Hi,
I have submitted a patch for review:
https://gerrit.libreoffice.org/2757
To pull it, you can do:
git pull ssh://gerrit.libreoffice.org:29418/core refs/changes/57/2757/1
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)
---
A basic/CppunitTest_basic_vba.mk
M basic/Module_basic.mk
M basic/qa/cppunit/basic_coverage.cxx
M basic/qa/cppunit/basictest.hxx
M basic/qa/cppunit/test_append.cxx
M basic/qa/cppunit/test_nested_struct.cxx
A basic/qa/cppunit/test_vba.cxx
A basic/qa/vba_tests/bytearraystring.vb
A basic/qa/vba_tests/data/ADODBdata.xls
A basic/qa/vba_tests/dateserial.vb
A basic/qa/vba_tests/datevalue.vb
A basic/qa/vba_tests/format.vb
A basic/qa/vba_tests/ole_ObjAssignNoDflt.vb
A basic/qa/vba_tests/ole_ObjAssignToNothing.vb
A basic/qa/vba_tests/partition.vb
A basic/qa/vba_tests/replace.vb
A basic/qa/vba_tests/strconv.vb
A basic/qa/vba_tests/stringplusdouble.vb
M basic/source/sbx/sbxform.cxx
19 files changed, 1,630 insertions(+), 234 deletions(-)
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 @@
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,24 +16,20 @@
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();
@@ -51,18 +47,8 @@
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 @@
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)
@@ -130,33 +106,6 @@
{
test_failed();
}
-}
-
-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)
@@ -172,7 +121,7 @@
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;
- public:
- BasicTestBase() : BootstrapFixture(true, false), mbError(false) {};
+ 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:
+ 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 @@
}
};
-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 @@
};
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 @@
// 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 @@
// 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 @@
// 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 @@
"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 @@
"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 @@
// 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::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::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::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::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
--- /dev/null
+++ b/basic/qa/vba_tests/data/ADODBdata.xls
Binary files 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 @@
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':
--
To view, visit https://gerrit.libreoffice.org/2757
To unsubscribe, visit https://gerrit.libreoffice.org/settings
Gerrit-MessageType: newchange
Gerrit-Change-Id: I94b43b03f742da7c6c8cf2e6a60ed305c1395fa7
Gerrit-PatchSet: 1
Gerrit-Project: core
Gerrit-Branch: libreoffice-4-0
Gerrit-Owner: Noel Power <noel.power@suse.com>
Context
- [PATCH libreoffice-4-0] Rehash basic unit test framework · Noel Power (via Code Review)
Privacy Policy |
Impressum (Legal Info) |
Copyright information: Unless otherwise specified, all text and images
on this website are licensed under the
Creative Commons Attribution-Share Alike 3.0 License.
This does not include the source code of LibreOffice, which is
licensed under the Mozilla Public License (
MPLv2).
"LibreOffice" and "The Document Foundation" are
registered trademarks of their corresponding registered owners or are
in actual use as trademarks in one or more countries. Their respective
logos and icons are also subject to international copyright laws. Use
thereof is explained in our
trademark policy.