unit tests and data for bnc#805071

Change-Id: I36fefa280ee922cbade676c951b753e632c9d8bb

5 files changed, 132 insertions, 4 deletions

diff --git a/basic/CppunitTest_basic_vba.mk b/basic/CppunitTest_basic_vba.mk
index 278ef29cd040..b34318604923 100644
--- a/basic/CppunitTest_basic_vba.mk
+++ b/basic/CppunitTest_basic_vba.mk
@@ -57,8 +57,16 @@ $(eval $(call gb_CppunitTest_use_api,basic_vba,\
 
 $(eval $(call gb_CppunitTest_use_ure,basic_vba))
 
+ifeq ($(OS),WNT)
+$(eval $(call gb_CppunitTest_use_components,basic_vba,\
+    configmgr/source/configmgr \
+    i18npool/util/i18npool \
+    extensions/source/ole/oleautobridge \
+))
+else
 $(eval $(call gb_CppunitTest_use_components,basic_vba,\
     configmgr/source/configmgr \
     i18npool/util/i18npool \
 ))
+endif
 $(eval $(call gb_CppunitTest_use_configuration,basic_vba))
diff --git a/basic/qa/cppunit/test_vba.cxx b/basic/qa/cppunit/test_vba.cxx
index 3534670a07c1..f120a22304a1 100644
--- a/basic/qa/cppunit/test_vba.cxx
+++ b/basic/qa/cppunit/test_vba.cxx
@@ -8,7 +8,7 @@
  */
 #include "basictest.hxx"
 #include <vcl/svapp.hxx>
-
+#include <comphelper/processfactory.hxx>
 using namespace ::com::sun::star;
 
 namespace
@@ -17,15 +17,18 @@ namespace
 
     class VBATest : public test::BootstrapFixture
     {
+        bool hasOLEEnv();
         public:
         VBATest() : BootstrapFixture(true, false) {}
         ~VBATest(){}
         void testMiscVBAFunctions();
+        void testObjAssignWithDefaultMember();
         // Adds code needed to register the test suite
         CPPUNIT_TEST_SUITE(VBATest);
 
         // Declares the method as a test to call
         CPPUNIT_TEST(testMiscVBAFunctions);
+        CPPUNIT_TEST(testObjAssignWithDefaultMember);
         //CPPUNIT_TEST(testOle);
 
         // End of test suite definition
@@ -33,14 +36,44 @@ namespace
 
     };
 
+bool VBATest::hasOLEEnv()
+{
+    // test if we have the necessary runtime environment
+    // to run the OLE tests.
+    static uno::Reference< lang::XMultiServiceFactory > xOLEFactory;
+    if ( !xOLEFactory.is() )
+    {
+        uno::Reference< uno::XComponentContext > xContext(
+            comphelper::getProcessComponentContext() );
+        if( xContext.is() )
+        {
+            uno::Reference<lang::XMultiComponentFactory> xSMgr = xContext->getServiceManager();
+            xOLEFactory = uno::Reference<lang::XMultiServiceFactory>(
+                xSMgr->createInstanceWithContext(
+                    rtl::OUString( RTL_CONSTASCII_USTRINGPARAM(
+                        "com.sun.star.bridge.OleObjectFactory") ),
+                        xContext ), uno::UNO_QUERY );
+        }
+    }
+    bool bOk = false;
+    if( xOLEFactory.is() )
+    {
+        uno::Reference< uno::XInterface > xExcel = xOLEFactory->createInstance( "Excel.Application" );
+        uno::Reference< uno::XInterface > xADODB = xOLEFactory->createInstance( "ADODB.Connection" );
+       bOk = xExcel.is() && xADODB.is();
+    }
+    return bOk;
+}
+
 void VBATest::testMiscVBAFunctions()
 {
     const char* macroSource[] = {
         "bytearraystring.vb",
-#if 1// FIXED // datevalue test seems to depend on both locale and language
-          // settings, should try and rewrite the test to deal with that
+// datevalue test seems to depend on both locale and language
+// settings, should try and rewrite the test to deal with that
+// for some reason tinderboxes don't seem to complain leaving enabled
+// for the moment
         "datevalue.vb",
-#endif
         "partition.vb",
         "strconv.vb",
         "dateserial.vb",
@@ -71,6 +104,44 @@ void VBATest::testMiscVBAFunctions()
     }
 }
 
+void VBATest::testObjAssignWithDefaultMember()
+{
+    bool bCanRunOleTests = hasOLEEnv();
+    if ( !bCanRunOleTests )
+        return; // can't do anything, skip test
+
+    const char* macroSource[] = {
+        "ole_ObjAssignNoDflt.vb",
+        "ole_ObjAssignToNothing.vb",
+    };
+
+    rtl::OUString sMacroPathURL = getURLFromSrc("/basic/qa/vba_tests/");
+
+    uno::Sequence< uno::Any > aArgs(1);
+    // path to test document
+    rtl::OUString sPath = getPathFromSrc("/basic/qa/vba_tests/data/");
+    sPath += rtl::OUString( RTL_CONSTASCII_USTRINGPARAM("ADODBdata.xls") );
+    sPath = sPath.replaceAll( rtl::OUString( RTL_CONSTASCII_USTRINGPARAM("/") ), rtl::OUString( RTL_CONSTASCII_USTRINGPARAM( "\\" ) ) );
+
+    aArgs[ 0 ] = uno::makeAny( sPath );
+
+    for ( sal_uInt32  i=0; i<SAL_N_ELEMENTS( macroSource ); ++i )
+    {
+        rtl::OUString sMacroURL( sMacroPathURL );
+        sMacroURL += rtl::OUString::createFromAscii( macroSource[ i ] );
+        MacroSnippet myMacro;
+        myMacro.LoadSourceFromFile( sMacroURL );
+        SbxVariableRef pReturn = myMacro.Run( aArgs );
+        if ( pReturn )
+        {
+            fprintf(stderr, "macro result for %s\n", macroSource[ i ] );
+            fprintf(stderr, "macro returned:\n%s\n", rtl::OUStringToOString( pReturn->GetOUString(), RTL_TEXTENCODING_UTF8 ).getStr() );
+        }
+        CPPUNIT_ASSERT_MESSAGE("No return variable huh?", pReturn != NULL );
+        CPPUNIT_ASSERT_MESSAGE("Result not as expected", pReturn->GetOUString() == rtl::OUString("OK") );
+    }
+}
+
   // Put the test suite in the registry
 
   // Put the test suite in the registry
diff --git a/basic/qa/vba_tests/data/ADODBdata.xls b/basic/qa/vba_tests/data/ADODBdata.xls
new file mode 100755
index 000000000000..655b38a9028b
--- /dev/null
+++ b/basic/qa/vba_tests/data/ADODBdata.xls
diff --git a/basic/qa/vba_tests/ole_ObjAssignNoDflt.vb b/basic/qa/vba_tests/ole_ObjAssignNoDflt.vb
new file mode 100644
index 000000000000..70e1e084a09c
--- /dev/null
+++ b/basic/qa/vba_tests/ole_ObjAssignNoDflt.vb
@@ -0,0 +1,30 @@
+Option VBASupport 1
+Function doUnitTest( TestData as String) as String
+Rem Ensure object assignment is by reference
+Rem when object member is used ( as lhs )
+Dim origTimeout As Long
+Dim modifiedTimout As Long
+Set cn = New ADODB.Connection
+origTimeout = cn.CommandTimeout
+modifiedTimeout = origTimeout * 2
+cn.CommandTimeout = modifiedTimeout
+Dim conStr As String
+conStr = "Provider=MSDASQL;Driver={Microsoft Excel Driver (*.xls)};DBQ="
+conStr = conStr & TestData & "; ReadOnly=False;"
+cn.Open conStr
+Set objCmd = New ADODB.Command
+objCmd.ActiveConnection = cn
+If objCmd.ActiveConnection.CommandTimeout <> modifiedTimeout Then
+    Rem if we copied the object by reference then we should have the
+    Rem modified timeout ( because we should be just pointing as cn )
+    doUnitTest = "FAIL expected modified timeout " & modifiedTimeout & " but got " &  objCmd.ActiveConnection.CommandTimeout 
+    Exit Function
+End If
+cn.CommandTimeout = origTimeout ' restore timeout
+Rem Double check objCmd.ActiveConnection is pointing to objCmd.ActiveConnection
+If objCmd.ActiveConnection.CommandTimeout <> origTimeout Then
+    doUnitTest = "FAIL expected orignal timeout " & origTimeout & " but got " &  objCmd.ActiveConnection.CommandTimeout 
+    Exit Function
+End If
+doUnitTest = "OK" ' no error
+End Function
diff --git a/basic/qa/vba_tests/ole_ObjAssignToNothing.vb b/basic/qa/vba_tests/ole_ObjAssignToNothing.vb
new file mode 100644
index 000000000000..b34163db73ce
--- /dev/null
+++ b/basic/qa/vba_tests/ole_ObjAssignToNothing.vb
@@ -0,0 +1,19 @@
+Option VBASupport 1
+Function doUnitTest( TestData as String) as String
+Rem Ensure object assignment is by reference
+Rem when object member is used ( as lhs )
+Rem This time we are testing assigning with special Nothing
+Rem keyword
+Set cn = New ADODB.Connection
+Dim conStr As String
+conStr = "Provider=MSDASQL;Driver={Microsoft Excel Driver (*.xls)};DBQ="
+conStr = conStr & TestData & "; ReadOnly=False;"
+cn.Open conStr
+Set objCmd = New ADODB.Command
+objCmd.ActiveConnection = Nothing
+if objCmd.ActiveConnection Is Nothing Then
+    doUnitTest = "OK" ' no error
+Else
+    doUnitTest = "Fail - expected objCmd.ActiveConnection be Nothing"
+End If
+End Function