basic/CppunitTest_basic_vba.mk | 8 ++ basic/qa/cppunit/test_vba.cxx | 79 +++++++++++++++++++++++++-- basic/qa/vba_tests/data/ADODBdata.xls |binary basic/qa/vba_tests/ole_ObjAssignNoDflt.vb | 30 ++++++++++ basic/qa/vba_tests/ole_ObjAssignToNothing.vb | 19 ++++++ basic/source/runtime/step0.cxx | 43 ++++++++++---- 6 files changed, 164 insertions(+), 15 deletions(-)
New commits: commit 5463610a2c44ebfd7b42697187eb4b619dd5a988 Author: Noel Power <[email protected]> Date: Mon Mar 11 15:50:54 2013 +0000 unit tests and data for bnc#805071 Change-Id: I36fefa280ee922cbade676c951b753e632c9d8bb diff --git a/basic/CppunitTest_basic_vba.mk b/basic/CppunitTest_basic_vba.mk index 182f984..e96f0f3 100644 --- a/basic/CppunitTest_basic_vba.mk +++ b/basic/CppunitTest_basic_vba.mk @@ -54,8 +54,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 805267a..5b56ea6 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 0000000..655b38a Binary files /dev/null and b/basic/qa/vba_tests/data/ADODBdata.xls differ diff --git a/basic/qa/vba_tests/ole_ObjAssignNoDflt.vb b/basic/qa/vba_tests/ole_ObjAssignNoDflt.vb new file mode 100644 index 0000000..70e1e08 --- /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 0000000..b34163d --- /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 commit 9fce56c76db085eb8e230183ef8d357ed6f25f08 Author: Noel Power <[email protected]> Date: Mon Mar 11 11:28:18 2013 +0000 bnc#805071 fix object assigment problems when default members present Change-Id: I6f7dfd369a36aff06f15b9a3affadb9d19787a9c diff --git a/basic/source/runtime/step0.cxx b/basic/source/runtime/step0.cxx index 607d5cb..d3a89af 100644 --- a/basic/source/runtime/step0.cxx +++ b/basic/source/runtime/step0.cxx @@ -398,13 +398,26 @@ void SbiRuntime::StepPUT() // could equate to Range("A1").Value = 34 if ( bVBAEnabled ) { - if ( refVar->GetType() == SbxOBJECT ) + // yet more hacking at this, I feel we don't quite have the correct + // heuristics for dealing with obj1 = obj2 ( where obj2 ( and maybe + // obj1 ) has default member/property ) ) It seems that default props + // aren't dealt with if the object is a member of some parent object + bool bObjAssign = false; + if ( refVar->GetType() == SbxEMPTY ) + refVar->Broadcast( SBX_HINT_DATAWANTED ); + if ( refVar->GetType() == SbxOBJECT ) { - SbxVariable* pDflt = getDefaultProp( refVar ); - if ( pDflt ) - refVar = pDflt; + if ( refVar->IsA( TYPE(SbxMethod) ) || ! refVar->GetParent() ) + { + SbxVariable* pDflt = getDefaultProp( refVar ); + + if ( pDflt ) + refVar = pDflt; + } + else + bObjAssign = true; } - if ( refVal->GetType() == SbxOBJECT ) + if ( refVal->GetType() == SbxOBJECT && !bObjAssign && ( refVal->IsA( TYPE(SbxMethod) ) || ! refVal->GetParent() ) ) { SbxVariable* pDflt = getDefaultProp( refVal ); if ( pDflt ) @@ -532,16 +545,24 @@ void SbiRuntime::StepSET_Impl( SbxVariableRef& refVal, SbxVariableRef& refVar, b { // get default properties for lhs & rhs where necessary // SbxVariable* defaultProp = NULL; unused variable - bool bLHSHasDefaultProp = false; // LHS try determine if a default prop exists + // again like in StepPUT (see there too ) we are tweaking the + // heursitics again for when to assign an object reference or + // use default memebers if they exists + // #FIXME we really need to get to the bottom of this mess + bool bObjAssign = false; if ( refVar->GetType() == SbxOBJECT ) { - SbxVariable* pDflt = getDefaultProp( refVar ); - if ( pDflt ) + if ( refVar->IsA( TYPE(SbxMethod) ) || ! refVar->GetParent() ) { - refVar = pDflt; - bLHSHasDefaultProp = true; + SbxVariable* pDflt = getDefaultProp( refVar ); + if ( pDflt ) + { + refVar = pDflt; + } } + else + bObjAssign = true; } // RHS only get a default prop is the rhs has one if ( refVal->GetType() == SbxOBJECT ) @@ -561,7 +582,7 @@ void SbiRuntime::StepSET_Impl( SbxVariableRef& refVal, SbxVariableRef& refVar, b pObj = PTR_CAST(SbxObject,pObjVarObj); } SbxVariable* pDflt = NULL; - if ( pObj || bLHSHasDefaultProp ) + if ( pObj && !bObjAssign ) // lhs is either a valid object || or has a defaultProp pDflt = getDefaultProp( refVal ); if ( pDflt ) _______________________________________________ Libreoffice-commits mailing list [email protected] http://lists.freedesktop.org/mailman/listinfo/libreoffice-commits
