basic/qa/vba_tests/ole_ObjAssignNoDflt.vb

   1 '
   2 ' This file is part of the LibreOffice project.
   3 '
   4 ' This Source Code Form is subject to the terms of the Mozilla Public
   5 ' License, v. 2.0. If a copy of the MPL was not distributed with this
   6 ' file, You can obtain one at http://mozilla.org/MPL/2.0/.
   7 '
   8
   9 Option VBASupport 1
  10 Function doUnitTest(TestData as String, Driver as String) as String
  11 Rem Ensure object assignment is by reference
  12 Rem when object member is used ( as lhs )
  13 Dim origTimeout As Long
  14 Dim modifiedTimeout As Long
  15 Set cn = New ADODB.Connection
  16 origTimeout = cn.CommandTimeout
  17 modifiedTimeout = origTimeout * 2
  18 cn.CommandTimeout = modifiedTimeout
  19 Dim conStr As String
  20 conStr = "Provider=MSDASQL;Driver={" & Driver & "};DBQ="
  21 conStr = conStr & TestData & "; ReadOnly=False;"
  22 cn.Open conStr
  23 Set objCmd = New ADODB.Command
  24 objCmd.ActiveConnection = cn
  25 If objCmd.ActiveConnection.CommandTimeout <> modifiedTimeout Then
  26     Rem if we copied the object by reference then we should have the
  27     Rem modified timeout ( because we should be just pointing as cn )
  28     doUnitTest = "FAIL expected modified timeout " & modifiedTimeout & " but got " &  objCmd.ActiveConnection.CommandTimeout
  29     Exit Function
  30 End If
  31 cn.CommandTimeout = origTimeout ' restore timeout
  32 Rem Double check objCmd.ActiveConnection is pointing to objCmd.ActiveConnection
  33 If objCmd.ActiveConnection.CommandTimeout <> origTimeout Then
  34     doUnitTest = "FAIL expected original timeout " & origTimeout & " but got " &  objCmd.ActiveConnection.CommandTimeout
  35     Exit Function
  36 End If
  37 doUnitTest = "OK" ' no error
  38 End Function