[Libreoffice-commits] core.git: Branch 'libreoffice-4-0' - basic/CppunitTest_basic_vba.mk basic/Module_basic.mk basic/qa basic/source
Noel Power
noel.power at suse.com
Fri Mar 15 14:55:53 PDT 2013
basic/CppunitTest_basic_vba.mk | 67 ++++
basic/Module_basic.mk | 1
basic/qa/cppunit/basic_coverage.cxx | 75 ----
basic/qa/cppunit/basictest.hxx | 120 +++++++
basic/qa/cppunit/test_append.cxx | 40 --
basic/qa/cppunit/test_nested_struct.cxx | 192 +++---------
basic/qa/cppunit/test_vba.cxx | 153 ++++++++++
basic/qa/vba_tests/bytearraystring.vb | 68 ++++
basic/qa/vba_tests/data/ADODBdata.xls |binary
basic/qa/vba_tests/dateserial.vb | 65 ++++
basic/qa/vba_tests/datevalue.vb | 65 ++++
basic/qa/vba_tests/format.vb | 406 +++++++++++++++++++++++++++
basic/qa/vba_tests/ole_ObjAssignNoDflt.vb | 30 +
basic/qa/vba_tests/ole_ObjAssignToNothing.vb | 19 +
basic/qa/vba_tests/partition.vb | 71 ++++
basic/qa/vba_tests/replace.vb | 70 ++++
basic/qa/vba_tests/strconv.vb | 90 +++++
basic/qa/vba_tests/stringplusdouble.vb | 328 +++++++++++++++++++++
basic/source/sbx/sbxform.cxx | 2
19 files changed, 1629 insertions(+), 233 deletions(-)
New commits:
commit 90a9abea38d5fb17d754b78c4452a94c1ffbdf3c
Author: Noel Power <noel.power at suse.com>
Date: Wed Mar 6 21:14:08 2013 +0000
Rehash basic unit test framework
Create new Macro helper class to help invoking macros for unittests
Change-Id: Icc3cbfc3eae6ade037960497e7fe2addf1912897
(cherry picked from commit a9fc6ee7dc640f016728bf524d684696a376e989)
use "doUnitTest" as the method to search for, tweak error reporting
Change-Id: I0c0f4ce1304b561bf94af5444c83d8920062568b
(cherry picked from commit 49417b0b68e8c9743bd6f664a5f8b4a0f3c19723)
adapt existing tests to use MacroSnipper helper class
Change-Id: I50980d9510b82277a5da04cc4f6c1d3ec8e7c756
(cherry picked from commit 8534787f95dfbfff24167b2160cfe07a1b70bcc6)
Nested_Struct should really inherit from test::BootstrapFixture
Change-Id: I06255940f41c32493187d1ec847f7238fef4e9f8
(cherry picked from commit 20f12a1d7ad5f9694f901a85e1fa22f46c3953a2)
finally remove no long needed BasicTestBase
Change-Id: Ic1522b0c3a292af061f5777e06e796dd82884fbf
(cherry picked from commit fea9b3a99a24366b4dea22ed1b79f34046f7f521)
Add some stand alone vba specific tests ( mostly vba only functions )
Change-Id: I137e93a8af67b7eec4c51348caf3d0d03dbbce73
(cherry picked from commit 76c3184813c97224cfd1e114ec13796e1da040d5)
fix String->OUString foobar
Change-Id: Ia924e6e8f3cfa25b131185713699d64e9d339357
(cherry picked from commit f202b21770b9d36522ff811868b911d0f1c852a6)
doh! sReturnStrg is OUStringBuffer, no need to assign
Change-Id: I490d20e8b494b4f59277b1cc92c73beb65a05813
(cherry picked from commit a9813b9ab307591a4c8a06fd01a4ef82126cfb18)
fix WAE mbError unused
Change-Id: I03bae6808008dcb0b53b1e816f3fe84739036773
(cherry picked from commit 4596120336b575d94d305c4139054afd95d2f740)
remove duplicate file loading from basic_coverage ( now in MacroSnippet )
Change-Id: I1b19fec59419575fcf09d79986b6bac73ea51c9a
(cherry picked from commit 46bab17e6d48c2279f4698d46f01db5404b0ba6f)
unit tests and data for bnc#805071
Change-Id: I36fefa280ee922cbade676c951b753e632c9d8bb
(cherry picked from commit 0f7798d86226d8e93fbd624283cd3558c7dd63fe)
remove some rtl:: and RTL_CONSTASCII_USTRINGPARAM foo
Change-Id: I68e2891999f306865d00b33fdfef3bc539a34e93
(cherry picked from commit 54d70501380f818fc928557590ed70e6f5a925f7)
basic: make the makefile a bit nicer
Change-Id: Ib606c0a9c84b35f4ab4b10dd7dc4dd82e85fcb71
(cherry picked from commit 954611cdea0ae4b0dab4f241e580c4f61792dc8b)
Windows oleautobridge depends on ATL
Change-Id: I94b43b03f742da7c6c8cf2e6a60ed305c1395fa7
(cherry picked from commit b0bcadf62a631b6cce5a5188f8018f266e1b99ee)
Reviewed-on: https://gerrit.libreoffice.org/2757
Reviewed-by: Fridrich Strba <fridrich at documentfoundation.org>
Tested-by: Fridrich Strba <fridrich at documentfoundation.org>
diff --git a/basic/CppunitTest_basic_vba.mk b/basic/CppunitTest_basic_vba.mk
new file mode 100644
index 0000000..25f41f3
--- /dev/null
+++ b/basic/CppunitTest_basic_vba.mk
@@ -0,0 +1,67 @@
+#
+# This file is part of the LibreOffice project.
+#
+# This Source Code Form is subject to the terms of the Mozilla Public
+# License, v. 2.0. If a copy of the MPL was not distributed with this
+# file, You can obtain one at http://mozilla.org/MPL/2.0/.
+#
+
+$(eval $(call gb_CppunitTest_CppunitTest,basic_vba))
+
+$(eval $(call gb_CppunitTest_use_external,basic_vba,boost_headers))
+
+$(eval $(call gb_CppunitTest_add_exception_objects,basic_vba, \
+ basic/qa/cppunit/test_vba \
+))
+
+#$(eval $(call gb_CppunitTest_use_library_objects,basic_vba,sb))
+
+# add a list of all needed libraries here
+$(eval $(call gb_CppunitTest_use_libraries,basic_vba, \
+ comphelper \
+ cppu \
+ cppuhelper \
+ i18nisolang1 \
+ sal \
+ salhelper \
+ sb \
+ sot \
+ svl \
+ svt \
+ test \
+ tl \
+ unotest \
+ utl \
+ vcl \
+ xmlscript \
+ $(gb_UWINAPI) \
+))
+
+ifeq ($(OS),WNT)
+$(eval $(call gb_CppunitTest_use_system_win32_libs,basic_vba, \
+ oleaut32 \
+))
+endif
+
+$(eval $(call gb_CppunitTest_set_include,basic_vba,\
+ -I$(SRCDIR)/basic/source/inc \
+ -I$(SRCDIR)/basic/inc \
+ $$(INCLUDE) \
+))
+
+$(eval $(call gb_CppunitTest_use_api,basic_vba,\
+ offapi \
+ udkapi \
+ oovbaapi \
+))
+
+$(eval $(call gb_CppunitTest_use_ure,basic_vba))
+
+$(eval $(call gb_CppunitTest_use_components,basic_vba,\
+ configmgr/source/configmgr \
+ i18npool/util/i18npool \
+ $(if $(DISABLE_ATL),,$(if $(filter $(OS),WNT), \
+ extensions/source/ole/oleautobridge)) \
+))
+
+$(eval $(call gb_CppunitTest_use_configuration,basic_vba))
diff --git a/basic/Module_basic.mk b/basic/Module_basic.mk
index a4ff822..d94bf16 100644
--- a/basic/Module_basic.mk
+++ b/basic/Module_basic.mk
@@ -20,6 +20,7 @@ $(eval $(call gb_Module_add_check_targets,basic,\
CppunitTest_basic_enable \
CppunitTest_basic_nested_struct \
CppunitTest_basic_coverage \
+ CppunitTest_basic_vba \
))
endif
diff --git a/basic/qa/cppunit/basic_coverage.cxx b/basic/qa/cppunit/basic_coverage.cxx
index d78a28f..1e571da 100644
--- a/basic/qa/cppunit/basic_coverage.cxx
+++ b/basic/qa/cppunit/basic_coverage.cxx
@@ -16,25 +16,21 @@
namespace
{
-class Coverage : public BasicTestBase
+class Coverage : public test::BootstrapFixture
{
private:
- bool m_bError;
int m_nb_tests;
int m_nb_tests_ok;
int m_nb_tests_ko;
int m_nb_tests_skipped;
OUString m_sCurrentTest;
void process_directory(OUString sDirName);
- void process_file(OUString sFileName);
- void run_test(OUString sFileName, OUString sCode);
+ void run_test(OUString sFileName);
void test_start(OUString /* sFileName */);
void test_failed(void);
void test_success(void);
void print_summary() {};
- DECL_LINK( CoverageErrorHdl, StarBASIC * );
-
public:
Coverage();
~Coverage();
@@ -51,18 +47,8 @@ public:
CPPUNIT_TEST_SUITE_END();
};
-IMPL_LINK( Coverage, CoverageErrorHdl, StarBASIC *, /*pBasic*/)
-{
- fprintf(stderr,"%s:(%d:%d)\n",
- rtl::OUStringToOString( m_sCurrentTest, RTL_TEXTENCODING_UTF8 ).getStr(),
- StarBASIC::GetLine(), StarBASIC::GetCol1());
- fprintf(stderr,"Basic error: %s\n", rtl::OUStringToOString( StarBASIC::GetErrorText(), RTL_TEXTENCODING_UTF8 ).getStr() );
- m_bError = true;
- return 0;
-}
-
Coverage::Coverage()
- : m_bError(false)
+ : BootstrapFixture(true, false)
, m_nb_tests(0)
, m_nb_tests_ok(0)
, m_nb_tests_ko(0)
@@ -98,28 +84,18 @@ void Coverage::test_success()
fprintf(stderr,"%s,PASS\n", rtl::OUStringToOString( m_sCurrentTest, RTL_TEXTENCODING_UTF8 ).getStr() );
}
-void Coverage::run_test(OUString /*sFileName*/, OUString sCode)
+void Coverage::run_test(OUString sFileURL)
{
bool result = false;
- CPPUNIT_ASSERT_MESSAGE( "No resource manager", basicDLL().GetBasResMgr() != NULL );
- StarBASICRef pBasic = new StarBASIC();
- ResetError();
- StarBASIC::SetGlobalErrorHdl( LINK( this, Coverage, CoverageErrorHdl ) );
-
- SbModule* pMod = pBasic->MakeModule( rtl::OUString( "TestModule" ), sCode );
- pMod->Compile();
- if(!m_bError)
+ MacroSnippet testMacro;
+ testMacro.LoadSourceFromFile( sFileURL );
+ testMacro.Compile();
+ if( !testMacro.HasError() )
{
- SbMethod* pMeth = static_cast<SbMethod*>(pMod->Find( rtl::OUString("doUnitTest"), SbxCLASS_METHOD ));
- if(pMeth)
+ SbxVariableRef pResult = testMacro.Run();
+ if( pResult && pResult->GetInteger() == 1 )
{
- SbxVariableRef refTemp = pMeth;
- // forces a broadcast
- SbxVariableRef pNew = new SbxMethod( *((SbxMethod*)pMeth));
- if(pNew->GetInteger() == 1 )
- {
- result = true;
- }
+ result = true;
}
}
if(result)
@@ -132,33 +108,6 @@ void Coverage::run_test(OUString /*sFileName*/, OUString sCode)
}
}
-void Coverage::process_file(OUString sFileName)
-{
- osl::File aFile(sFileName);
-
- test_start(sFileName);
- if(osl::FileBase::E_None == aFile.open(osl_File_OpenFlag_Read))
- {
- sal_uInt64 size;
- sal_uInt64 size_read;
- if(osl::FileBase::E_None == aFile.getSize(size))
- {
- void* buffer = calloc(1, size+1);
- CPPUNIT_ASSERT(buffer);
- if(osl::FileBase::E_None == aFile.read( buffer, size, size_read))
- {
- if(size == size_read)
- {
- OUString sCode((sal_Char*)buffer, size, RTL_TEXTENCODING_UTF8);
- run_test(sFileName, sCode);
- return;
- }
- }
- }
- }
- test_failed();
-}
-
void Coverage::process_directory(OUString sDirName)
{
osl::Directory aDir(sDirName);
@@ -172,7 +121,7 @@ void Coverage::process_directory(OUString sDirName)
aItem.getFileStatus(aFileStatus);
if(aFileStatus.isRegular())
{
- process_file(aFileStatus.getFileURL());
+ run_test(aFileStatus.getFileURL());
}
}
}
diff --git a/basic/qa/cppunit/basictest.hxx b/basic/qa/cppunit/basictest.hxx
index bb26a23..c828f25 100644
--- a/basic/qa/cppunit/basictest.hxx
+++ b/basic/qa/cppunit/basictest.hxx
@@ -16,22 +16,131 @@
#include <test/bootstrapfixture.hxx>
#include "basic/sbstar.hxx"
#include "basic/basrdll.hxx"
+#include "basic/sbmod.hxx"
+#include "basic/sbmeth.hxx"
+#include "basic/basrdll.hxx"
+#include "basic/sbuno.hxx"
+#include <osl/file.hxx>
-class BasicTestBase : public test::BootstrapFixture
+class MacroSnippet
{
private:
bool mbError;
+ SbModuleRef mpMod;
+ StarBASICRef mpBasic;
+
+ void InitSnippet()
+ {
+ CPPUNIT_ASSERT_MESSAGE( "No resource manager", basicDLL().GetBasResMgr() != NULL );
+ mpBasic = new StarBASIC();
+ StarBASIC::SetGlobalErrorHdl( LINK( this, MacroSnippet, BasicErrorHdl ) );
+ }
+ void MakeModule( const OUString& sSource )
+ {
+ mpMod = mpBasic->MakeModule( OUString( "TestModule" ), sSource );
+ }
public:
- BasicTestBase() : BootstrapFixture(true, false), mbError(false) {};
+ struct ErrorDetail
+ {
+ OUString sErrorText;
+ int nLine;
+ int nCol;
+ ErrorDetail() : nLine(0), nCol(0) {}
+ };
+
+ MacroSnippet( const OUString& sSource ) : mbError(false)
+ {
+ InitSnippet();
+ MakeModule( sSource );
+ };
+ MacroSnippet() : mbError(false)
+ {
+ InitSnippet();
+ };
+ void LoadSourceFromFile( const OUString& sMacroFileURL )
+ {
+ OUString sSource;
+ fprintf(stderr,"loadSource opening macro file %s\n", OUStringToOString( sMacroFileURL, RTL_TEXTENCODING_UTF8 ).getStr() );
+
+ osl::File aFile(sMacroFileURL);
+ if(osl::FileBase::E_None == aFile.open(osl_File_OpenFlag_Read))
+ {
+ sal_uInt64 size;
+ sal_uInt64 size_read;
+ if(osl::FileBase::E_None == aFile.getSize(size))
+ {
+ void* buffer = calloc(1, size+1);
+ CPPUNIT_ASSERT(buffer);
+ if(osl::FileBase::E_None == aFile.read( buffer, size, size_read))
+ {
+ if(size == size_read)
+ {
+ OUString sCode((sal_Char*)buffer, size, RTL_TEXTENCODING_UTF8);
+ sSource = sCode;
+ }
+ }
+ }
+ }
+ CPPUNIT_ASSERT_MESSAGE( "Source is empty", ( sSource.getLength() > 0 ) );
+ MakeModule( sSource );
+ }
+
+ SbxVariableRef Run( const ::com::sun::star::uno::Sequence< ::com::sun::star::uno::Any >& rArgs )
+ {
+ SbxVariableRef pReturn = NULL;
+ if ( !Compile() )
+ return pReturn;
+ SbMethod* pMeth = mpMod ? static_cast<SbMethod*>(mpMod->Find( OUString("doUnitTest"), SbxCLASS_METHOD )) : NULL;
+ if ( pMeth )
+ {
+ if ( rArgs.getLength() )
+ {
+ SbxArrayRef aArgs = new SbxArray;
+ for ( int i=0; i < rArgs.getLength(); ++i )
+ {
+ SbxVariable* pVar = new SbxVariable();
+ unoToSbxValue( pVar, rArgs[ i ] );
+ aArgs->Put( pVar, i + 1 );
+ }
+ pMeth->SetParameters( aArgs );
+ }
+ pReturn = new SbxMethod( *((SbxMethod*)pMeth));
+ }
+ return pReturn;
+ }
+ SbxVariableRef Run()
+ {
+ ::com::sun::star::uno::Sequence< ::com::sun::star::uno::Any > aArgs;
+ return Run( aArgs );
+ }
+
+ bool Compile()
+ {
+ CPPUNIT_ASSERT_MESSAGE("module is NULL", mpMod != NULL );
+ mpMod->Compile();
+ return !mbError;
+ }
DECL_LINK( BasicErrorHdl, StarBASIC * );
+
+ ErrorDetail GetError()
+ {
+ ErrorDetail aErr;
+ aErr.sErrorText = StarBASIC::GetErrorText();
+ aErr.nLine = StarBASIC::GetLine();
+ aErr.nCol = StarBASIC::GetCol1();
+ return aErr;
+ }
+
bool HasError() { return mbError; }
+
void ResetError()
{
StarBASIC::SetGlobalErrorHdl( Link() );
mbError = false;
}
+
BasicDLL& basicDLL()
{
static BasicDLL maDll; // we need a dll instance for resouce manager etc.
@@ -39,13 +148,14 @@ class BasicTestBase : public test::BootstrapFixture
}
};
-IMPL_LINK( BasicTestBase, BasicErrorHdl, StarBASIC *, /*pBasic*/)
+IMPL_LINK( MacroSnippet, BasicErrorHdl, StarBASIC *, /*pBasic*/)
{
- fprintf(stderr,"Got error: \n\t%s!!!\n", rtl::OUStringToOString( StarBASIC::GetErrorText(), RTL_TEXTENCODING_UTF8 ).getStr() );
+ fprintf(stderr,"(%d:%d)\n",
+ StarBASIC::GetLine(), StarBASIC::GetCol1());
+ fprintf(stderr,"Basic error: %s\n", rtl::OUStringToOString( StarBASIC::GetErrorText(), RTL_TEXTENCODING_UTF8 ).getStr() );
mbError = true;
return 0;
}
-
#endif
/* vim:set shiftwidth=4 softtabstop=4 expandtab: */
diff --git a/basic/qa/cppunit/test_append.cxx b/basic/qa/cppunit/test_append.cxx
index 7e7990f..e3d9f6b 100644
--- a/basic/qa/cppunit/test_append.cxx
+++ b/basic/qa/cppunit/test_append.cxx
@@ -15,10 +15,10 @@
#include "basic/sbmeth.hxx"
namespace
{
- class EnableTest : public BasicTestBase
+ class EnableTest : public test::BootstrapFixture
{
public:
- EnableTest() {};
+ EnableTest() : BootstrapFixture(true, false) {};
void testDimEnable();
void testEnableRuntime();
// Adds code needed to register the test suite
@@ -33,50 +33,34 @@ namespace
};
rtl::OUString sTestEnableRuntime(
- "Function Test as Integer\n"
+ "Function doUnitTest as Integer\n"
"Dim Enable as Integer\n"
"Enable = 1\n"
"Enable = Enable + 2\n"
- "Test = Enable\n"
+ "doUnitTest = Enable\n"
"End Function\n"
);
rtl::OUString sTestDimEnable(
- "Sub Test\n"
+ "Sub doUnitTest\n"
"Dim Enable as String\n"
"End Sub\n"
);
void EnableTest::testEnableRuntime()
{
- CPPUNIT_ASSERT_MESSAGE( "No resource manager", basicDLL().GetBasResMgr() != NULL );
- StarBASICRef pBasic = new StarBASIC();
- ResetError();
- StarBASIC::SetGlobalErrorHdl( LINK( this, EnableTest, BasicErrorHdl ) );
-
- SbModule* pMod = pBasic->MakeModule( rtl::OUString( "TestModule" ), sTestEnableRuntime );
- pMod->Compile();
- CPPUNIT_ASSERT_MESSAGE("testEnableRuntime fails with compile error",!HasError() );
- SbMethod* pMeth = static_cast<SbMethod*>(pMod->Find( rtl::OUString("Test"), SbxCLASS_METHOD ));
- CPPUNIT_ASSERT_MESSAGE("testEnableRuntime no method found", pMeth );
- SbxVariableRef refTemp = pMeth;
- // forces a broadcast
- SbxVariableRef pNew = new SbxMethod( *((SbxMethod*)pMeth));
+ MacroSnippet myMacro(sTestEnableRuntime);
+ myMacro.Compile();
+ CPPUNIT_ASSERT_MESSAGE("testEnableRuntime fails with compile error",!myMacro.HasError() );
+ SbxVariableRef pNew = myMacro.Run();
CPPUNIT_ASSERT(pNew->GetInteger() == 3 );
}
void EnableTest::testDimEnable()
{
- CPPUNIT_ASSERT_MESSAGE( "No resource manager", basicDLL().GetBasResMgr() != NULL );
- StarBASICRef pBasic = new StarBASIC();
- StarBASIC::SetGlobalErrorHdl( LINK( this, EnableTest, BasicErrorHdl ) );
-
- ResetError();
-
- SbModule* pMod = pBasic->MakeModule( rtl::OUString( "TestModule" ), sTestDimEnable );
- pMod->Compile();
-
- CPPUNIT_ASSERT_MESSAGE("Dim causes compile error", !HasError() );
+ MacroSnippet myMacro(sTestDimEnable);
+ myMacro.Compile();
+ CPPUNIT_ASSERT_MESSAGE("Dim causes compile error", !myMacro.HasError() );
}
// Put the test suite in the registry
diff --git a/basic/qa/cppunit/test_nested_struct.cxx b/basic/qa/cppunit/test_nested_struct.cxx
index c55f4b3..8c7fabc 100644
--- a/basic/qa/cppunit/test_nested_struct.cxx
+++ b/basic/qa/cppunit/test_nested_struct.cxx
@@ -19,10 +19,10 @@
namespace
{
using namespace com::sun::star;
- class Nested_Struct : public BasicTestBase
+ class Nested_Struct : public test::BootstrapFixture
{
public:
- Nested_Struct() {};
+ Nested_Struct(): BootstrapFixture(true, false) {};
void testAssign1();
void testAssign1Alt(); // result is uno-ised and tested
void testOldAssign();
@@ -54,18 +54,18 @@ namespace
// tests the new behaviour, we should be able to
// directly modify the value of the nested 'HorizontalLine' struct
rtl::OUString sTestSource1(
- "Function simpleNestStructAccess() as Integer\n"
+ "Function doUnitTest() as Integer\n"
"Dim b0 as new \"com.sun.star.table.TableBorder\"\n"
"b0.HorizontalLine.OuterLineWidth = 9\n"
- "simpleNestStructAccess = b0.HorizontalLine.OuterLineWidth\n"
+ "doUnitTest = b0.HorizontalLine.OuterLineWidth\n"
"End Function\n"
);
rtl::OUString sTestSource1Alt(
- "Function simpleNestStructAccess() as Object\n"
+ "Function doUnitTest() as Object\n"
"Dim b0 as new \"com.sun.star.table.TableBorder\"\n"
"b0.HorizontalLine.OuterLineWidth = 9\n"
- "simpleNestStructAccess = b0\n"
+ "doUnitTest = b0\n"
"End Function\n"
);
@@ -76,22 +76,22 @@ rtl::OUString sTestSource1Alt(
// c) modifying the new instance
// d) setting b0.HorizontalLine with the value of the new instance
rtl::OUString sTestSource2(
- "Function simpleRegressionTestOld()\n"
+ "Function doUnitTest()\n"
"Dim b0 as new \"com.sun.star.table.TableBorder\", l as new \"com.sun.star.table.BorderLine\"\n"
"l = b0.HorizontalLine\n"
"l.OuterLineWidth = 9\n"
"b0.HorizontalLine = l\n"
- "simpleRegressionTestOld = b0.HorizontalLine.OuterLineWidth\n"
+ "doUnitTest = b0.HorizontalLine.OuterLineWidth\n"
"End Function\n"
);
rtl::OUString sTestSource2Alt(
- "Function simpleRegressionTestOld()\n"
+ "Function doUnitTest()\n"
"Dim b0 as new \"com.sun.star.table.TableBorder\", l as new \"com.sun.star.table.BorderLine\"\n"
"l = b0.HorizontalLine\n"
"l.OuterLineWidth = 9\n"
"b0.HorizontalLine = l\n"
- "simpleRegressionTestOld = b0\n"
+ "doUnitTest = b0\n"
"End Function\n"
);
// it should be legal to assign a variant to a struct ( and copy by val )
@@ -100,18 +100,18 @@ rtl::OUString sTestSource2Alt(
// OuterLineWidth of 4 & 9 respectively and we should be returning
// 13 the sum of the two ( hopefully unique values if we haven't copied by reference )
rtl::OUString sTestSource3(
- "Function testUnfixedVarAssign()\n"
+ "Function doUnitTest()\n"
"Dim b0 as new \"com.sun.star.table.TableBorder\"\n"
"l = b0.HorizontalLine\n"
"l.OuterLineWidth = 9\n"
"b0.HorizontalLine = l\n"
"l.OuterLineWidth = 4\n"
- "testUnfixedVarAssign = b0.HorizontalLine.OuterLineWidth + l.OuterLineWidth\n"
+ "doUnitTest = b0.HorizontalLine.OuterLineWidth + l.OuterLineWidth\n"
"End Function\n"
);
rtl::OUString sTestSource3Alt(
- "Function testUnfixedVarAssign()\n"
+ "Function doUnitTest()\n"
"Dim b0 as new \"com.sun.star.table.TableBorder\"\n"
"l = b0.HorizontalLine\n"
"l.OuterLineWidth = 9\n"
@@ -120,25 +120,25 @@ rtl::OUString sTestSource3Alt(
"Dim result(1)\n"
"result(0) = b0\n"
"result(1) = l\n"
- "testUnfixedVarAssign = result\n"
+ "doUnitTest = result\n"
"End Function\n"
);
// nearly the same as above but this time for a fixed type
// variable
rtl::OUString sTestSource4(
- "Function testFixedVarAssign()\n"
+ "Function doUnitTest()\n"
"Dim b0 as new \"com.sun.star.table.TableBorder\", l as new \"com.sun.star.table.BorderLine\"\n"
"l = b0.HorizontalLine\n"
"l.OuterLineWidth = 9\n"
"b0.HorizontalLine = l\n"
"l.OuterLineWidth = 4\n"
- "testFixedVarAssign = b0.HorizontalLine.OuterLineWidth + l.OuterLineWidth\n"
+ "doUnitTest = b0.HorizontalLine.OuterLineWidth + l.OuterLineWidth\n"
"End Function\n"
);
rtl::OUString sTestSource4Alt(
- "Function testFixedVarAssign()\n"
+ "Function doUnitTest()\n"
"Dim b0 as new \"com.sun.star.table.TableBorder\", l as new \"com.sun.star.table.BorderLine\"\n"
"l = b0.HorizontalLine\n"
"l.OuterLineWidth = 9\n"
@@ -147,7 +147,7 @@ rtl::OUString sTestSource4Alt(
"Dim result(1)\n"
"result(0) = b0\n"
"result(1) = l\n"
- "testFixedVarAssign = result\n"
+ "doUnitTest = result\n"
"End Function\n"
);
@@ -157,49 +157,31 @@ rtl::OUString sTestSource4Alt(
// We need to additionally check the actual uno struct to see if the
// changes made are *really* reflected in the object
rtl::OUString sTestSource5(
- "Function testUnoAccess() as Object\n"
+ "Function doUnitTest() as Object\n"
"Dim aWinDesc as new \"com.sun.star.awt.WindowDescriptor\"\n"
"Dim aRect as new \"com.sun.star.awt.Rectangle\"\n"
"aRect.X = 200\n"
"aWinDesc.Bounds = aRect\n"
- "testUnoAccess = aWinDesc\n"
+ "doUnitTest = aWinDesc\n"
"End Function\n"
);
void Nested_Struct::testAssign1()
{
- CPPUNIT_ASSERT_MESSAGE( "No resource manager", basicDLL().GetBasResMgr() != NULL );
- StarBASICRef pBasic = new StarBASIC();
- ResetError();
- StarBASIC::SetGlobalErrorHdl( LINK( this, Nested_Struct, BasicErrorHdl ) );
-
- SbModule* pMod = pBasic->MakeModule( rtl::OUString( "TestModule" ), sTestSource1 );
- pMod->Compile();
- CPPUNIT_ASSERT_MESSAGE("testAssign1 fails with compile error",!HasError() );
- SbMethod* pMeth = static_cast<SbMethod*>(pMod->Find( rtl::OUString("simpleNestStructAccess"), SbxCLASS_METHOD ));
- CPPUNIT_ASSERT_MESSAGE("testAssign1 no method found", pMeth );
- SbxVariableRef refTemp = pMeth;
- // forces a broadcast
- SbxVariableRef pNew = new SbxMethod( *((SbxMethod*)pMeth));
+ MacroSnippet myMacro( sTestSource1 );
+ myMacro.Compile();
+ CPPUNIT_ASSERT_MESSAGE("testAssign1 fails with compile error",!myMacro.HasError() );
+ SbxVariableRef pNew = myMacro.Run();
CPPUNIT_ASSERT(pNew->GetInteger() == 9 );
}
void Nested_Struct::testAssign1Alt()
{
- CPPUNIT_ASSERT_MESSAGE( "No resource manager", basicDLL().GetBasResMgr() != NULL );
- StarBASICRef pBasic = new StarBASIC();
- ResetError();
- StarBASIC::SetGlobalErrorHdl( LINK( this, Nested_Struct, BasicErrorHdl ) );
-
- SbModule* pMod = pBasic->MakeModule( rtl::OUString( "TestModule" ), sTestSource1Alt );
- pMod->Compile();
- CPPUNIT_ASSERT_MESSAGE("testAssign1Alt fails with compile error",!HasError() );
- SbMethod* pMeth = static_cast<SbMethod*>(pMod->Find( rtl::OUString("simpleNestStructAccess"), SbxCLASS_METHOD ));
- CPPUNIT_ASSERT_MESSAGE("testAssign1Alt no method found", pMeth );
- SbxVariableRef refTemp = pMeth;
- // forces a broadcast
- SbxVariableRef pNew = new SbxMethod( *((SbxMethod*)pMeth));
+ MacroSnippet myMacro( sTestSource1Alt );
+ myMacro.Compile();
+ CPPUNIT_ASSERT_MESSAGE("testAssign1Alt fails with compile error",!myMacro.HasError() );
+ SbxVariableRef pNew = myMacro.Run();
uno::Any aRet = sbxToUnoValue( pNew );
table::TableBorder aBorder;
aRet >>= aBorder;
@@ -210,37 +192,19 @@ void Nested_Struct::testAssign1Alt()
void Nested_Struct::testOldAssign()
{
- CPPUNIT_ASSERT_MESSAGE( "No resource manager", basicDLL().GetBasResMgr() != NULL );
- StarBASICRef pBasic = new StarBASIC();
- ResetError();
- StarBASIC::SetGlobalErrorHdl( LINK( this, Nested_Struct, BasicErrorHdl ) );
-
- SbModule* pMod = pBasic->MakeModule( rtl::OUString( "TestModule" ), sTestSource2 );
- pMod->Compile();
- CPPUNIT_ASSERT_MESSAGE("testOldAssign fails with compile error",!HasError() );
- SbMethod* pMeth = static_cast<SbMethod*>(pMod->Find( rtl::OUString("simpleRegressionTestOld"), SbxCLASS_METHOD ));
- CPPUNIT_ASSERT_MESSAGE("testOldAssign no method found", pMeth );
- SbxVariableRef refTemp = pMeth;
- // forces a broadcast
- SbxVariableRef pNew = new SbxMethod( *((SbxMethod*)pMeth));
+ MacroSnippet myMacro( sTestSource2 );
+ myMacro.Compile();
+ CPPUNIT_ASSERT_MESSAGE("testOldAssign fails with compile error",!myMacro.HasError() );
+ SbxVariableRef pNew = myMacro.Run();
CPPUNIT_ASSERT(pNew->GetInteger() == 9 );
}
void Nested_Struct::testOldAssignAlt()
{
- CPPUNIT_ASSERT_MESSAGE( "No resource manager", basicDLL().GetBasResMgr() != NULL );
- StarBASICRef pBasic = new StarBASIC();
- ResetError();
- StarBASIC::SetGlobalErrorHdl( LINK( this, Nested_Struct, BasicErrorHdl ) );
-
- SbModule* pMod = pBasic->MakeModule( rtl::OUString( "TestModule" ), sTestSource2Alt );
- pMod->Compile();
- CPPUNIT_ASSERT_MESSAGE("testOldAssign fails with compile error",!HasError() );
- SbMethod* pMeth = static_cast<SbMethod*>(pMod->Find( rtl::OUString("simpleRegressionTestOld"), SbxCLASS_METHOD ));
- CPPUNIT_ASSERT_MESSAGE("testOldAssign no method found", pMeth );
- SbxVariableRef refTemp = pMeth;
- // forces a broadcast
- SbxVariableRef pNew = new SbxMethod( *((SbxMethod*)pMeth));
+ MacroSnippet myMacro( sTestSource2Alt );
+ myMacro.Compile();
+ CPPUNIT_ASSERT_MESSAGE("testOldAssign fails with compile error",!myMacro.HasError() );
+ SbxVariableRef pNew = myMacro.Run();
uno::Any aRet = sbxToUnoValue( pNew );
table::TableBorder aBorder;
aRet >>= aBorder;
@@ -251,37 +215,20 @@ void Nested_Struct::testOldAssignAlt()
void Nested_Struct::testUnfixedVarAssign()
{
- CPPUNIT_ASSERT_MESSAGE( "No resource manager", basicDLL().GetBasResMgr() != NULL );
- StarBASICRef pBasic = new StarBASIC();
- ResetError();
- StarBASIC::SetGlobalErrorHdl( LINK( this, Nested_Struct, BasicErrorHdl ) );
-
- SbModule* pMod = pBasic->MakeModule( rtl::OUString( "TestModule" ), sTestSource3 );
- pMod->Compile();
- CPPUNIT_ASSERT_MESSAGE("testUnfixedVarAssign fails with compile error",!HasError() );
- SbMethod* pMeth = static_cast<SbMethod*>(pMod->Find( rtl::OUString("testUnfixedVarAssign"), SbxCLASS_METHOD ));
- CPPUNIT_ASSERT_MESSAGE("testUnfixedVarAssign no method found", pMeth );
- SbxVariableRef refTemp = pMeth;
+ MacroSnippet myMacro( sTestSource3 );
+ myMacro.Compile();
+ CPPUNIT_ASSERT_MESSAGE("testUnfixedVarAssign fails with compile error",!myMacro.HasError() );
// forces a broadcast
- SbxVariableRef pNew = new SbxMethod( *((SbxMethod*)pMeth));
+ SbxVariableRef pNew = myMacro.Run();
CPPUNIT_ASSERT(pNew->GetInteger() == 13 );
}
void Nested_Struct::testUnfixedVarAssignAlt()
{
- CPPUNIT_ASSERT_MESSAGE( "No resource manager", basicDLL().GetBasResMgr() != NULL );
- StarBASICRef pBasic = new StarBASIC();
- ResetError();
- StarBASIC::SetGlobalErrorHdl( LINK( this, Nested_Struct, BasicErrorHdl ) );
-
- SbModule* pMod = pBasic->MakeModule( rtl::OUString( "TestModule" ), sTestSource3Alt );
- pMod->Compile();
- CPPUNIT_ASSERT_MESSAGE("testUnfixedVarAssignAlt fails with compile error",!HasError() );
- SbMethod* pMeth = static_cast<SbMethod*>(pMod->Find( rtl::OUString("testUnfixedVarAssign"), SbxCLASS_METHOD ));
- CPPUNIT_ASSERT_MESSAGE("testUnfixedVarAssignAlt no method found", pMeth );
- SbxVariableRef refTemp = pMeth;
- // forces a broadcast
- SbxVariableRef pNew = new SbxMethod( *((SbxMethod*)pMeth));
+ MacroSnippet myMacro( sTestSource3Alt );
+ myMacro.Compile();
+ CPPUNIT_ASSERT_MESSAGE("testUnfixedVarAssignAlt fails with compile error",!myMacro.HasError() );
+ SbxVariableRef pNew = myMacro.Run();
uno::Any aRet = sbxToUnoValue( pNew );
uno::Sequence< uno::Any > aResult;
@@ -305,37 +252,19 @@ void Nested_Struct::testUnfixedVarAssignAlt()
void Nested_Struct::testFixedVarAssign()
{
- CPPUNIT_ASSERT_MESSAGE( "No resource manager", basicDLL().GetBasResMgr() != NULL );
- StarBASICRef pBasic = new StarBASIC();
- ResetError();
- StarBASIC::SetGlobalErrorHdl( LINK( this, Nested_Struct, BasicErrorHdl ) );
-
- SbModule* pMod = pBasic->MakeModule( rtl::OUString( "TestModule" ), sTestSource4 );
- pMod->Compile();
- CPPUNIT_ASSERT_MESSAGE("testFixedVarAssign fails with compile error",!HasError() );
- SbMethod* pMeth = static_cast<SbMethod*>(pMod->Find( rtl::OUString("testFixedVarAssign"), SbxCLASS_METHOD ));
- CPPUNIT_ASSERT_MESSAGE("testFixedVarAssign no method found", pMeth );
- SbxVariableRef refTemp = pMeth;
- // forces a broadcast
- SbxVariableRef pNew = new SbxMethod( *((SbxMethod*)pMeth));
+ MacroSnippet myMacro( sTestSource4 );
+ myMacro.Compile();
+ CPPUNIT_ASSERT_MESSAGE("testFixedVarAssign fails with compile error",!myMacro.HasError() );
+ SbxVariableRef pNew = myMacro.Run();
CPPUNIT_ASSERT(pNew->GetInteger() == 13 );
}
void Nested_Struct::testFixedVarAssignAlt()
{
- CPPUNIT_ASSERT_MESSAGE( "No resource manager", basicDLL().GetBasResMgr() != NULL );
- StarBASICRef pBasic = new StarBASIC();
- ResetError();
- StarBASIC::SetGlobalErrorHdl( LINK( this, Nested_Struct, BasicErrorHdl ) );
-
- SbModule* pMod = pBasic->MakeModule( rtl::OUString( "TestModule" ), sTestSource4Alt );
- pMod->Compile();
- CPPUNIT_ASSERT_MESSAGE("testFixedVarAssignAlt fails with compile error",!HasError() );
- SbMethod* pMeth = static_cast<SbMethod*>(pMod->Find( rtl::OUString("testFixedVarAssign"), SbxCLASS_METHOD ));
- CPPUNIT_ASSERT_MESSAGE("testFixedVarAssignAlt no method found", pMeth );
- SbxVariableRef refTemp = pMeth;
- // forces a broadcast
- SbxVariableRef pNew = new SbxMethod( *((SbxMethod*)pMeth));
+ MacroSnippet myMacro( sTestSource4Alt );
+ myMacro.Compile();
+ CPPUNIT_ASSERT_MESSAGE("testFixedVarAssignAlt fails with compile error",!myMacro.HasError() );
+ SbxVariableRef pNew = myMacro.Run();
uno::Any aRet = sbxToUnoValue( pNew );
uno::Sequence< uno::Any > aResult;
@@ -359,19 +288,10 @@ void Nested_Struct::testFixedVarAssignAlt()
void Nested_Struct::testUnoAccess()
{
- CPPUNIT_ASSERT_MESSAGE( "No resource manager", basicDLL().GetBasResMgr() != NULL );
- StarBASICRef pBasic = new StarBASIC();
- ResetError();
- StarBASIC::SetGlobalErrorHdl( LINK( this, Nested_Struct, BasicErrorHdl ) );
-
- SbModule* pMod = pBasic->MakeModule( rtl::OUString( "TestModule" ), sTestSource5 );
- pMod->Compile();
- CPPUNIT_ASSERT_MESSAGE("testUnoAccess fails with compile error",!HasError() );
- SbMethod* pMeth = static_cast<SbMethod*>(pMod->Find( rtl::OUString("testUnoAccess"), SbxCLASS_METHOD ));
- CPPUNIT_ASSERT_MESSAGE("testUnoAccess no method found", pMeth );
- SbxVariableRef refTemp = pMeth;
- // forces a broadcast
- SbxVariableRef pNew = new SbxMethod( *((SbxMethod*)pMeth));
+ MacroSnippet myMacro( sTestSource5 );
+ myMacro.Compile();
+ CPPUNIT_ASSERT_MESSAGE("testUnoAccess fails with compile error",!myMacro.HasError() );
+ SbxVariableRef pNew = myMacro.Run();
uno::Any aRet = sbxToUnoValue( pNew );
awt::WindowDescriptor aWinDesc;
aRet >>= aWinDesc;
diff --git a/basic/qa/cppunit/test_vba.cxx b/basic/qa/cppunit/test_vba.cxx
new file mode 100644
index 0000000..abb929f
--- /dev/null
+++ b/basic/qa/cppunit/test_vba.cxx
@@ -0,0 +1,153 @@
+/* -*- Mode: C++; tab-width: 4; indent-tabs-mode: nil; c-basic-offset: 4 -*- */
+/*
+ * Copyright 2012 LibreOffice contributors.
+ *
+ * This Source Code Form is subject to the terms of the Mozilla Public
+ * License, v. 2.0. If a copy of the MPL was not distributed with this
+ * file, You can obtain one at http://mozilla.org/MPL/2.0/.
+ */
+#include "basictest.hxx"
+#include <vcl/svapp.hxx>
+#include <comphelper/processfactory.hxx>
+using namespace ::com::sun::star;
+
+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);
+// not much point even trying to run except on windows
+#if defined(WNT)
+ CPPUNIT_TEST(testObjAssignWithDefaultMember);
+#endif
+
+ // End of test suite definition
+ CPPUNIT_TEST_SUITE_END();
+
+ };
+
+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(
+ "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",
+// 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",
+ "partition.vb",
+ "strconv.vb",
+ "dateserial.vb",
+ "format.vb",
+ "replace.vb",
+ "stringplusdouble.vb"
+ };
+ OUString sMacroPathURL = getURLFromSrc("/basic/qa/vba_tests/");
+ // Some test data expects the uk locale
+ AllSettings aSettings = Application::GetSettings();
+ aSettings.SetLanguageTag( LanguageTag( LANGUAGE_ENGLISH_UK ) );
+ Application::SetSettings( aSettings );
+ for ( sal_uInt32 i=0; i<SAL_N_ELEMENTS( macroSource ); ++i )
+ {
+ OUString sMacroURL( sMacroPathURL );
+ sMacroURL += OUString::createFromAscii( macroSource[ i ] );
+
+ MacroSnippet myMacro;
+ myMacro.LoadSourceFromFile( sMacroURL );
+ SbxVariableRef pReturn = myMacro.Run();
+ if ( pReturn )
+ {
+ fprintf(stderr, "macro result for %s\n", macroSource[ i ] );
+ 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() == "OK" );
+ }
+}
+
+void VBATest::testObjAssignWithDefaultMember()
+{
+ bool bCanRunOleTests = hasOLEEnv();
+ if ( !bCanRunOleTests )
+ return; // can't do anything, skip test
+
+ const char* macroSource[] = {
+ "ole_ObjAssignNoDflt.vb",
+ "ole_ObjAssignToNothing.vb",
+ };
+
+ OUString sMacroPathURL = getURLFromSrc("/basic/qa/vba_tests/");
+
+ uno::Sequence< uno::Any > aArgs(1);
+ // path to test document
+ 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 )
+ {
+ 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", 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() == "OK" );
+ }
+}
+
+ // Put the test suite in the registry
+
+ // Put the test suite in the registry
+ CPPUNIT_TEST_SUITE_REGISTRATION(VBATest);
+} // namespace
+CPPUNIT_PLUGIN_IMPLEMENT();
+
+/* vim:set shiftwidth=4 softtabstop=4 expandtab: */
diff --git a/basic/qa/vba_tests/bytearraystring.vb b/basic/qa/vba_tests/bytearraystring.vb
new file mode 100644
index 0000000..a4054d4
--- /dev/null
+++ b/basic/qa/vba_tests/bytearraystring.vb
@@ -0,0 +1,68 @@
+Option VBASupport 1
+Option Explicit
+
+Dim passCount As Integer
+Dim failCount As Integer
+Dim displayMessage As Boolean
+Dim thisTest As String
+
+Function doUnitTest() As String
+Dim result As String
+result = verify_ByteArrayString()
+If failCount <> 0 Then
+ doUnitTest = result
+Else
+ doUnitTest = "OK"
+End If
+End Function
+
+Sub Main()
+MsgBox verify_ByteArrayString()
+End Sub
+
+Function verify_ByteArrayString() As String
+ passCount = 0
+ failCount = 0
+ Dim result As String
+
+ Dim testName As String
+ Dim MyString As String
+ Dim x() As Byte
+ Dim count As Integer
+ testName = "Test the conversion between bytearray and string"
+
+
+ On Error GoTo errorHandler
+
+ MyString = "abc"
+ x = MyString ' string -> byte array
+
+ result = "Test Results" & Chr$(10) & "============" & Chr$(10)
+
+ count = UBound(x) ' 6 byte
+
+ ' test bytes in string
+ result = result + updateResultString("test1 numbytes ", (count), 5)
+
+
+ MyString = x 'byte array -> string
+ result = result + updateResultString("test assign byte array to string", MyString, "abc")
+
+ result = result & Chr$(10) & "Tests passed: " & passCount & Chr$(10) & "Tests failed: " & failCount & Chr$(10)
+ verify_ByteArrayString = result
+ Exit Function
+errorHandler:
+ failCount = failCount + 1
+ verify_ByteArrayString = "Error Handler hit"
+End Function
+
+Function updateResultString(testDesc As String, actual As String, expected As String) As String
+Dim result As String
+If actual <> expected Then
+ result = result & Chr$(10) & testDesc & " Failed: expected " & expected & " got " & actual
+ failCount = failCount + 1
+Else
+ passCount = passCount + 1
+End If
+updateResultString = result
+End Function
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/dateserial.vb b/basic/qa/vba_tests/dateserial.vb
new file mode 100644
index 0000000..9df5ae2
--- /dev/null
+++ b/basic/qa/vba_tests/dateserial.vb
@@ -0,0 +1,65 @@
+Option VBASupport 1
+Option Explicit
+
+Dim passCount As Integer
+Dim failCount As Integer
+Dim result As String
+
+Function doUnitTest() As String
+result = verify_testDateSerial()
+If failCount <> 0 And passCount > 0 Then
+ doUnitTest = result
+Else
+ doUnitTest = "OK"
+End If
+End Function
+
+Function verify_testDateSerial() as String
+ Dim testName As String
+ Dim TestDateTime As Date
+ Dim TestStr As String
+ Dim date1, date2 As Date
+ passCount = 0
+ failCount = 0
+
+ result = "Test Results" & Chr$(10) & "============" & Chr$(10)
+
+ testName = "Test DateSerial function"
+ date2 = 36326
+
+ On Error GoTo errorHandler
+
+ date1 = DateSerial(1999, 6, 15) '6/15/1999
+ TestLog_ASSERT date1 = date2, "the return date is: " & date1
+ date1 = DateSerial(2000, 1 - 7, 15) '6/15/1999
+ TestLog_ASSERT date1 = date2, "the return date is: " & date1
+ date1 = DateSerial(1999, 1, 166) '6/15/1999
+ TestLog_ASSERT date1 = date2, "the return date is: " & date1
+ result = result & Chr$(10) & "Tests passed: " & passCount & Chr$(10) & "Tests failed: " & failCount & Chr$(10)
+
+ verify_testDateSerial = result
+
+ Exit Function
+errorHandler:
+ TestLog_ASSERT (False), testName & ": hit error handler"
+End Function
+
+Sub TestLog_ASSERT(assertion As Boolean, Optional testId As String, Optional testComment As String)
+
+ If assertion = True Then
+ passCount = passCount + 1
+ Else
+ Dim testMsg As String
+ If Not IsMissing(testId) Then
+ testMsg = testMsg + " : " + testId
+ End If
+ If Not IsMissing(testComment) And Not (testComment = "") Then
+ testMsg = testMsg + " (" + testComment + ")"
+ End If
+
+ result = result & Chr$(10) & " Failed: " & testMsg
+ failCount = failCount + 1
+ End If
+
+End Sub
+
diff --git a/basic/qa/vba_tests/datevalue.vb b/basic/qa/vba_tests/datevalue.vb
new file mode 100644
index 0000000..20aac64
--- /dev/null
+++ b/basic/qa/vba_tests/datevalue.vb
@@ -0,0 +1,65 @@
+Option VBASupport 1
+Option Explicit
+Dim passCount As Integer
+Dim failCount As Integer
+Dim result As String
+
+Function doUnitTest() As String
+result = verify_testDateValue()
+If failCount <> 0 And passCount > 0 Then
+ doUnitTest = result
+Else
+ doUnitTest = "OK"
+End If
+End Function
+
+
+
+Function verify_testDateValue() as String
+
+ passCount = 0
+ failCount = 0
+
+ result = "Test Results" & Chr$(10) & "============" & Chr$(10)
+
+ Dim testName As String
+ Dim TestDateTime As Date
+ Dim TestStr As String
+ Dim date1, date2 As Date
+ testName = "Test DateValue function"
+ date2 = 25246
+
+ On Error GoTo errorHandler
+
+ date1 = DateValue("February 12, 1969") '2/12/1969
+ TestLog_ASSERT date1 = date2, "the return date is: " & date1
+
+ date2 = 39468
+ date1 = DateValue("21/01/2008") '1/21/2008
+ TestLog_ASSERT date1 = date2, "the return date is: " & date1
+ result = result & Chr$(10) & "Tests passed: " & passCount & Chr$(10) & "Tests failed: " & failCount & Chr$(10)
+ verify_testDateValue = result
+
+ Exit Function
+errorHandler:
+ TestLog_ASSERT (False), testName & ": hit error handler"
+End Sub
+
+Sub TestLog_ASSERT(assertion As Boolean, Optional testId As String, Optional testComment As String)
+
+ If assertion = True Then
+ passCount = passCount + 1
+ Else
+ Dim testMsg As String
+ If Not IsMissing(testId) Then
+ testMsg = testMsg + " : " + testId
+ End If
+ If Not IsMissing(testComment) And Not (testComment = "") Then
+ testMsg = testMsg + " (" + testComment + ")"
+ End If
+
+ result = result & Chr$(10) & " Failed: " & testMsg
+ failCount = failCount + 1
+ End If
+
+End Sub
diff --git a/basic/qa/vba_tests/format.vb b/basic/qa/vba_tests/format.vb
new file mode 100644
index 0000000..b4f1928
--- /dev/null
+++ b/basic/qa/vba_tests/format.vb
@@ -0,0 +1,406 @@
+Option VBASupport 1
+Option Explicit
+
+Dim passCount As Integer
+Dim failCount As Integer
+Dim result As String
+
+Function doUnitTest() As String
+result = verify_format()
+If failCount <> 0 And passCount > 0 Then
+ doUnitTest = result
+Else
+ doUnitTest = "OK"
+End If
+End Function
+
+Function verify_format() as String
+ passCount = 0
+ failCount = 0
+
+ result = "Test Results" & Chr$(10) & "============" & Chr$(10)
+
+ 'Predefined_Datetime_Format_Sample
+ Predefined_Number_Format_Sample
+ 'Custom_Datetime_Format_Sample
+ Custom_Number_Format_Sample
+ Custom_Text_Format_Sample
+ result = result & Chr$(10) & "Tests passed: " & passCount & Chr$(10) & "Tests failed: " & failCount & Chr$(10)
+ verify_format = result
+
+End Sub
+
+
+Sub Predefined_Datetime_Format_Sample()
+ Dim testName As String
+ Dim myDate, MyTime, TestStr As String
+ myDate = "01/06/98"
+ MyTime = "17:08:06"
+ testName = "Test Predefined_Datetime_Format_Sample function"
+
+ On Error GoTo errorHandler
+
+ ' The date/time format have a little different between ms office and OOo due to different locale and system...
+ TestStr = Format(myDate, "General Date") ' 1/6/98
+
+ TestLog_ASSERT IsDate(TestStr), "General Date: " & TestStr & " (Test only applies to en_US locale)"
+ 'TestLog_ASSERT TestStr = "1/6/98", "General Date: " & TestStr
+
+ TestStr = Format(myDate, "Long Date") ' Tuesday, January 06, 1998
+ TestLog_ASSERT TestStr = "Tuesday, January 06, 1998", "Long Date: " & TestStr & " (Test only applies to en_US locale)"
+ 'TestLog_ASSERT IsDate(TestStr), "Long Date: " & TestStr
+
+ TestStr = Format(myDate, "Medium Date") ' 06-Jan-98
+ 'TestLog_ASSERT TestStr = "06-Jan-98", "Medium Date: " & TestStr
+ TestLog_ASSERT IsDate(TestStr), "Medium Date: " & TestStr & " (Test only applies to en_US locale)"
+
+
+ TestStr = Format(myDate, "Short Date") ' 1/6/98
+ 'TestLog_ASSERT TestStr = "1/6/98", "Short Date: " & TestStr
+ TestLog_ASSERT IsDate(TestStr), "Short Date: " & TestStr & " (Test only applies to en_US locale)"
+
+ TestStr = Format(MyTime, "Long Time") ' 5:08:06 PM
+ 'TestLog_ASSERT TestStr = "5:08:06 PM", "Long Time: " & TestStr
+ TestLog_ASSERT IsDate(TestStr), "Long Time: " & TestStr & " (Test only applies to en_US locale)"
+
+
+ TestStr = Format(MyTime, "Medium Time") ' 05:08 PM
+ 'TestLog_ASSERT TestStr = "05:08 PM", "Medium Time: " & TestStr
+ TestLog_ASSERT IsDate(TestStr), "Medium Time: " & TestStr & " (Test only applies to en_US locale)"
+
+
+ TestStr = Format(MyTime, "Short Time") ' 17:08
+ 'TestLog_ASSERT TestStr = "17:08", "Short Time: " & TestStr
+ TestLog_ASSERT IsDate(TestStr), "Short Time: " & TestStr & " (Test only applies to en_US locale)"
+ Exit Sub
+errorHandler:
+ TestLog_ASSERT (false), testName & ": hit error handler"
+End Sub
+
+Sub Predefined_Number_Format_Sample()
+ Dim myNumber, TestStr As String
+ Dim testName As String
+ testName = "Test Predefined_Number_Format_Sample function"
+ myNumber = 562486.2356
+
+ On Error GoTo errorHandler
+
+ TestStr = Format(myNumber, "General Number") '562486.2356
+ TestLog_ASSERT TestStr = "562486.2356", "General Number: " & TestStr
+ 'MsgBox TestStr
+
+ TestStr = Format(0.2, "Fixed") '0.20
+ TestLog_ASSERT TestStr = "0.20", "Fixed: " & TestStr
+ 'MsgBox TestStr
+
+ TestStr = Format(myNumber, "Standard") '562,486.24
+ TestLog_ASSERT TestStr = "562,486.24", "Standard: " & TestStr
+ 'MsgBox TestStr
+
+ TestStr = Format(0.7521, "Percent") '75.21%
+ TestLog_ASSERT TestStr = "75.21%", "Percent: " & TestStr
+ 'MsgBox TestStr
+
+ TestStr = Format(myNumber, "Scientific") '5.62E+05
+ TestLog_ASSERT TestStr = "5.62E+05", "Scientific: " & TestStr
+ 'MsgBox TestStr
+
+ TestStr = Format(-3456.789, "Scientific") '-3.46E+03
+ TestLog_ASSERT TestStr = "-3.46E+03", "Scientific: " & TestStr
+ 'MsgBox TestStr
+
+ TestStr = Format(0, "Yes/No") 'No
+ TestLog_ASSERT TestStr = "No", "Yes/No: " & TestStr
+ 'MsgBox TestStr
+
+ TestStr = Format(23, "Yes/No") 'Yes
+ TestLog_ASSERT TestStr = "Yes", "Yes/No: " & TestStr
+ 'MsgBox TestStr
+
+ TestStr = Format(0, "True/False") 'False
+ TestLog_ASSERT TestStr = "False", "True/False: " & TestStr
+ 'MsgBox TestStr
+
+ TestStr = Format(23, "True/False") 'True
+ TestLog_ASSERT TestStr = "True", "True/False: " & TestStr
+ 'MsgBox TestStr
+
+ TestStr = Format(0, "On/Off") 'Off
+ TestLog_ASSERT TestStr = "Off", "On/Off: " & TestStr
+ 'MsgBox TestStr
+
+ TestStr = Format(23, "On/Off") 'On
+ TestLog_ASSERT TestStr = "On", "On/Off: " & TestStr
+ 'MsgBox TestStr
+
+ Exit Sub
+errorHandler:
+ TestLog_ASSERT (false), testName & ": hit error handler"
+
+End Sub
+
+Sub Custom_Datetime_Format_Sample()
+ Dim myDate, MyTime, TestStr As String
+ Dim testName As String
+
+ myDate = "01/06/98"
+ MyTime = "05:08:06"
+
+ testName = "Test Custom_Datetime_Format_Sample function"
+ On Error GoTo errorHandler
+
+ TestStr = Format("01/06/98 17:08:06", "c") ' 1/6/98 5:08:06 PM
+ TestLog_ASSERT TestStr = "1/6/98 5:08:06 PM", "c: " & TestStr & " (Test only applies to en_US locale)"
+ 'MsgBox TestStr
+
+ TestStr = Format(myDate, "dddddd") ' (Long Date), Tuesday, January 06, 1998
+ TestLog_ASSERT TestStr = "Tuesday, January 06, 1998", "dddddd: " & TestStr & " (Test only applies to en_US locale)"
+ 'MsgBox TestStr
+
+ TestStr = Format(myDate, "mm-dd-yyyy") ' 01-06-19s98
+ TestLog_ASSERT TestStr = "01-06-1998", "mm-dd-yyyy: " & TestStr & " (Test only applies to en_US locale)"
+ 'MsgBox TestStr
+
+ TestStr = Format(myDate, "d") ' 6
+ TestLog_ASSERT TestStr = "6", "d: " & TestStr & " (Test only applies to en_US locale)"
+ 'MsgBox TestStr
+
+ TestStr = Format(myDate, "dd") ' 06
+ TestLog_ASSERT TestStr = "06", "dd: " & TestStr & " (Test only applies to en_US locale)"
+ 'MsgBox TestStr
+
+ TestStr = Format(myDate, "ddd") ' Tue
+ TestLog_ASSERT TestStr = "Tue", "ddd: " & TestStr & " (Test only applies to en_US locale)"
+ 'MsgBox TestStr
+
+ TestStr = Format(myDate, "dddd") ' Tuesday
+ TestLog_ASSERT TestStr = "Tuesday", "dddd: " & TestStr & " (Test only applies to en_US locale)"
+ 'MsgBox TestStr
+
+ TestStr = Format(MyTime, "h") ' 5
+ TestLog_ASSERT TestStr = "5", "h: " & TestStr & " (Test only applies to en_US locale)"
+ 'MsgBox TestStr
+
+ TestStr = Format(MyTime, "hh") ' 05
+ TestLog_ASSERT TestStr = "05", "hh: " & TestStr & " (Test only applies to en_US locale)"
+ 'MsgBox TestStr
+
+ TestStr = Format(MyTime, "n") ' 8
+ TestLog_ASSERT TestStr = "8", "n: " & TestStr & " (Test only applies to en_US locale)"
+ 'MsgBox TestStr
+
+ TestStr = Format(MyTime, "nn") ' 08
+ TestLog_ASSERT TestStr = "08", "nn: " & TestStr & " (Test only applies to en_US locale)"
+ 'MsgBox TestStr
+
+ TestStr = Format(myDate, "m") ' 1
+ TestLog_ASSERT TestStr = "1", "m: " & TestStr & " (Test only applies to en_US locale)"
+ 'MsgBox TestStr
+
+ TestStr = Format(myDate, "mm") ' 01
+ TestLog_ASSERT TestStr = "01", "mm: " & TestStr & " (Test only applies to en_US locale)"
+ 'MsgBox TestStr
+
+ TestStr = Format(myDate, "mmm") ' Jan
+ TestLog_ASSERT TestStr = "Jan", "mmm: " & TestStr & " (Test only applies to en_US locale)"
+ 'MsgBox TestStr
+
+ TestStr = Format(myDate, "mmmm") ' January
+ TestLog_ASSERT TestStr = "January", "mmmm: " & TestStr & " (Test only applies to en_US locale)"
+ 'MsgBox TestStr
+
+ TestStr = Format(MyTime, "s") ' 6
+ TestLog_ASSERT TestStr = "6", "s: " & TestStr & " (Test only applies to en_US locale)"
+ 'MsgBox TestStr
+
+ TestStr = Format(MyTime, "ss") ' 06
+ TestLog_ASSERT TestStr = "06", "ss: " & TestStr & " (Test only applies to en_US locale)"
+ 'MsgBox TestStr
+
+
+ MyTime = "17:08:06"
+
+ TestStr = Format(MyTime, "hh:mm:ss AM/PM") ' 05:08:06 PM
+ TestLog_ASSERT TestStr = "05:08:06 PM", "hh:mm:ss AM/PM: " & TestStr & " (Test only applies to en_US locale)"
+
+
+ TestStr = Format(MyTime, "hh:mm:ss") ' 17:08:06
+ TestLog_ASSERT TestStr = "17:08:06", "hh:mm:ss: " & TestStr & " (Test only applies to en_US locale)"
+ 'MsgBox TestStr
+
+ TestStr = Format(myDate, "ww") ' 2
+ TestLog_ASSERT TestStr = "2", "ww: " & TestStr & " (Test only applies to en_US locale)"
+ 'MsgBox TestStr
+
+ TestStr = Format(myDate, "w") ' 3
+ TestLog_ASSERT TestStr = "3", "w: " & TestStr & " (Test only applies to en_US locale)"
+ 'MsgBox TestStr
+
+ TestStr = Format(myDate, "y") ' 6
+ TestLog_ASSERT TestStr = "6", "y: " & TestStr & " (Test only applies to en_US locale)"
+ 'MsgBox TestStr
+
+ TestStr = Format(myDate, "yy") ' 98
+ TestLog_ASSERT TestStr = "98", "yy: " & TestStr & " (Test only applies to en_US locale)"
+ 'MsgBox TestStr
+
+ TestStr = Format(myDate, "yyyy") ' 1998
+ TestLog_ASSERT TestStr = "1998", "yyyy: " & TestStr & " (Test only applies to en_US locale)"
+ 'MsgBox TestStr
+
+ Exit Sub
+errorHandler:
+ TestLog_ASSERT (false), testName & ": hit error handler"
+End Sub
+
+Sub Custom_Number_Format_Sample()
+ Dim TestStr As String
+ Dim testName As String
+
+ testName = "Test Custom_Number_Format_Sample function"
+ On Error GoTo errorHandler
+
+ TestStr = Format(23.675, "00.0000") ' 23.6750
+ TestLog_ASSERT TestStr = "23.6750", "00.0000: " & TestStr
+ 'MsgBox TestStr
+
+ TestStr = Format(23.675, "00.00") ' 23.68
+ TestLog_ASSERT TestStr = "23.68", "00.00: " & TestStr
+ 'MsgBox TestStr
+
+ TestStr = Format(2658, "00000") ' 02658
+ TestLog_ASSERT TestStr = "02658", "00000: " & TestStr
+ 'MsgBox TestStr
+
+ TestStr = Format(2658, "00.00") ' 2658.00
+ TestLog_ASSERT TestStr = "2658.00", "00.00: " & TestStr
+ 'MsgBox TestStr
+
+ TestStr = Format(23.675, "##.####") ' 23.675
+ TestLog_ASSERT TestStr = "23.675", "##.####: " & TestStr
+ 'MsgBox TestStr
+
+ TestStr = Format(23.675, "##.##") ' 23.68
+ TestLog_ASSERT TestStr = "23.68", "##.##: " & TestStr
+ 'MsgBox TestStr
+
+ TestStr = Format(12345.25, "#,###.##") '12,345.25
+ TestLog_ASSERT TestStr = "12,345.25", "#,###.##: " & TestStr
+ 'MsgBox TestStr
+
+ TestStr = Format(0.25, "##.00%") '25.00%
+ TestLog_ASSERT TestStr = "25.00%", "##.00%: " & TestStr
+ 'MsgBox TestStr
+
+ TestStr = Format(1000000, "#,###") '1,000,000
+ TestLog_ASSERT TestStr = "1,000,000", "#,###: " & TestStr
+ 'MsgBox TestStr
+
+ TestStr = Format(1.09837555, "######E-###") '109838E-5
+ TestLog_ASSERT TestStr = "109838E-5", "######E-###: " & TestStr
+ 'MsgBox TestStr
+
+ TestStr = Format(2345.25, "$#,###.##") '$2.345.25
+ TestLog_ASSERT TestStr = "$2,345.25", "$#,###.##: " & TestStr
+ 'MsgBox TestStr
+
+ TestStr = Format(0.25, "##.###\%") '.25%
+ TestLog_ASSERT TestStr = ".25%", "##.###\%: " & TestStr
+ 'MsgBox TestStr
+
+ Exit Sub
+errorHandler:
+ TestLog_ASSERT (false), testName & ": hit error handler"
+End Sub
+
+Sub Custom_Text_Format_Sample()
+ Dim myText, TestStr As String
+ myText = "VBA"
+
+ Dim testName As String
+
+ testName = "Test Custom_Text_Format_Sample function"
+ On Error GoTo errorHandler
+
+ TestStr = Format(myText, "<") 'vba
+ TestLog_ASSERT TestStr = "vba", "<: " & TestStr
+ 'MsgBox TestStr
+
+ TestStr = Format("vba", ">") 'VBA
+ TestLog_ASSERT TestStr = "VBA", ">: " & TestStr
+ 'MsgBox TestStr
+
+ Exit Sub
+errorHandler:
+ TestLog_ASSERT (false), testName & "hit error handler"
+End Sub
+
+
+
+Sub testFormat()
+ Dim testName As String
+ Dim TestDateTime As Date
+ Dim TestStr As String
+ testName = "Test Format function"
+
+ On Error GoTo errorHandler
+
+ TestDateTime = "1/27/2001 5:04:23 PM"
+
+ ' Returns the value of TestDateTime in user-defined date/time formats.
+ ' Returns "17:4:23".
+ TestStr = Format(TestDateTime, "h:m:s")
+ TestLog_ASSERT TestStr = "17:4:23", "the format of h:m:s: " & TestStr
+
+ ' Returns "05:04:23 PM".
+ TestStr = Format(TestDateTime, "ttttt")
+ TestLog_ASSERT TestStr = "5:04:23 PM", "the format of ttttt: " & TestStr
+
+ ' Returns "Saturday, Jan 27 2001".
+ TestStr = Format(TestDateTime, "dddd, MMM d yyyy")
+ TestLog_ASSERT TestStr = "Saturday, Jan 27 2001", "the format of dddd, MMM d yyyy: " & TestStr
+
+ ' Returns "17:04:23".
+ TestStr = Format(TestDateTime, "HH:mm:ss")
+ TestLog_ASSERT TestStr = "17:04:23", "the format of HH:mm:ss: " & TestStr
+
+ ' Returns "23".
+ TestStr = Format(23)
+ TestLog_ASSERT TestStr = "23", "no format:" & TestStr
+
+ ' User-defined numeric formats.
+ ' Returns "5,459.40".
+ TestStr = Format(5459.4, "##,##0.00")
+ TestLog_ASSERT TestStr = "5,459.40", "the format of ##,##0.00: " & TestStr
+
+ ' Returns "334.90".
+ TestStr = Format(334.9, "###0.00")
+ TestLog_ASSERT TestStr = "334.90", "the format of ###0.00: " & TestStr
+
+ ' Returns "500.00%".
+ TestStr = Format(5, "0.00%")
+ TestLog_ASSERT TestStr = "500.00%", "the format of 0.00%: " & TestStr
+ Exit Sub
+errorHandler:
+ TestLog_ASSERT (false), testName & ": hit error handler"
+End Sub
+
+Sub TestLog_ASSERT(assertion As Boolean, Optional testId As String, Optional testComment As String)
+
+ If assertion = True Then
+ passCount = passCount + 1
+ Else
+ Dim testMsg As String
+ If Not IsMissing(testId) Then
+ testMsg = testMsg + " : " + testId
+ End If
+ If Not IsMissing(testComment) And Not (testComment = "") Then
+ testMsg = testMsg + " (" + testComment + ")"
+ End If
+
+ result = result & Chr$(10) & " Failed: " & testMsg
+ failCount = failCount + 1
+ End If
+
+End Sub
+
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
diff --git a/basic/qa/vba_tests/partition.vb b/basic/qa/vba_tests/partition.vb
new file mode 100644
index 0000000..821cdeb
--- /dev/null
+++ b/basic/qa/vba_tests/partition.vb
@@ -0,0 +1,71 @@
+Option VBASupport 1
+Option Explicit
+Dim passCount As Integer
+Dim failCount As Integer
+Dim result As String
+
+Function doUnitTest() As String
+result = verify_testPartition()
+If failCount <> 0 And passCount > 0 Then
+ doUnitTest = result
+Else
+ doUnitTest = "OK"
+End If
+End Function
+
+Function verify_testPartition() as String
+ passCount = 0
+ failCount = 0
+
+ result = "Test Results" & Chr$(10) & "============" & Chr$(10)
+
+
+ Dim testName As String
+ Dim retStr As String
+ testName = "Test Partition function"
+ On Error GoTo errorHandler
+
+ retStr = Partition(20, 0, 98, 5)
+ 'MsgBox retStr
+ TestLog_ASSERT retStr = "20:24", "the number 20 occurs in the range:" & retStr
+
+ retStr = Partition(20, 0, 99, 1)
+ 'MsgBox retStr
+ TestLog_ASSERT retStr = " 20: 20", "the number 20 occurs in the range:" & retStr
+
+ retStr = Partition(120, 0, 99, 5)
+ 'MsgBox retStr
+ TestLog_ASSERT retStr = "100: ", "the number 120 occurs in the range:" & retStr
+
+ retStr = Partition(-5, 0, 99, 5)
+ 'MsgBox retStr
+ TestLog_ASSERT retStr = " : -1", "the number -5 occurs in the range:" & retStr
+
+ retStr = Partition(2, 0, 5, 2)
+ 'MsgBox retStr
+ TestLog_ASSERT retStr = " 2: 3", "the number 2 occurs in the range:" & retStr
+ result = result & Chr$(10) & "Tests passed: " & passCount & Chr$(10) & "Tests failed: " & failCount & Chr$(10)
+ verify_testPartition = result
+ Exit Function
+errorHandler:
+ TestLog_ASSERT (false), "vertify_testPartion failed, hit error handler"
+End Function
+
+Sub TestLog_ASSERT(assertion As Boolean, Optional testId As String, Optional testComment As String)
+
+ If assertion = True Then
+ passCount = passCount + 1
+ Else
+ Dim testMsg As String
+ If Not IsMissing(testId) Then
+ testMsg = testMsg + " : " + testId
+ End If
+ If Not IsMissing(testComment) And Not (testComment = "") Then
+ testMsg = testMsg + " (" + testComment + ")"
+ End If
+
+ result = result & Chr$(10) & " Failed: " & testMsg
+ failCount = failCount + 1
+ End If
+
+End Sub
diff --git a/basic/qa/vba_tests/replace.vb b/basic/qa/vba_tests/replace.vb
new file mode 100644
index 0000000..e04cde0
--- /dev/null
+++ b/basic/qa/vba_tests/replace.vb
@@ -0,0 +1,70 @@
+Option VBASupport 1
+Option Explicit
+Dim passCount As Integer
+Dim failCount As Integer
+Dim result As String
+
+Function doUnitTest() As String
+result = verify_testReplace()
+If failCount <> 0 And passCount > 0 Then
+ doUnitTest = result
+Else
+ doUnitTest = "OK"
+End If
+End Function
+
+Function verify_testReplace() as String
+ passCount = 0
+ failCount = 0
+
+ result = "Test Results" & Chr$(10) & "============" & Chr$(10)
+
+ Dim testName As String
+ Dim srcStr, destStr, repStr, start, count, retStr
+ testName = "Test Replace function"
+ On Error GoTo errorHandler
+ srcStr = "abcbcdBc"
+ destStr = "bc"
+ repStr = "ef"
+ retStr = Replace(srcStr, destStr, repStr)
+ TestLog_ASSERT retStr = "aefefdBc", "common string:" & retStr
+ retStr = Replace("abcbcdbc", destStr, repStr)
+ TestLog_ASSERT retStr = "aefefdef", "expression string:" & retStr
+ retStr = Replace(srcStr, destStr, repStr, 1, -1, vbBinaryCompare)
+ TestLog_ASSERT retStr = "aefefdBc", "binanary compare:" & retStr
+ retStr = Replace(srcStr, destStr, repStr, 1, -1, vbTextCompare)
+ TestLog_ASSERT retStr = "aefefdef", "text compare:" & retStr
+ retStr = Replace(srcStr, destStr, repStr, compare:=vbTextCompare)
+ TestLog_ASSERT retStr = "aefefdef", "text compare:" & retStr
+ retStr = Replace(srcStr, destStr, repStr, 3, -1, vbBinaryCompare)
+ TestLog_ASSERT retStr = "cefdBc", "start = 3:" & retStr
+ retStr = Replace(srcStr, destStr, repStr, 1, 2, vbBinaryCompare)
+ TestLog_ASSERT retStr = "aefefdBc", "count = 2: " & retStr
+ retStr = Replace(srcStr, destStr, repStr, 1, 0, vbBinaryCompare)
+ TestLog_ASSERT retStr = "abcbcdBc", "start = 1, count = 0, not support in Unix: " & retStr
+ result = result & Chr$(10) & "Tests passed: " & passCount & Chr$(10) & "Tests failed: " & failCount & Chr$(10)
+ verify_testReplace = result
+
+ Exit Function
+errorHandler:
+ TestLog_ASSERT (False), testName & ": hit error handler"
+End Function
+
+Sub TestLog_ASSERT(assertion As Boolean, Optional testId As String, Optional testComment As String)
+
+ If assertion = True Then
+ passCount = passCount + 1
+ Else
+ Dim testMsg As String
+ If Not IsMissing(testId) Then
+ testMsg = testMsg + " : " + testId
+ End If
+ If Not IsMissing(testComment) And Not (testComment = "") Then
+ testMsg = testMsg + " (" + testComment + ")"
+ End If
+
+ result = result & Chr$(10) & " Failed: " & testMsg
+ failCount = failCount + 1
+ End If
+
+End Sub
diff --git a/basic/qa/vba_tests/strconv.vb b/basic/qa/vba_tests/strconv.vb
new file mode 100644
index 0000000..a98fbaa
--- /dev/null
+++ b/basic/qa/vba_tests/strconv.vb
@@ -0,0 +1,90 @@
+Option VBASupport 1
+Option Explicit
+Dim passCount As Integer
+Dim failCount As Integer
+Dim result As String
+
+Function doUnitTest() As String
+result = verify_testStrConv()
+If failCount <> 0 And passCount > 0 Then
+ doUnitTest = result
+Else
+ doUnitTest = "OK"
+End If
+End Function
+
+Function verify_testStrConv() as String
+ passCount = 0
+ failCount = 0
+
+ result = "Test Results" & Chr$(10) & "============" & Chr$(10)
+
+ Dim testName As String
+ Dim srcStr, retStr As String
+ Dim x() As Byte
+ srcStr = "abc EFG hij"
+ testName = "Test StrConv function"
+ On Error GoTo errorHandler
+
+ retStr = StrConv(srcStr, vbUpperCase)
+ 'MsgBox retStr
+ TestLog_ASSERT retStr = "ABC EFG HIJ", "Converts the string to uppercase characters:" & retStr
+
+ retStr = StrConv(srcStr, vbLowerCase)
+ 'MsgBox retStr
+ TestLog_ASSERT retStr = "abc efg hij", "Converts the string to lowercase characters:" & retStr
+
+ retStr = StrConv(srcStr, vbProperCase)
+ 'MsgBox retStr
+ TestLog_ASSERT retStr = "Abc Efg Hij", "Converts the first letter of every word in string to uppercase:" & retStr
+
+ 'retStr = StrConv("ABCDEVB¥ì¥¹¥Â¥å©`", vbWide)
+ 'MsgBox retStr
+ 'TestLog_ASSERT retStr = "£Ã£Â£Ã£Ä£ÅVB¥ì¥¹¥Â¥å©`", "Converts narrow (single-byte) characters in string to wide"
+
+ 'retStr = StrConv("£Ã£Â£Ã£Ä£ÅVB¥ì¥¹¥Â¥å©`", vbNarrow)
+ 'MsgBox retStr
+ 'TestLog_ASSERT retStr = "ABCDEVB¥ì¥¹¥Â¥å©`", "Converts wide (double-byte) characters in string to narrow (single-byte) characters." & retStr
+
+ 'retStr = StrConv("¤Ã¤Ê¤Ã¤ã¤ó", vbKatakana)
+ 'MsgBox retStr
+ 'TestLog_ASSERT retStr = "¥åʥåã¥ó", "Converts Hiragana characters in string to Katakana characters.." & retStr
+
+ ' retStr = StrConv("¥åʥåã¥ó", vbHiragana)
+ 'MsgBox retStr
+ ' TestLog_ASSERT retStr = "¤Ã¤Ê¤Ã¤ã¤ó", "Converts Katakana characters in string to Hiragana characters.." & retStr
+
+ 'x = StrConv("Éú£ÊÃABC", vbFromUnicode)
+ 'MsgBox retStr
+ 'TestLog_ASSERT UBound(x) = 8, "Converts the string from Unicode, the lenght is : " & UBound(x) + 1
+
+ ' retStr = StrConv(x, vbUnicode)
+ 'MsgBox retStr
+ ' TestLog_ASSERT retStr = "Éú£ÊÃABC", "Converts the string to Unicode: " & retStr
+
+ result = result & Chr$(10) & "Tests passed: " & passCount & Chr$(10) & "Tests failed: " & failCount & Chr$(10)
+ verify_testStrConv = result
+
+ Exit Function
+errorHandler:
+ TestLog_ASSERT (False), testName & ": hit error handler"
+End Function
+
+Sub TestLog_ASSERT(assertion As Boolean, Optional testId As String, Optional testComment As String)
+
+ If assertion = True Then
+ passCount = passCount + 1
+ Else
+ Dim testMsg As String
+ If Not IsMissing(testId) Then
+ testMsg = testMsg + " : " + testId
+ End If
+ If Not IsMissing(testComment) And Not (testComment = "") Then
+ testMsg = testMsg + " (" + testComment + ")"
+ End If
+
+ result = result & Chr$(10) & " Failed: " & testMsg
+ failCount = failCount + 1
+ End If
+
+End Sub
diff --git a/basic/qa/vba_tests/stringplusdouble.vb b/basic/qa/vba_tests/stringplusdouble.vb
new file mode 100644
index 0000000..e75cfdb
--- /dev/null
+++ b/basic/qa/vba_tests/stringplusdouble.vb
@@ -0,0 +1,328 @@
+Option VBASupport 1
+Option Explicit
+Dim passCount As Integer
+Dim failCount As Integer
+Dim result As String
+
+Function doUnitTest() As String
+result = verify_stringplusdouble()
+If failCount <> 0 And passCount > 0 Then
+ doUnitTest = result
+Else
+ doUnitTest = "OK"
+End If
+End Function
+
+Function verify_stringplusdouble() as String
+ passCount = 0
+ failCount = 0
+
+ result = "Test Results" & Chr$(10) & "============" & Chr$(10)
+
+ DSD
+ SSD
+ DSS
+ result = result & Chr$(10) & "Tests passed: " & passCount & Chr$(10) & "Tests failed: " & failCount & Chr$(10)
+ verify_stringplusdouble = result
+End Function
+
+Sub DSD()
+ Dim testName As String
+ testName = "double = string + double"
+ Dim testCompute As String
+
+ Dim s As String
+ Dim d As Double
+ Dim r As Double
+
+ On Error GoTo ErrorHandler
+
+ testCompute = "s = null, d = null, r = s + d"
+ r = s + d
+ TestLog_ASSERT r = -1, testCompute & " .The result is: " & r
+
+ testCompute = "s = null, d = null, r = s & d"
+ r = s & d
+ TestLog_ASSERT r = 0, testCompute & " .The result is: " & r
+
+ testCompute = "s = null, d = 20, r = s + d"
+ d = 20
+ r = s + d
+ TestLog_ASSERT r = -1, testCompute & " .The result is: " & r
+
+ testCompute = "s = null, d = 20, r = s & d"
+ d = 20
+ r = s & d
+ TestLog_ASSERT r = 20, testCompute & " .The result is: " & r
+
+
+ ''''''''''''''
+ s = "10"
+ Dim d2 As Double
+ testCompute = "s = '10', d = null, r = s + d"
+ r = s + d2
+ TestLog_ASSERT r = 10, testCompute & " .The result is: " & r
+
+ testCompute = "s = '10', d = null, r = s & d"
+ r = s & d2
+ TestLog_ASSERT r = 100, testCompute & " .The result is: " & r
+
+ testCompute = "s = '10', d = 20, r = s + d"
+ d2 = 20
+ r = s + d2
+ TestLog_ASSERT r = 30, testCompute & " .The result is: " & r
+
+ testCompute = "s = '10', d = 20, r = s & d"
+ d2 = 20
+ r = s & d2
+ TestLog_ASSERT r = 1020, testCompute & " .The result is: " & r
+
+ ''''''''''''''
+ s = "abc"
+ Dim d3 As Double
+ testCompute = "s = 'abc', d = null, r = s + d"
+ r = s + d3
+ TestLog_ASSERT r = -1, testCompute & " .The result is: " & r
+
+ testCompute = "s = 'abc', d = null, r = s & d"
+ r = s & d3
+ TestLog_ASSERT r = -1, testCompute & " .The result is: " & r
+
+ testCompute = "s = 'abc', d = 20, r = s + d"
+ d3 = 20
+ r = s + d3
+ TestLog_ASSERT r = -1, testCompute & " .The result is: " & r
+
+ testCompute = "s = 'abc', d = 20, r = s & d"
+ d3 = 20
+ r = s & d3
+ TestLog_ASSERT r = -1, testCompute & " .The result is: " & r
+
+ Exit Sub
+
+ErrorHandler:
+ r = -1
+' TestLog_Comment "The next compute raises error: " & testCompute
+ Resume Next
+End Sub
+
+
+Sub SSD()
+ Dim testName As String
+ testName = "string = string + double"
+ Dim testCompute As String
+
+ Dim s As String
+ Dim d As Double
+ Dim r As String
+
+ On Error GoTo ErrorHandler
+
+ testCompute = "s = null, d = null, r = s + d"
+ r = s + d
+ TestLog_ASSERT r = "-1", testCompute & " .The result is: " & r
+
+ testCompute = "s = null, d = null, r = s & d"
+ r = s & d
+ TestLog_ASSERT r = "0", testCompute & " .The result is: " & r
+
+ testCompute = "s = null, d = 20, r = s + d"
+ d = 20
+ r = s + d
+ TestLog_ASSERT r = "-1", testCompute & " .The result is: " & r
+
+ testCompute = "s = null, d = 20, r = s & d"
+ d = 20
+ r = s & d
+ TestLog_ASSERT r = "20", testCompute & " .The result is: " & r
+
+
+ ''''''''''''''
+ s = "10"
+ Dim d2 As Double
+ testCompute = "s = '10', d = null, r = s + d"
+ r = s + d2
+ TestLog_ASSERT r = "10", testCompute & " .The result is: " & r
+
+ testCompute = "s = '10', d = null, r = s & d"
+ r = s & d2
+ TestLog_ASSERT r = "100", testCompute & " .The result is: " & r
+
+ testCompute = "s = '10', d = 20, r = s + d"
+ d2 = 20
+ r = s + d2
+ TestLog_ASSERT r = "30", testCompute & " .The result is: " & r
+
+ testCompute = "s = '10', d = 20, r = s & d"
+ d2 = 20
+ r = s & d2
+ TestLog_ASSERT r = "1020", testCompute & " .The result is: " & r
+
+ ''''''''''''''
+ s = "abc"
+ Dim d3 As Double
+ testCompute = "s = 'abc', d = null, r = s + d"
+ r = s + d3
+ TestLog_ASSERT r = "-1", testCompute & " .The result is: " & r
+
+ testCompute = "s = 'abc', d = null, r = s & d"
+ r = s & d3
+ TestLog_ASSERT r = "abc0", testCompute & " .The result is: " & r
+
+ testCompute = "s = 'abc', d = 20, r = s + d"
+ d3 = 20
+ r = s + d3
+ TestLog_ASSERT r = "-1", testCompute & " .The result is: " & r
+
+ testCompute = "s = 'abc', d = 20, r = s & d"
+ d3 = 20
+ r = s & d3
+ TestLog_ASSERT r = "abc20", testCompute & " .The result is: " & r
+ Exit Sub
+
+ErrorHandler:
+ r = "-1"
+' TestLog_Comment "The next compute raises error: " & testCompute
+ Resume Next
+End Sub
+
+Sub DSS()
+ Dim testName As String
+ testName = "double = string + string"
+ Dim testCompute As String
+
+ Dim s As String
+ Dim d As String
+ Dim r As Double
+
+ On Error GoTo ErrorHandler
+
+ testCompute = "s = null, d = null, r = s + d"
+ r = s + d
+ TestLog_ASSERT r = -1, testCompute & " .The result is: " & r
+
+ testCompute = "s = null, d = null, r = s & d"
+ r = s & d
+ TestLog_ASSERT r = -1, testCompute & " .The result is: " & r
+
+ testCompute = "s = null, d = 20, r = s + d"
+ d = "20"
+ r = s + d
+ TestLog_ASSERT r = 20, testCompute & " .The result is: " & r
+
+ testCompute = "s = null, d = 20, r = s & d"
+ d = "20"
+ r = s & d
+ TestLog_ASSERT r = 20, testCompute & " .The result is: " & r
+
+
+ ''''''''''''''
+ s = "10"
+ Dim d2 As String
+ testCompute = "s = '10', d = null, r = s + d"
+ r = s + d2
+ TestLog_ASSERT r = 10, testCompute & " .The result is: " & r
+
+ testCompute = "s = '10', d = null, r = s & d"
+ r = s & d2
+ TestLog_ASSERT r = 10, testCompute & " .The result is: " & r
+
+ testCompute = "s = '10', d = 20, r = s + d"
+ d2 = "20"
+ r = s + d2
+ TestLog_ASSERT r = 1020, testCompute & " .The result is: " & r
+
+ testCompute = "s = '10', d = 20, r = s & d"
+ d2 = "20"
+ r = s & d2
+ TestLog_ASSERT r = 1020, testCompute & " .The result is: " & r
+
+ ''''''''''''''
+ s = "abc"
+ Dim d3 As String
+ testCompute = "s = 'abc', d = null, r = s + d"
+ r = s + d3
+ TestLog_ASSERT r = -1, testCompute & " .The result is: " & r
+
+ testCompute = "s = 'abc', d = null, r = s & d"
+ r = s & d3
+ TestLog_ASSERT r = -1, testCompute & " .The result is: " & r
+
+ testCompute = "s = 'abc', d = 20, r = s + d"
+ d3 = "20"
+ r = s + d3
+ TestLog_ASSERT r = -1, testCompute & " .The result is: " & r
+
+ testCompute = "s = 'abc', d = 20, r = s & d"
+ d3 = "20"
+ r = s & d3
+ TestLog_ASSERT r = -1, testCompute & " .The result is: " & r
+ Exit Sub
+
+ErrorHandler:
+ r = -1
+' TestLog_Comment "The next compute raises error: " & testCompute
+ Resume Next
+End Sub
+
+
+
+Sub test2()
+ Dim s As String
+ Dim d As Double
+ s = ""
+ d = s ' fail in MSO
+ MsgBox d
+End Sub
+
+Sub testBolean()
+ Dim a As String
+ Dim b As Boolean
+ Dim c As Boolean
+ Dim d As String
+
+ b = True
+
+ a = "1"
+ c = a + b ' c = false
+ MsgBox c
+
+ d = a + b 'd = 0
+ MsgBox d
+End Sub
+
+Sub testCurrency()
+ Dim a As String
+ Dim b As Currency
+ Dim c As Currency
+ Dim d As String
+
+ a = "10"
+ b = 30.3
+
+ c = a + b ' c = 40.3
+ MsgBox c
+
+ d = a + b ' c =40.3
+ MsgBox d
+
+End Sub
+
+Sub TestLog_ASSERT(assertion As Boolean, Optional testId As String, Optional testComment As String)
+
+ If assertion = True Then
+ passCount = passCount + 1
+ Else
+ Dim testMsg As String
+ If Not IsMissing(testId) Then
+ testMsg = testMsg + " : " + testId
+ End If
+ If Not IsMissing(testComment) And Not (testComment = "") Then
+ testMsg = testMsg + " (" + testComment + ")"
+ End If
+
+ result = result & Chr$(10) & " Failed: " & testMsg
+ failCount = failCount + 1
+ End If
+
+End Sub
diff --git a/basic/source/sbx/sbxform.cxx b/basic/source/sbx/sbxform.cxx
index 0661861..c0e23ff 100644
--- a/basic/source/sbx/sbxform.cxx
+++ b/basic/source/sbx/sbxform.cxx
@@ -819,7 +819,7 @@ void SbxBasicFormater::ScanFormatString( double dNumber,
case '%':
// maybe remove redundant 0s, e. g. 4.500e4 in 0.0##e-00
ParseBack( sReturnStrg, sFormatStrg, i-1 );
- sReturnStrg.insert(0,'%');
+ sReturnStrg.append('%');
break;
case 'e':
case 'E':
More information about the Libreoffice-commits
mailing list