[Libreoffice-commits] core.git: Branch 'distro/suse/suse-3.6' - 2 commits - basic/CppunitTest_basic_vba.mk basic/qa basic/source
Noel Power
noel.power at novell.com
Mon Mar 11 09:21:37 PDT 2013
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 <noel.power at 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 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 <noel.power at 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 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 )
More information about the Libreoffice-commits
mailing list