basic/CppunitTest_basic_vba.mk | 8 ++
basic/qa/cppunit/test_vba.cxx | 84 +++++++++++++++++++++++++--
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, 167 insertions(+), 17 deletions(-)
New commits:
commit 54d70501380f818fc928557590ed70e6f5a925f7
Author: Noel Power <noel.po...@suse.com>
Date: Mon Mar 11 17:31:43 2013 +0000
remove some rtl:: and RTL_CONSTASCII_USTRINGPARAM foo
Change-Id: I68e2891999f306865d00b33fdfef3bc539a34e93
diff --git a/basic/qa/cppunit/test_vba.cxx b/basic/qa/cppunit/test_vba.cxx
index f120a22..abb929f 100644
--- a/basic/qa/cppunit/test_vba.cxx
+++ b/basic/qa/cppunit/test_vba.cxx
@@ -28,8 +28,10 @@ namespace
// Declares the method as a test to call
CPPUNIT_TEST(testMiscVBAFunctions);
+// not much point even trying to run except on windows
+#if defined(WNT)
CPPUNIT_TEST(testObjAssignWithDefaultMember);
- //CPPUNIT_TEST(testOle);
+#endif
// End of test suite definition
CPPUNIT_TEST_SUITE_END();
@@ -50,8 +52,7 @@ bool VBATest::hasOLEEnv()
uno::Reference<lang::XMultiComponentFactory> xSMgr =
xContext->getServiceManager();
xOLEFactory = uno::Reference<lang::XMultiServiceFactory>(
xSMgr->createInstanceWithContext(
- rtl::OUString( RTL_CONSTASCII_USTRINGPARAM(
- "com.sun.star.bridge.OleObjectFactory") ),
+ "com.sun.star.bridge.OleObjectFactory",
xContext ), uno::UNO_QUERY );
}
}
@@ -100,7 +101,7 @@ void VBATest::testMiscVBAFunctions()
fprintf(stderr, "macro returned:\n%s\n", 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") );
+ CPPUNIT_ASSERT_MESSAGE("Result not as expected",
pReturn->GetOUString() == "OK" );
}
}
@@ -115,30 +116,30 @@ void VBATest::testObjAssignWithDefaultMember()
"ole_ObjAssignToNothing.vb",
};
- rtl::OUString sMacroPathURL = getURLFromSrc("/basic/qa/vba_tests/");
+ 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( "\\" ) ) );
+ OUString sPath = getPathFromSrc("/basic/qa/vba_tests/data/");
+ sPath += OUString( "ADODBdata.xls" );
+ sPath = sPath.replaceAll( "/", "\\" );
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 ] );
+ OUString sMacroURL( sMacroPathURL );
+ sMacroURL += 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() );
+ fprintf(stderr, "macro returned:\n%s\n", 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") );
+ CPPUNIT_ASSERT_MESSAGE("Result not as expected",
pReturn->GetOUString() == "OK" );
}
}
commit 0f7798d86226d8e93fbd624283cd3558c7dd63fe
Author: Noel Power <noel.po...@novell.com>
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 278ef29..b343186 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 3534670..f120a22 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 d06f4577b52df5f390809850f26663e2e62d0ff1
Author: Noel Power <noel.po...@novell.com>
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 f762d57..225b17b 100644
--- a/basic/source/runtime/step0.cxx
+++ b/basic/source/runtime/step0.cxx
@@ -445,13 +445,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 )
@@ -585,16 +598,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 )
@@ -614,7 +635,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 );
_______________________________________________
Libreoffice-commits mailing list
libreoffice-comm...@lists.freedesktop.org
http://lists.freedesktop.org/mailman/listinfo/libreoffice-commits
