diff options
| author | Daniel Baumann <daniel.baumann@progress-linux.org> | 2024-04-27 16:51:28 +0000 |
|---|---|---|
| committer | Daniel Baumann <daniel.baumann@progress-linux.org> | 2024-04-27 16:51:28 +0000 |
| commit | 940b4d1848e8c70ab7642901a68594e8016caffc (patch) | |
| tree | eb72f344ee6c3d9b80a7ecc079ea79e9fba8676d /basic/qa | |
| parent | Initial commit. (diff) | |
| download | libreoffice-940b4d1848e8c70ab7642901a68594e8016caffc.tar.xz libreoffice-940b4d1848e8c70ab7642901a68594e8016caffc.zip | |
Adding upstream version 1:7.0.4.upstream/1%7.0.4upstream
Signed-off-by: Daniel Baumann <daniel.baumann@progress-linux.org>
Diffstat (limited to 'basic/qa')
239 files changed, 13419 insertions, 0 deletions
diff --git a/basic/qa/basic_coverage/da-DK/cdbl-2.vb b/basic/qa/basic_coverage/da-DK/cdbl-2.vb new file mode 100644 index 000000000..a219304d4 --- /dev/null +++ b/basic/qa/basic_coverage/da-DK/cdbl-2.vb @@ -0,0 +1,14 @@ +Function doUnitTest() as Integer + Dim A As String + Dim B As Double + Dim Expected As Double + A = "222,222" + ' in da-DK locale ',' is the decimal separator + Expected = 222.222 + B = Cdbl(A) + If B <> Expected Then + doUnitTest = 0 + Else + doUnitTest = 1 + End If +End Function diff --git a/basic/qa/basic_coverage/da-DK/cdbl.vb b/basic/qa/basic_coverage/da-DK/cdbl.vb new file mode 100644 index 000000000..128cfcc99 --- /dev/null +++ b/basic/qa/basic_coverage/da-DK/cdbl.vb @@ -0,0 +1,14 @@ +Function doUnitTest() as Integer + Dim A As String + Dim B As Double + Dim Expected As String + A = "222.222" + ' in da-DK locale ',' is the decimal separator + Expected = "222222" + B = Cdbl(A) + If B <> Expected Then + doUnitTest = 0 + Else + doUnitTest = 1 + End If +End Function diff --git a/basic/qa/basic_coverage/string_left_01.vb b/basic/qa/basic_coverage/string_left_01.vb new file mode 100644 index 000000000..ef896bef1 --- /dev/null +++ b/basic/qa/basic_coverage/string_left_01.vb @@ -0,0 +1,25 @@ +' +' 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/. +' + + +Function doUnitTest as Integer + +Dim s1 As String +Dim s2 As String + + s1 = "abc" + + s2 = Left(s1, 2) + + If s2 = "ab" Then + doUnitTest = 1 + Else + doUnitTest = 0 + End If + +End Function diff --git a/basic/qa/basic_coverage/string_right_01.vb b/basic/qa/basic_coverage/string_right_01.vb new file mode 100644 index 000000000..65b16c6a8 --- /dev/null +++ b/basic/qa/basic_coverage/string_right_01.vb @@ -0,0 +1,24 @@ +' +' 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/. +' + +Function doUnitTest as Integer + +Dim s1 As String +Dim s2 As String + + s1 = "abc" + + s2 = Right(s1, 2) + + If s2 = "bc" Then + doUnitTest = 1 + Else + doUnitTest = 0 + End If + +End Function diff --git a/basic/qa/basic_coverage/test_Property.GetLet.vb b/basic/qa/basic_coverage/test_Property.GetLet.vb new file mode 100644 index 000000000..992496a21 --- /dev/null +++ b/basic/qa/basic_coverage/test_Property.GetLet.vb @@ -0,0 +1,27 @@ +' +' 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/. +' + +Option Compatible + +Function doUnitTest as Integer + ' PROPERTY GET/LET + aString = "Office" + If ( aString <> "LibreOffice") Then + doUnitTest = 0 ' Ko + Else + doUnitTest = 1 ' Ok + End If +End Function + +Dim _pn As String +Property Get aString As String + aString = _pn +End Property +Property Let aString(value As String) + _pn = "Libre"& value +End Property diff --git a/basic/qa/basic_coverage/test_Property.GetSet.vb b/basic/qa/basic_coverage/test_Property.GetSet.vb new file mode 100644 index 000000000..4a23867c2 --- /dev/null +++ b/basic/qa/basic_coverage/test_Property.GetSet.vb @@ -0,0 +1,37 @@ +' +' 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/. +' + +Option Compatible + +Function doUnitTest as Integer + ' PROPERTY GET/SET for classes or UNO services + + Set objSetter = New Collection ' OR objLetter = New Collection + If ( objGetter.Count <> 3 ) Then + doUnitTest = 0 ' not Ok + Else + doUnitTest = 1 ' Ok + End If +End Function + +Sub DEV_TST : MsgBox doUnitTesT : End Sub + +Property Get objGetter As Object + _obj.add "roots" + Set objGetter = _obj +End Property + +Private _obj As Object + +Property Set objSetter(value As Object) + Set _obj = value + With _obj + .add "branches" + .add "leaves" + End With +End Property diff --git a/basic/qa/basic_coverage/test_abs_method.vb b/basic/qa/basic_coverage/test_abs_method.vb new file mode 100644 index 000000000..b79b9bcbb --- /dev/null +++ b/basic/qa/basic_coverage/test_abs_method.vb @@ -0,0 +1,17 @@ +' 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/. +' + +Function doUnitTest as Integer + ' ABS + If (Abs(-3.5) <> 3.5) Then + doUnitTest = 0 + ElseIf (Abs(3.5) <> 3.5) Then + doUnitTest = 0 + Else + doUnitTest = 1 + End If +End Function diff --git a/basic/qa/basic_coverage/test_array_method.vb b/basic/qa/basic_coverage/test_array_method.vb new file mode 100644 index 000000000..42f10a25a --- /dev/null +++ b/basic/qa/basic_coverage/test_array_method.vb @@ -0,0 +1,20 @@ +' +' 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/. +' + +Function doUnitTest as Integer + dim aVector as Variant + ' ARRAY + aVector = Array( "Hello", -3.14) + If (aVector(0) <> "Hello") Then + doUnitTest = 0 + ElseIf ( aVector(1) <> -3.14 ) Then + doUnitTest = 0 + Else + doUnitTest = 1 + End If +End Function diff --git a/basic/qa/basic_coverage/test_asc_method.vb b/basic/qa/basic_coverage/test_asc_method.vb new file mode 100644 index 000000000..48b88933f --- /dev/null +++ b/basic/qa/basic_coverage/test_asc_method.vb @@ -0,0 +1,15 @@ +' 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/. +' + +Function doUnitTest as Integer + ' ASC + If (Asc("€a") <> 8364) Then + doUnitTest = 0 + Else + doUnitTest = 1 + End If +End Function diff --git a/basic/qa/basic_coverage/test_atn_method.vb b/basic/qa/basic_coverage/test_atn_method.vb new file mode 100644 index 000000000..771714134 --- /dev/null +++ b/basic/qa/basic_coverage/test_atn_method.vb @@ -0,0 +1,15 @@ +' 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/. +' + +Function doUnitTest as Integer + ' ATN (arc tan) + If (Atn(1) <> PI/4) Then + doUnitTest = 0 + Else + doUnitTest = 1 + End If +End Function diff --git a/basic/qa/basic_coverage/test_beep_method.vb b/basic/qa/basic_coverage/test_beep_method.vb new file mode 100644 index 000000000..28eed61a6 --- /dev/null +++ b/basic/qa/basic_coverage/test_beep_method.vb @@ -0,0 +1,12 @@ +' 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/. +' + +Function doUnitTest as Integer + ' BEEP + Beep + doUnitTest = 1 +End Function diff --git a/basic/qa/basic_coverage/test_cbool_method.vb b/basic/qa/basic_coverage/test_cbool_method.vb new file mode 100644 index 000000000..d1d995f19 --- /dev/null +++ b/basic/qa/basic_coverage/test_cbool_method.vb @@ -0,0 +1,16 @@ +' +' 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/. +' + +Function doUnitTest as Integer + ' CBOOL + If (CBool(3) <> True) Then + doUnitTest = 0 + Else + doUnitTest = 1 + End If +End Function diff --git a/basic/qa/basic_coverage/test_cbyte_method.vb b/basic/qa/basic_coverage/test_cbyte_method.vb new file mode 100644 index 000000000..35bb1654c --- /dev/null +++ b/basic/qa/basic_coverage/test_cbyte_method.vb @@ -0,0 +1,16 @@ +' +' 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/. +' + +Function doUnitTest as Integer + ' CBYTE + If (CByte("3") <> 3) Then + doUnitTest = 0 + Else + doUnitTest = 1 + End If +End Function diff --git a/basic/qa/basic_coverage/test_ccur_method.vb b/basic/qa/basic_coverage/test_ccur_method.vb new file mode 100644 index 000000000..b84ddafd5 --- /dev/null +++ b/basic/qa/basic_coverage/test_ccur_method.vb @@ -0,0 +1,16 @@ +' +' 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/. +' + +Function doUnitTest as Integer + ' CCUR + If (CCur("100") <> 100) Then + doUnitTest = 0 + Else + doUnitTest = 1 + End If +End Function diff --git a/basic/qa/basic_coverage/test_cdate_method.vb b/basic/qa/basic_coverage/test_cdate_method.vb new file mode 100644 index 000000000..c26287b1f --- /dev/null +++ b/basic/qa/basic_coverage/test_cdate_method.vb @@ -0,0 +1,16 @@ +' +' 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/. +' + +Function doUnitTest as Integer + ' CDATE + If (CDate(100) <> 100) Then + doUnitTest = 0 + Else + doUnitTest = 1 + End If +End Function diff --git a/basic/qa/basic_coverage/test_cdatetofromiso_methods.vb b/basic/qa/basic_coverage/test_cdatetofromiso_methods.vb new file mode 100644 index 000000000..d2f4ce9c7 --- /dev/null +++ b/basic/qa/basic_coverage/test_cdatetofromiso_methods.vb @@ -0,0 +1,41 @@ +' +' 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/. +' + +Function doUnitTest as Integer + ' CDateFromIso CDateToIso + If ( CDateToIso( CDateFromIso("20161016") ) <> "20161016" ) Then + doUnitTest = 0 + ElseIf ( CDateToIso( CDateFromIso("2016-10-16") ) <> "20161016" ) Then + doUnitTest = 0 + ElseIf ( CDateToIso( CDateFromIso("-2016-10-16") ) <> "-20161016" ) Then + doUnitTest = 0 + ElseIf ( CDateToIso( CDateFromIso("-20161016") ) <> "-20161016" ) Then + doUnitTest = 0 + ElseIf ( CDateToIso( CDateFromIso("12016-10-16") ) <> "120161016" ) Then + doUnitTest = 0 + ElseIf ( CDateToIso( CDateFromIso("120161016") ) <> "120161016" ) Then + doUnitTest = 0 + ElseIf ( CDateToIso( CDateFromIso("-12016-10-16") ) <> "-120161016" ) Then + doUnitTest = 0 + ElseIf ( CDateToIso( CDateFromIso("-120161016") ) <> "-120161016" ) Then + doUnitTest = 0 + ElseIf ( CDateToIso( CDateFromIso("0001-01-01") ) <> "00010101" ) Then + doUnitTest = 0 + ElseIf ( CDateToIso( CDateFromIso("00010101") ) <> "00010101" ) Then + doUnitTest = 0 + ElseIf ( CDateToIso( CDateFromIso("-0001-12-31") ) <> "-00011231" ) Then + doUnitTest = 0 + ElseIf ( CDateToIso( CDateFromIso("-00011231") ) <> "-00011231" ) Then + doUnitTest = 0 + ElseIf ( CDateToIso( CDateFromIso("991231") ) <> "19991231" ) Then + doUnitTest = 0 + Else + doUnitTest = 1 + End If + ' TODO: add some failure tests for misformed input, On Error whatever? +End Function diff --git a/basic/qa/basic_coverage/test_cdatetounodatecdatefromunodate_methods.vb b/basic/qa/basic_coverage/test_cdatetounodatecdatefromunodate_methods.vb new file mode 100644 index 000000000..2aa735c54 --- /dev/null +++ b/basic/qa/basic_coverage/test_cdatetounodatecdatefromunodate_methods.vb @@ -0,0 +1,18 @@ +' +' 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/. +' + +Function doUnitTest as Integer + dim aDate as Date + aDate = Date() + ' CDateToUnoDate CDateFromUnoDate + If ( CDateFromUnoDate( CDateToUnoDate( aDate ) ) <> aDate ) Then + doUnitTest = 0 + Else + doUnitTest = 1 + End If +End Function diff --git a/basic/qa/basic_coverage/test_cdatetounodatetimecdatefromunodatetime_methods.vb b/basic/qa/basic_coverage/test_cdatetounodatetimecdatefromunodatetime_methods.vb new file mode 100644 index 000000000..9aa5680b1 --- /dev/null +++ b/basic/qa/basic_coverage/test_cdatetounodatetimecdatefromunodatetime_methods.vb @@ -0,0 +1,18 @@ +' +' 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/. +' + +Function doUnitTest as Integer + dim aDate as Date + aDate = Now() + ' CDateToUnoDateTime CDateFromUnoDateTime + If ( CDateFromUnoDateTime( CDateToUnoDateTime( aDate ) ) <> aDate ) Then + doUnitTest = 0 + Else + doUnitTest = 1 + End If +End Function diff --git a/basic/qa/basic_coverage/test_cdatetounotimecdatefromunotime_methods.vb b/basic/qa/basic_coverage/test_cdatetounotimecdatefromunotime_methods.vb new file mode 100644 index 000000000..38fd9da45 --- /dev/null +++ b/basic/qa/basic_coverage/test_cdatetounotimecdatefromunotime_methods.vb @@ -0,0 +1,18 @@ +' +' 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/. +' + +Function doUnitTest as Integer + dim aDate as Date + aDate = Time() + ' CDateToUnoTime CDateFromUnoTime + If ( CDateFromUnoTime( CDateToUnoTime( aDate ) ) <> aDate ) Then + doUnitTest = 0 + Else + doUnitTest = 1 + End If +End Function diff --git a/basic/qa/basic_coverage/test_cdbl_method.vb b/basic/qa/basic_coverage/test_cdbl_method.vb new file mode 100644 index 000000000..a0ba8f029 --- /dev/null +++ b/basic/qa/basic_coverage/test_cdbl_method.vb @@ -0,0 +1,16 @@ +' +' 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/. +' + +Function doUnitTest as Integer + ' CDBL + If (CDbl("100") <> 100) Then + doUnitTest = 0 + Else + doUnitTest = 1 + End If +End Function diff --git a/basic/qa/basic_coverage/test_chdircurdir_methods.vb b/basic/qa/basic_coverage/test_chdircurdir_methods.vb new file mode 100644 index 000000000..dadd65b10 --- /dev/null +++ b/basic/qa/basic_coverage/test_chdircurdir_methods.vb @@ -0,0 +1,12 @@ +' 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/. +' + +Function doUnitTest as Integer + ' CHDIR CURDIR + ChDir( CurDir ) + doUnitTest = 1 +End Function diff --git a/basic/qa/basic_coverage/test_choose_method.vb b/basic/qa/basic_coverage/test_choose_method.vb new file mode 100644 index 000000000..6ab2aea80 --- /dev/null +++ b/basic/qa/basic_coverage/test_choose_method.vb @@ -0,0 +1,16 @@ +' +' 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/. +' + +Function doUnitTest as Integer + ' CHOOSE + If (Choose(2, 1, 100, 3) <> 100) Then + doUnitTest = 0 + Else + doUnitTest = 1 + End If +End Function diff --git a/basic/qa/basic_coverage/test_chr_method.vb b/basic/qa/basic_coverage/test_chr_method.vb new file mode 100644 index 000000000..8e8179463 --- /dev/null +++ b/basic/qa/basic_coverage/test_chr_method.vb @@ -0,0 +1,64 @@ +' 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/. + +Function overflow1 as Integer + On Error GoTo handler + Chr(-32769) + overflow1 = 0 + Exit Function +handler: + if (Err <> 6) Then + overflow1 = 0 + Exit Function + Endif + overflow1 = 1 +End Function + +Function overflow2 as Integer + On Error GoTo handler + Chr(65536) + overflow2 = 0 + Exit Function +handler: + if (Err <> 6) Then + overflow2 = 0 + Exit Function + Endif + overflow2 = 1 +End Function + +Function overflow3 as Integer + On Error GoTo handler + Chr(&H10000) + overflow3 = 0 + Exit Function +handler: + if (Err <> 6) Then + overflow3 = 0 + Exit Function + Endif + overflow3 = 1 +End Function + +Function doUnitTest as Integer + Chr(-32768) + Chr(65535) + Chr(&H8000) + Chr(&HFFFF) + if (overflow1 = 0) Then + doUnitTest = 0 + Exit Function + Endif + if (overflow2 = 0) Then + doUnitTest = 0 + Exit Function + Endif + if (overflow3 = 0) Then + doUnitTest = 0 + Exit Function + Endif + doUnitTest = 1 +End Function diff --git a/basic/qa/basic_coverage/test_cint_method.vb b/basic/qa/basic_coverage/test_cint_method.vb new file mode 100644 index 000000000..b84af04d7 --- /dev/null +++ b/basic/qa/basic_coverage/test_cint_method.vb @@ -0,0 +1,16 @@ +' +' 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/. +' + +Function doUnitTest as Integer + ' CINT + If (CInt("100") <> 100) Then + doUnitTest = 0 + Else + doUnitTest = 1 + End If +End Function diff --git a/basic/qa/basic_coverage/test_compatibilitymode_method.vb b/basic/qa/basic_coverage/test_compatibilitymode_method.vb new file mode 100644 index 000000000..599adb963 --- /dev/null +++ b/basic/qa/basic_coverage/test_compatibilitymode_method.vb @@ -0,0 +1,15 @@ +' 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/. +' + +Function doUnitTest as Integer + ' CompatibilityMode + If (CompatibilityMode(True) <> True) Then + doUnitTest = 0 + Else + doUnitTest = 1 + End If +End Function diff --git a/basic/qa/basic_coverage/test_converttofromurl_methods.vb b/basic/qa/basic_coverage/test_converttofromurl_methods.vb new file mode 100644 index 000000000..40c6494bd --- /dev/null +++ b/basic/qa/basic_coverage/test_converttofromurl_methods.vb @@ -0,0 +1,15 @@ +' 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/. +' + +Function doUnitTest as Integer + ' ConvertFromUrl ConvertToUrl + If ( ConvertToUrl( ConvertFromUrl("") ) <> "") Then + doUnitTest = 0 + Else + doUnitTest = 1 + End If +End Function diff --git a/basic/qa/basic_coverage/test_cossin_methods.vb b/basic/qa/basic_coverage/test_cossin_methods.vb new file mode 100644 index 000000000..c4a5cc5e5 --- /dev/null +++ b/basic/qa/basic_coverage/test_cossin_methods.vb @@ -0,0 +1,15 @@ +' 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/. +' + +Function doUnitTest as Integer + ' COS SIN + If ( Abs(Cos(PI/3) - Sin(PI/6)) > 1E-6 ) Then + doUnitTest = 0 + Else + doUnitTest = 1 + End If +End Function diff --git a/basic/qa/basic_coverage/test_createobject_method.vb b/basic/qa/basic_coverage/test_createobject_method.vb new file mode 100644 index 000000000..6ae316b57 --- /dev/null +++ b/basic/qa/basic_coverage/test_createobject_method.vb @@ -0,0 +1,21 @@ +' +' 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/. +' + +Type address + Name1 As String + City As String +End Type + +Function doUnitTest as Integer + ' CREATEOBJECT + If ( IsObject( CreateObject("address") ) = False ) Then + doUnitTest = 0 + Else + doUnitTest = 1 + End If +End Function diff --git a/basic/qa/basic_coverage/test_createunolistener_method.vb b/basic/qa/basic_coverage/test_createunolistener_method.vb new file mode 100644 index 000000000..08c71fd8a --- /dev/null +++ b/basic/qa/basic_coverage/test_createunolistener_method.vb @@ -0,0 +1,13 @@ +' 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/. +' + +Function doUnitTest as Integer + ' CreateUnoListener + Dim oListener + oListener = CreateUnoListener( "ContListener_","com.sun.star.container.XContainerListener" ) + doUnitTest = 1 +End Function diff --git a/basic/qa/basic_coverage/test_createunoservice_method.vb b/basic/qa/basic_coverage/test_createunoservice_method.vb new file mode 100644 index 000000000..8fc043fd3 --- /dev/null +++ b/basic/qa/basic_coverage/test_createunoservice_method.vb @@ -0,0 +1,13 @@ +' 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/. +' + +Function doUnitTest as Integer + ' CreateUnoService + Dim filepicker + filepicker = CreateUnoService("com.sun.star.ui.dialogs.FilePicker") + doUnitTest = 1 +End Function diff --git a/basic/qa/basic_coverage/test_createunostruct_method.vb b/basic/qa/basic_coverage/test_createunostruct_method.vb new file mode 100644 index 000000000..f08368fed --- /dev/null +++ b/basic/qa/basic_coverage/test_createunostruct_method.vb @@ -0,0 +1,13 @@ +' 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/. +' + +Function doUnitTest as Integer + ' CreateUnoStruct + Dim oStruct + oStruct = CreateUnoStruct( "com.sun.star.beans.Property" ) + doUnitTest = 1 +End Function diff --git a/basic/qa/basic_coverage/test_createunovalue_method.vb b/basic/qa/basic_coverage/test_createunovalue_method.vb new file mode 100644 index 000000000..e640354ac --- /dev/null +++ b/basic/qa/basic_coverage/test_createunovalue_method.vb @@ -0,0 +1,15 @@ +' 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/. +' + +Function doUnitTest as Integer + ' CreateUnoValue + Dim oUnoValue as Variant + Dim aValue as Variant + aValue = Array ( 1, 1 ) + oUnoValue = CreateUnoValue( "[]byte", aValue ) + doUnitTest = 1 +End Function diff --git a/basic/qa/basic_coverage/test_csng_method.vb b/basic/qa/basic_coverage/test_csng_method.vb new file mode 100644 index 000000000..87704ec1d --- /dev/null +++ b/basic/qa/basic_coverage/test_csng_method.vb @@ -0,0 +1,16 @@ +' +' 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/. +' + +Function doUnitTest as Integer + ' CSNG + If (CSng("100") <> 100) Then + doUnitTest = 0 + Else + doUnitTest = 1 + End If +End Function diff --git a/basic/qa/basic_coverage/test_cstr_method.vb b/basic/qa/basic_coverage/test_cstr_method.vb new file mode 100644 index 000000000..53484b06f --- /dev/null +++ b/basic/qa/basic_coverage/test_cstr_method.vb @@ -0,0 +1,16 @@ +' +' 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/. +' + +Function doUnitTest as Integer + ' CSTR + If (CStr(100) <> "100") Then + doUnitTest = 0 + Else + doUnitTest = 1 + End If +End Function diff --git a/basic/qa/basic_coverage/test_cvar_method.vb b/basic/qa/basic_coverage/test_cvar_method.vb new file mode 100644 index 000000000..cc13bef6c --- /dev/null +++ b/basic/qa/basic_coverage/test_cvar_method.vb @@ -0,0 +1,16 @@ +' +' 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/. +' + +Function doUnitTest as Integer + ' CVAR + If (CVar(100) <> 100) Then + doUnitTest = 0 + Else + doUnitTest = 1 + End If +End Function diff --git a/basic/qa/basic_coverage/test_cverr_method.vb b/basic/qa/basic_coverage/test_cverr_method.vb new file mode 100644 index 000000000..f74445c20 --- /dev/null +++ b/basic/qa/basic_coverage/test_cverr_method.vb @@ -0,0 +1,36 @@ +' +' 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/. +' + +Function doUnitTest as Integer + ' CVERR + If (CVerr(100) <> 100) Then + doUnitTest = 0 + Else + doUnitTest = 1 + End If + + ' tdf#79426 - passing an error object to a function + if ( TestCVErr( CVErr( 2 ) ) <> 2 ) Then + doUnitTest = 0 + Else + doUnitTest = 1 + End If + + ' tdf#79426 - test with Error-Code 448 ( ERRCODE_BASIC_NAMED_NOT_FOUND ) + if ( TestCVErr( CVErr( 448 ) ) <> 448 ) Then + doUnitTest = 0 + Else + doUnitTest = 1 + End If +End Function + +Function TestCVErr(vErr As Variant) + Dim nValue As Integer + nValue = vErr + TestCVErr = nValue +End Function
\ No newline at end of file diff --git a/basic/qa/basic_coverage/test_date_literal.vb b/basic/qa/basic_coverage/test_date_literal.vb new file mode 100644 index 000000000..a175368f3 --- /dev/null +++ b/basic/qa/basic_coverage/test_date_literal.vb @@ -0,0 +1,16 @@ +' +' 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/. +' + + +Function doUnitTest as Integer + If #07/28/1977# = 28334 And #1977-07-28# = 28334 Then + doUnitTest = 1 + Else + doUnitTest = 0 + End If +End Function diff --git a/basic/qa/basic_coverage/test_datedateadddatediff_methods.vb b/basic/qa/basic_coverage/test_datedateadddatediff_methods.vb new file mode 100644 index 000000000..4ba40f8eb --- /dev/null +++ b/basic/qa/basic_coverage/test_datedateadddatediff_methods.vb @@ -0,0 +1,18 @@ +' +' 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/. +' + +Function doUnitTest as Integer + dim aDate as Date + aDate = Date() + ' DATE DATEDIFF DATEADD + If ( DateDiff( "d", aDate, DateAdd("d", 1, aDate) ) <> 1 ) Then + doUnitTest = 0 + Else + doUnitTest = 1 + End If +End Function diff --git a/basic/qa/basic_coverage/test_datedatepartday_methods.vb b/basic/qa/basic_coverage/test_datedatepartday_methods.vb new file mode 100644 index 000000000..04cc326f7 --- /dev/null +++ b/basic/qa/basic_coverage/test_datedatepartday_methods.vb @@ -0,0 +1,18 @@ +' +' 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/. +' + +Function doUnitTest as Integer + dim aDate as Date + aDate = Date() + ' DATEPART DAY + If ( DatePart( "d", aDate ) <> Day( aDate ) ) Then + doUnitTest = 0 + Else + doUnitTest = 1 + End If +End Function diff --git a/basic/qa/basic_coverage/test_dimarray_method.vb b/basic/qa/basic_coverage/test_dimarray_method.vb new file mode 100644 index 000000000..f92c7459d --- /dev/null +++ b/basic/qa/basic_coverage/test_dimarray_method.vb @@ -0,0 +1,18 @@ +' 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/. +' + +Function doUnitTest as Integer + Dim aValue as variant + aValue = DimArray( 1, 2, 4 ) + aValue( 1, 2, 4 ) = 3 + ' DIMARRAY + If ( aValue( 1, 2, 4 ) <> 3 ) Then + doUnitTest = 0 + Else + doUnitTest = 1 + End If +End Function diff --git a/basic/qa/basic_coverage/test_empty_parameter.vb b/basic/qa/basic_coverage/test_empty_parameter.vb new file mode 100644 index 000000000..fe6e2651c --- /dev/null +++ b/basic/qa/basic_coverage/test_empty_parameter.vb @@ -0,0 +1,22 @@ +'
+' 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/.
+'
+
+Sub assignVar(v As Variant)
+ v = 1
+End Sub
+
+Function doUnitTest() As Integer + ' tdf#132563 - check if empty parameters are converted to their respective types
+ anEmptyVar = Empty
+ assignVar(anEmptyVar)
+ If (anEmptyVar = 1 And TypeName(anEmptyVar) = "Integer") Then
+ doUnitTest = 1
+ Else
+ doUnitTest = 0
+ End If
+End Function diff --git a/basic/qa/basic_coverage/test_environ_method.vb b/basic/qa/basic_coverage/test_environ_method.vb new file mode 100644 index 000000000..63b6f360a --- /dev/null +++ b/basic/qa/basic_coverage/test_environ_method.vb @@ -0,0 +1,12 @@ +' 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/. +' + +Function doUnitTest as Integer + ' ENVIRON + Environ ("TMP") + doUnitTest = 1 +End Function diff --git a/basic/qa/basic_coverage/test_equalunoobjects_method.vb b/basic/qa/basic_coverage/test_equalunoobjects_method.vb new file mode 100644 index 000000000..b48111546 --- /dev/null +++ b/basic/qa/basic_coverage/test_equalunoobjects_method.vb @@ -0,0 +1,25 @@ +' 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/. +' + +Function doUnitTest as Integer + ' EqualUnoObjects + ' Copy of objects -> same instance + oIntrospection = CreateUnoService( "com.sun.star.beans.Introspection" ) + oIntro2 = oIntrospection + If ( EqualUnoObjects( oIntrospection, oIntro2 ) = False ) Then + doUnitTest = 0 + Else + ' Copy of structs as value -> new instance + Dim Struct1 as new com.sun.star.beans.Property + Struct2 = Struct1 + If ( EqualUnoObjects( Struct1, Struct2 ) ) Then + doUnitTest = 0 + Else + doUnitTest = 1 + End If + End If +End Function diff --git a/basic/qa/basic_coverage/test_erl_method.vb b/basic/qa/basic_coverage/test_erl_method.vb new file mode 100644 index 000000000..b541b15fa --- /dev/null +++ b/basic/qa/basic_coverage/test_erl_method.vb @@ -0,0 +1,22 @@ +' 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/. +' + +Function doUnitTest as Integer + ' ERL + On Error GoTo ErrorHandler ' Set up error handler + Dim nVar As Integer + nVar = 0 + nVar = 1/nVar + doUnitTest = 0 + Exit Function +ErrorHandler: + If ( Erl <> 13 ) Then + doUnitTest = 0 + Else + doUnitTest = 1 + Endif +End Function diff --git a/basic/qa/basic_coverage/test_err_method.vb b/basic/qa/basic_coverage/test_err_method.vb new file mode 100644 index 000000000..c21b417b4 --- /dev/null +++ b/basic/qa/basic_coverage/test_err_method.vb @@ -0,0 +1,22 @@ +' 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/. +' + +Function doUnitTest as Integer + ' ERR + On Error GoTo ErrorHandler ' Set up error handler + Dim nVar As Integer + nVar = 0 + nVar = 1/nVar + doUnitTest = 0 + Exit Function +ErrorHandler: + If ( Err <> 11 ) Then + doUnitTest = 0 + Else + doUnitTest = 1 + Endif +End Function diff --git a/basic/qa/basic_coverage/test_falsetrue_method.vb b/basic/qa/basic_coverage/test_falsetrue_method.vb new file mode 100644 index 000000000..f99b8032b --- /dev/null +++ b/basic/qa/basic_coverage/test_falsetrue_method.vb @@ -0,0 +1,16 @@ +' +' 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/. +' + +Function doUnitTest as Integer + ' FALSE TRUE + If (False = True) Then + doUnitTest = 0 + Else + doUnitTest = 1 + End If +End Function diff --git a/basic/qa/basic_coverage/test_filedatetime_nonexistent.vb b/basic/qa/basic_coverage/test_filedatetime_nonexistent.vb new file mode 100644 index 000000000..53a72549c --- /dev/null +++ b/basic/qa/basic_coverage/test_filedatetime_nonexistent.vb @@ -0,0 +1,20 @@ +' 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/. +' +'Bug 121337 - FileDateTime("\\nonexistent\smb\path") returns bogus result rather than throwing error +Function doUnitTest as Integer + On Error GoTo ErrorHandler ' Set up error handler + Dim result + result = FileDateTime("/bogus/unix/path") + doUnitTest = 0 + Exit Function +ErrorHandler: + If ( Err <> 0 ) Then + doUnitTest = 0 + Else + doUnitTest = 1 + Endif +End Function diff --git a/basic/qa/basic_coverage/test_filedatetime_nonexistent2.vb b/basic/qa/basic_coverage/test_filedatetime_nonexistent2.vb new file mode 100644 index 000000000..2135b25d2 --- /dev/null +++ b/basic/qa/basic_coverage/test_filedatetime_nonexistent2.vb @@ -0,0 +1,20 @@ +' 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/. +' +'Bug 121337 - FileDateTime("\\nonexistent\smb\path") returns bogus result rather than throwing error +Function doUnitTest as Integer + On Error GoTo ErrorHandler ' Set up error handler + Dim result + result = FileDateTime("\\bogus\smb\path") + doUnitTest = 0 + Exit Function +ErrorHandler: + If ( Err <> 0 ) Then + doUnitTest = 0 + Else + doUnitTest = 1 + Endif +End Function diff --git a/basic/qa/basic_coverage/test_fix_method.vb b/basic/qa/basic_coverage/test_fix_method.vb new file mode 100644 index 000000000..91d2f01fc --- /dev/null +++ b/basic/qa/basic_coverage/test_fix_method.vb @@ -0,0 +1,15 @@ +' 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/. +' + +Function doUnitTest as Integer + ' FIX + If (Fix(PI) <> 3) Then + doUnitTest = 0 + Else + doUnitTest = 1 + End If +End Function diff --git a/basic/qa/basic_coverage/test_for_each.vb b/basic/qa/basic_coverage/test_for_each.vb new file mode 100644 index 000000000..654513e88 --- /dev/null +++ b/basic/qa/basic_coverage/test_for_each.vb @@ -0,0 +1,43 @@ +' +' 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/. +' + +Function doUnitTest as Integer + Dim n As Integer, i + Dim a(3) + n = 0 + For Each i In a + n = n + 1 + Next i + If n <> 4 Then + doUnitTest = "For Each over array failed" + Exit Function + End If + + If TestInvalidForEachWithErrorHandler <> "13 91 14 " Then + doUnitTest = "For Each doesn't generate proper errors on bad arguments" + Exit Function + End If + + doUnitTest = 1 +End Function + +Function TestInvalidForEachWithErrorHandler + Dim s As String + On Error Goto ErrHandler +' This For Each is given a bad iterable; it must generate first error ("Data type mismatch") for b; + For Each a In b +' Then proceed here (Resume Next from ErrHandler), and generate "Object variable not set" for c; + c.d +' Then proceed here (Resume Next from ErrHandler), and generate "Invalid parameter" at Next. + Next + TestInvalidForEachWithErrorHandler = s + Exit Function +ErrHandler: + s = s & Err & " " + Resume Next +End Function diff --git a/basic/qa/basic_coverage/test_frac_method.vb b/basic/qa/basic_coverage/test_frac_method.vb new file mode 100644 index 000000000..14d6863db --- /dev/null +++ b/basic/qa/basic_coverage/test_frac_method.vb @@ -0,0 +1,15 @@ +' 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/. +' + +Function doUnitTest as Integer + ' FRAC + If ( 3+Frac(PI) <> PI) Then + doUnitTest = 0 + Else + doUnitTest = 1 + End If +End Function diff --git a/basic/qa/basic_coverage/test_freefile_method.vb b/basic/qa/basic_coverage/test_freefile_method.vb new file mode 100644 index 000000000..d2a5cb93b --- /dev/null +++ b/basic/qa/basic_coverage/test_freefile_method.vb @@ -0,0 +1,15 @@ +' 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/. +' + +Function doUnitTest as Integer + ' FREEFILE + If ( FreeFile < 0 ) Then + doUnitTest = 0 + Else + doUnitTest = 1 + End If +End Function diff --git a/basic/qa/basic_coverage/test_freelibrary_method.vb b/basic/qa/basic_coverage/test_freelibrary_method.vb new file mode 100644 index 000000000..4f6f9cd2d --- /dev/null +++ b/basic/qa/basic_coverage/test_freelibrary_method.vb @@ -0,0 +1,12 @@ +' 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/. +' + +Function doUnitTest as Integer + ' FREELIBRARY + FreeLibrary("") + doUnitTest = 1 +End Function diff --git a/basic/qa/basic_coverage/test_getdefaultcontext_method.vb b/basic/qa/basic_coverage/test_getdefaultcontext_method.vb new file mode 100644 index 000000000..8a90d6e96 --- /dev/null +++ b/basic/qa/basic_coverage/test_getdefaultcontext_method.vb @@ -0,0 +1,12 @@ +' 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/. +' + +Function doUnitTest as Integer + ' GetDefaultContext + GetDefaultContext() + doUnitTest = 1 +End Function diff --git a/basic/qa/basic_coverage/test_getdialogzoomfactorx_method.vb b/basic/qa/basic_coverage/test_getdialogzoomfactorx_method.vb new file mode 100644 index 000000000..279fc005d --- /dev/null +++ b/basic/qa/basic_coverage/test_getdialogzoomfactorx_method.vb @@ -0,0 +1,15 @@ +' 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/. +' + +Function doUnitTest as Integer + ' GETDIALOGFACTORX + If ( GetDialogZoomFactorX(100) < 0 ) Then + doUnitTest = 0 + Else + doUnitTest = 1 + End If +End Function diff --git a/basic/qa/basic_coverage/test_getdialogzoomfactory_method.vb b/basic/qa/basic_coverage/test_getdialogzoomfactory_method.vb new file mode 100644 index 000000000..f4139bed5 --- /dev/null +++ b/basic/qa/basic_coverage/test_getdialogzoomfactory_method.vb @@ -0,0 +1,15 @@ +' 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/. +' + +Function doUnitTest as Integer + ' GETDIALOGFACTORY + If ( GetDialogZoomFactorY(100) < 0 ) Then + doUnitTest = 0 + Else + doUnitTest = 1 + End If +End Function diff --git a/basic/qa/basic_coverage/test_getguitype_method.vb b/basic/qa/basic_coverage/test_getguitype_method.vb new file mode 100644 index 000000000..c1606da10 --- /dev/null +++ b/basic/qa/basic_coverage/test_getguitype_method.vb @@ -0,0 +1,15 @@ +' 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/. +' + +Function doUnitTest as Integer + ' GETGUITYPE + If ( GetGuiType = 0 ) Then + doUnitTest = 0 + Else + doUnitTest = 1 + End If +End Function diff --git a/basic/qa/basic_coverage/test_getguiversion_method.vb b/basic/qa/basic_coverage/test_getguiversion_method.vb new file mode 100644 index 000000000..a70ff07e6 --- /dev/null +++ b/basic/qa/basic_coverage/test_getguiversion_method.vb @@ -0,0 +1,15 @@ +' 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/. +' + +Function doUnitTest as Integer + ' GETGUIVERSION + If ( GetGuiVersion = 0 ) Then + doUnitTest = 0 + Else + doUnitTest = 1 + End If +End Function diff --git a/basic/qa/basic_coverage/test_getpathseparator_method.vb b/basic/qa/basic_coverage/test_getpathseparator_method.vb new file mode 100644 index 000000000..63a7b6737 --- /dev/null +++ b/basic/qa/basic_coverage/test_getpathseparator_method.vb @@ -0,0 +1,15 @@ +' 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/. +' + +Function doUnitTest as Integer + ' GETPATHSEPARATOR + If ( GetPathSeparator = "" ) Then + doUnitTest = 0 + Else + doUnitTest = 1 + End If +End Function diff --git a/basic/qa/basic_coverage/test_getprocessservicemanager_method.vb b/basic/qa/basic_coverage/test_getprocessservicemanager_method.vb new file mode 100644 index 000000000..90e2012d6 --- /dev/null +++ b/basic/qa/basic_coverage/test_getprocessservicemanager_method.vb @@ -0,0 +1,12 @@ +' 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/. +' + +Function doUnitTest as Integer + ' GetProcessServiceManager + GetProcessServiceManager() + doUnitTest = 1 +End Function diff --git a/basic/qa/basic_coverage/test_getsolarversion_method.vb b/basic/qa/basic_coverage/test_getsolarversion_method.vb new file mode 100644 index 000000000..c2a75d11d --- /dev/null +++ b/basic/qa/basic_coverage/test_getsolarversion_method.vb @@ -0,0 +1,15 @@ +' 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/. +' + +Function doUnitTest as Integer + ' GetSolarVersion + If ( GetSolarVersion() < 50000) Then + doUnitTest = 0 + Else + doUnitTest = 1 + End If +End Function diff --git a/basic/qa/basic_coverage/test_getsystemtype_method.vb b/basic/qa/basic_coverage/test_getsystemtype_method.vb new file mode 100644 index 000000000..eced70204 --- /dev/null +++ b/basic/qa/basic_coverage/test_getsystemtype_method.vb @@ -0,0 +1,15 @@ +' 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/. +' + +Function doUnitTest as Integer + ' GETSYSTEMTYPE + If ( GetSystemType <> -1 ) Then + doUnitTest = 0 + Else + doUnitTest = 1 + End If +End Function diff --git a/basic/qa/basic_coverage/test_hasunointerfaces_method.vb b/basic/qa/basic_coverage/test_hasunointerfaces_method.vb new file mode 100644 index 000000000..06472d847 --- /dev/null +++ b/basic/qa/basic_coverage/test_hasunointerfaces_method.vb @@ -0,0 +1,16 @@ +' 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/. +' + +Function doUnitTest as Integer + ' HASUNOINTERFACES + dim aObject as Object + If ( HasUnoInterfaces( aObject, "com.sun.star.beans.XIntrospection" ) ) Then + doUnitTest = 0 + Else + doUnitTest = 1 + End If +End Function diff --git a/basic/qa/basic_coverage/test_hex_method.vb b/basic/qa/basic_coverage/test_hex_method.vb new file mode 100644 index 000000000..72edd9d8e --- /dev/null +++ b/basic/qa/basic_coverage/test_hex_method.vb @@ -0,0 +1,15 @@ +' 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/. +' + +Function doUnitTest as Integer + ' HEX + If ( Hex(100) <> "64") Then + doUnitTest = 0 + Else + doUnitTest = 1 + End If +End Function diff --git a/basic/qa/basic_coverage/test_hour_method.vb b/basic/qa/basic_coverage/test_hour_method.vb new file mode 100644 index 000000000..e132775f8 --- /dev/null +++ b/basic/qa/basic_coverage/test_hour_method.vb @@ -0,0 +1,16 @@ +' +' 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/. +' + +Function doUnitTest as Integer + ' HOUR + If ( Hour(TimeSerial(12,30,41)) <> 12 ) Then + doUnitTest = 0 + Else + doUnitTest = 1 + End If +End Function diff --git a/basic/qa/basic_coverage/test_iif_method.vb b/basic/qa/basic_coverage/test_iif_method.vb new file mode 100644 index 000000000..502cadcb3 --- /dev/null +++ b/basic/qa/basic_coverage/test_iif_method.vb @@ -0,0 +1,16 @@ +' +' 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/. +' + +Function doUnitTest as Integer + ' IIF + If ( IIF(True, 10, 12) <> 10 ) Then + doUnitTest = 0 + Else + doUnitTest = 1 + End If +End Function diff --git a/basic/qa/basic_coverage/test_instr_method.vb b/basic/qa/basic_coverage/test_instr_method.vb new file mode 100644 index 000000000..716aa2158 --- /dev/null +++ b/basic/qa/basic_coverage/test_instr_method.vb @@ -0,0 +1,17 @@ +' 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/. +' + +Function doUnitTest as Integer + dim aString as Variant + aString = "Hello" + ' InStr + If ( InStr( 1, aString, "l", 1) <> 3 ) Then + doUnitTest = 0 + Else + doUnitTest = 1 + End If +End Function diff --git a/basic/qa/basic_coverage/test_int_method.vb b/basic/qa/basic_coverage/test_int_method.vb new file mode 100644 index 000000000..69e811648 --- /dev/null +++ b/basic/qa/basic_coverage/test_int_method.vb @@ -0,0 +1,15 @@ +' 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/. +' + +Function doUnitTest as Integer + ' INT + If ( Int(PI) <> 3 ) Then + doUnitTest = 0 + Else + doUnitTest = 1 + End If +End Function diff --git a/basic/qa/basic_coverage/test_isarray_method.vb b/basic/qa/basic_coverage/test_isarray_method.vb new file mode 100644 index 000000000..9d73984b5 --- /dev/null +++ b/basic/qa/basic_coverage/test_isarray_method.vb @@ -0,0 +1,18 @@ +' +' 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/. +' + +Function doUnitTest as Integer + dim aVector as Variant + aVector = Array( 123, "Hello", -3.14) + ' ISARRAY + If ( IsArray( aVector ) = False ) Then + doUnitTest = 0 + Else + doUnitTest = 1 + End If +End Function diff --git a/basic/qa/basic_coverage/test_isdate_method.vb b/basic/qa/basic_coverage/test_isdate_method.vb new file mode 100644 index 000000000..5ce72f87b --- /dev/null +++ b/basic/qa/basic_coverage/test_isdate_method.vb @@ -0,0 +1,18 @@ +' +' 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/. +' + +Function doUnitTest as Integer + dim aDate as Date + aDate = Date( ) + ' ISDATE + If ( IsDate( aDate ) = False ) Then + doUnitTest = 0 + Else + doUnitTest = 1 + End If +End Function diff --git a/basic/qa/basic_coverage/test_isempty_method.vb b/basic/qa/basic_coverage/test_isempty_method.vb new file mode 100644 index 000000000..6ca2fae6d --- /dev/null +++ b/basic/qa/basic_coverage/test_isempty_method.vb @@ -0,0 +1,18 @@ +' +' 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/. +' + +Function doUnitTest as Integer + dim aVariant as Variant + aVariant = Date( ) + ' ISEMPTY + If ( IsEmpty( aVariant ) ) Then + doUnitTest = 0 + Else + doUnitTest = 1 + End If +End Function diff --git a/basic/qa/basic_coverage/test_iserror_method.vb b/basic/qa/basic_coverage/test_iserror_method.vb new file mode 100644 index 000000000..fb12abe6a --- /dev/null +++ b/basic/qa/basic_coverage/test_iserror_method.vb @@ -0,0 +1,22 @@ +' +' 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/. +' + +Type MyType + tName as String +End Type + +Function doUnitTest as Integer + dim aVariant as MyType + aVariant.tName = "A string" + ' ISERROR + If ( IsError( aVariant ) ) Then + doUnitTest = 0 + Else + doUnitTest = 1 + End If +End Function diff --git a/basic/qa/basic_coverage/test_ismissing_basic.vb b/basic/qa/basic_coverage/test_ismissing_basic.vb new file mode 100644 index 000000000..b838ce718 --- /dev/null +++ b/basic/qa/basic_coverage/test_ismissing_basic.vb @@ -0,0 +1,190 @@ +Dim passCount As Integer +Dim failCount As Integer +Dim result As String + +Const IsMissingNone = -1 +Const IsMissingA = 0 +Const IsMissingB = 1 +Const IsMissingAB = 2 + +Function doUnitTest() As String + result = verify_testIsMissingBasic() + If failCount <> 0 Or passCount = 0 Then + doUnitTest = 0 + Else + doUnitTest = 1 + End If +End Function + +' tdf#36737 - Test optionals with different datatypes. In LO Basic, optional +' parameters are allowed, but without any default values. Missing optional parameters +' will not be initialized to their respective default values of its datatype, either. +Function verify_testIsMissingBasic() As String + + passCount = 0 + failCount = 0 + + result = "Test Results" & Chr$(10) & "============" & Chr$(10) + testName = "Test missing (Basic)" + On Error GoTo errorHandler + + ' optionals with variant datatypes + TestLog_ASSERT TestOptVariant(), IsMissingAB, "TestOptVariant()" + TestLog_ASSERT TestOptVariant(123), IsMissingB, "TestOptVariant(123)" + TestLog_ASSERT TestOptVariant(, 456), IsMissingA, "TestOptVariant(, 456)" + TestLog_ASSERT TestOptVariant(123, 456), IsMissingNone, "TestOptVariant(123, 456)" + + ' optionals with variant datatypes (ByRef and ByVal) + TestLog_ASSERT TestOptVariantByRefByVal(), IsMissingAB, "TestOptVariantByRefByVal()" + TestLog_ASSERT TestOptVariantByRefByVal(123), IsMissingB, "TestOptVariantByRefByVal(123)" + TestLog_ASSERT TestOptVariantByRefByVal(, 456), IsMissingA, "TestOptVariantByRefByVal(, 456)" + TestLog_ASSERT TestOptVariantByRefByVal(123, 456), IsMissingNone, "TestOptVariantByRefByVal(123, 456)" + + ' optionals with double datatypes + TestLog_ASSERT TestOptDouble(), IsMissingAB, "TestOptDouble()" + TestLog_ASSERT TestOptDouble(123.4), IsMissingB, "TestOptDouble(123.4)" + TestLog_ASSERT TestOptDouble(, 567.8), IsMissingA, "TestOptDouble(, 567.8)" + TestLog_ASSERT TestOptDouble(123.4, 567.8), IsMissingNone, "TestOptDouble(123.4, 567.8)" + + ' optionals with double datatypes (ByRef and ByVal) + TestLog_ASSERT TestOptDoubleByRefByVal(), IsMissingAB, "TestOptDouble()" + TestLog_ASSERT TestOptDoubleByRefByVal(123.4), IsMissingB, "TestOptDouble(123.4)" + TestLog_ASSERT TestOptDoubleByRefByVal(, 567.8), IsMissingA, "TestOptDoubleByRefByVal(, 567.8)" + TestLog_ASSERT TestOptDoubleByRefByVal(123.4, 567.8), IsMissingNone, "TestOptDoubleByRefByVal(123.4, 567.8)" + + ' optionals with integer datatypes + TestLog_ASSERT TestOptInteger(), IsMissingAB, "TestOptInteger()" + TestLog_ASSERT TestOptInteger(123), IsMissingB, "TestOptInteger(123)" + TestLog_ASSERT TestOptInteger(, 456), IsMissingA, "TestOptInteger(, 456)" + TestLog_ASSERT TestOptInteger(123, 456), IsMissingNone, "TestOptInteger(123, 456)" + + ' optionals with integer datatypes (ByRef and ByVal) + TestLog_ASSERT TestOptIntegerByRefByVal(), IsMissingAB, "TestOptIntegerByRefByVal()" + TestLog_ASSERT TestOptIntegerByRefByVal(123), IsMissingB, "TestOptIntegerByRefByVal(123)" + TestLog_ASSERT TestOptIntegerByRefByVal(, 456), IsMissingA, "TestOptIntegerByRefByVal(, 456)" + TestLog_ASSERT TestOptIntegerByRefByVal(123, 456), IsMissingNone, "TestOptIntegerByRefByVal(123, 456)" + + ' optionals with string datatypes + TestLog_ASSERT TestOptString(), IsMissingAB, "TestOptString()" + TestLog_ASSERT TestOptString("123"), IsMissingB, "TestOptString(""123"")" + TestLog_ASSERT TestOptString(, "456"), IsMissingA, "TestOptString(, ""456"")" + TestLog_ASSERT TestOptString("123", "456"), IsMissingNone, "TestOptString(""123"", ""456"")" + + ' optionals with string datatypes (ByRef and ByVal) + TestLog_ASSERT TestOptStringByRefByVal(), IsMissingAB, "TestOptStringByRefByVal()" + TestLog_ASSERT TestOptStringByRefByVal("123"), IsMissingB, "TestOptStringByRefByVal(""123"")" + TestLog_ASSERT TestOptStringByRefByVal(, "456"), IsMissingA, "TestOptStringByRefByVal(, ""456"")" + TestLog_ASSERT TestOptStringByRefByVal("123", "456"), IsMissingNone, "TestOptStringByRefByVal(""123"", ""456"")" + + ' optionals with object datatypes + Dim cA As New Collection + cA.Add (123) + cA.Add (456) + Dim cB As New Collection + cB.Add (123.4) + cB.Add (567.8) + TestLog_ASSERT TestOptObject(), IsMissingAB, "TestOptObject()" + TestLog_ASSERT TestOptObject(cA), IsMissingB, "TestOptObject(A)" + TestLog_ASSERT TestOptObject(, cB), IsMissingA, "TestOptObject(, B)" + TestLog_ASSERT TestOptObject(cA, cB), IsMissingNone, "TestOptObject(A, B)" + + ' optionals with object datatypes (ByRef and ByVal) + TestLog_ASSERT TestOptObjectByRefByVal(), IsMissingAB, "TestOptObjectByRefByVal()" + TestLog_ASSERT TestOptObjectByRefByVal(cA), IsMissingB, "TestOptObjectByRefByVal(A)" + TestLog_ASSERT TestOptObjectByRefByVal(, cB), IsMissingA, "TestOptObjectByRefByVal(, B)" + TestLog_ASSERT TestOptObjectByRefByVal(cA, cB), IsMissingNone, "TestOptObjectByRefByVal(A, B)" + + ' optionals with array datatypes + Dim aA(0 To 1) As Integer + aA(0) = 123 + aA(1) = 456 + Dim aB(0 To 1) As Variant + aB(0) = 123.4 + aB(1) = 567.8 + TestLog_ASSERT TestOptArray(), IsMissingAB, "TestOptArray()" + TestLog_ASSERT TestOptArray(aA), IsMissingB, "TestOptArray(A)" + TestLog_ASSERT TestOptArray(, aB), IsMissingA, "TestOptArray(, B)" + TestLog_ASSERT TestOptArray(aA, aB), IsMissingNone, "TestOptArray(A, B)" + + ' optionals with array datatypes (ByRef and ByVal) + TestLog_ASSERT TestOptArrayByRefByVal(), IsMissingAB, "TestOptArrayByRefByVal()" + TestLog_ASSERT TestOptArrayByRefByVal(aA), IsMissingB, "TestOptArrayByRefByVal(A)" + TestLog_ASSERT TestOptArrayByRefByVal(, aB), IsMissingA, "TestOptArrayByRefByVal(, B)" + TestLog_ASSERT TestOptArrayByRefByVal(aA, aB), IsMissingNone, "TestOptArrayByRefByVal(A, B)" + + result = result & Chr$(10) & "Tests passed: " & passCount & Chr$(10) & "Tests failed: " & failCount & Chr$(10) + verify_testIsMissingBasic = result + + Exit Function +errorHandler: + TestLog_ASSERT False, True, Err.Description +End Function + +Function TestOptVariant(Optional A, Optional B As Variant) + TestOptVariant = WhatIsMissing(IsMissing(A), IsMissing(B)) +End Function + +Function TestOptVariantByRefByVal(Optional ByRef A, Optional ByVal B As Variant) + TestOptVariantByRefByVal = WhatIsMissing(IsMissing(A), IsMissing(B)) +End Function + +Function TestOptDouble(Optional A As Double, Optional B As Double) + TestOptDouble = WhatIsMissing(IsMissing(A), IsMissing(B)) +End Function + +Function TestOptDoubleByRefByVal(Optional ByRef A As Double, Optional ByVal B As Double) + TestOptDoubleByRefByVal = WhatIsMissing(IsMissing(A), IsMissing(B)) +End Function + +Function TestOptInteger(Optional A As Integer, Optional B As Integer) + TestOptInteger = WhatIsMissing(IsMissing(A), IsMissing(B)) +End Function + +Function TestOptIntegerByRefByVal(Optional ByRef A As Integer, Optional ByVal B As Integer) + TestOptIntegerByRefByVal = WhatIsMissing(IsMissing(A), IsMissing(B)) +End Function + +Function TestOptString(Optional A As String, Optional B As String) + TestOptString = WhatIsMissing(IsMissing(A), IsMissing(B)) +End Function + +Function TestOptStringByRefByVal(Optional ByRef A As String, Optional ByVal B As String) + TestOptStringByRefByVal = WhatIsMissing(IsMissing(A), IsMissing(B)) +End Function + +Function TestOptObject(Optional A As Collection, Optional B As Collection) + TestOptObject = WhatIsMissing(IsMissing(A), IsMissing(B)) +End Function + +Function TestOptObjectByRefByVal(Optional ByRef A As Collection, Optional ByVal B As Collection) + TestOptObjectByRefByVal = WhatIsMissing(IsMissing(A), IsMissing(B)) +End Function + +Function TestOptArray(Optional A() As Integer, Optional B() As Variant) + TestOptArray = WhatIsMissing(IsMissing(A), IsMissing(B)) +End Function + +Function TestOptArrayByRefByVal(Optional ByRef A() As Integer, Optional ByVal B() As Variant) + TestOptArrayByRefByVal = WhatIsMissing(IsMissing(A), IsMissing(B)) +End Function + +Function WhatIsMissing(is_missingA, is_missingB) + If is_missingA And is_missingB Then + WhatIsMissing = IsMissingAB + ElseIf is_missingA Then + WhatIsMissing = IsMissingA + ElseIf is_missingB Then + WhatIsMissing = IsMissingB + Else + WhatIsMissing = IsMissingNone + End If +End Function + +Sub TestLog_ASSERT(actual As Variant, expected As Integer, testName As String) + If expected = actual Then + passCount = passCount + 1 + Else + result = result & Chr$(10) & " Failed: " & testName & " returned " & actual & ", expected " & expected + failCount = failCount + 1 + End If +End Sub
\ No newline at end of file diff --git a/basic/qa/basic_coverage/test_ismissing_cascade.vb b/basic/qa/basic_coverage/test_ismissing_cascade.vb new file mode 100644 index 000000000..ad967c7bb --- /dev/null +++ b/basic/qa/basic_coverage/test_ismissing_cascade.vb @@ -0,0 +1,51 @@ +Dim passCount As Integer +Dim failCount As Integer +Dim result As String + +Function doUnitTest() As String + result = verify_testIsMissingCascade() + If failCount <> 0 Or passCount = 0 Then + doUnitTest = 0 + Else + doUnitTest = 1 + End If +End Function + +Function verify_testIsMissingCascade() As String + + passCount = 0 + failCount = 0 + + result = "Test Results" & Chr$(10) & "============" & Chr$(10) + testName = "Test missing (IsMissing with cascading optionals)" + On Error GoTo errorHandler + + ' tdf#136143 - test cascading optionals in order to prevent type conversion errors, because + ' optional arguments are of type SbxERROR and set to not fixed. + TestLog_ASSERT TestOpt(), 2, "Cascading optionals" + + result = result & Chr$(10) & "Tests passed: " & passCount & Chr$(10) & "Tests failed: " & failCount & Chr$(10) + verify_testIsMissingCascade = result + + Exit Function +errorHandler: + TestLog_ASSERT False, True, Err.Description +End Function + +Function TestOpt(Optional A) + TestOpt = TestOptCascade(A) +End Function + +Function TestOptCascade(Optional A) + If IsMissing(A) Then A = 2 + TestOptCascade = A +End Function + +Sub TestLog_ASSERT(actual As Variant, expected As Integer, testName As String) + If expected = actual Then + passCount = passCount + 1 + Else + result = result & Chr$(10) & " Failed: " & testName & " returned " & actual & ", expected " & expected + failCount = failCount + 1 + End If +End Sub
\ No newline at end of file diff --git a/basic/qa/basic_coverage/test_ismissing_compatible.vb b/basic/qa/basic_coverage/test_ismissing_compatible.vb new file mode 100644 index 000000000..dbe2a815d --- /dev/null +++ b/basic/qa/basic_coverage/test_ismissing_compatible.vb @@ -0,0 +1,193 @@ +Option Compatible + +Dim passCount As Integer +Dim failCount As Integer +Dim result As String + +Const IsMissingNone = -1 +Const IsMissingA = 0 +Const IsMissingB = 1 +Const IsMissingAB = 2 + +Function doUnitTest() As String + result = verify_testIsMissingCompatible() + If failCount <> 0 Or passCount = 0 Then + doUnitTest = 0 + Else + doUnitTest = 1 + End If +End Function + +' tdf#36737 - Test isMissing function with different datatypes. In LO Basic +' with option Compatible, optional parameters are allowed with default values. +' Missing optional parameters that don't have explicit default values will +' not be initialized to their default values of its datatype. +Function verify_testIsMissingCompatible() As String + + passCount = 0 + failCount = 0 + + result = "Test Results" & Chr$(10) & "============" & Chr$(10) + testName = "Test missing (Compatible)" + On Error GoTo errorHandler + + ' optionals with variant datatypes + TestLog_ASSERT TestOptVariant(), IsMissingA, "TestOptVariant()" + TestLog_ASSERT TestOptVariant(123), IsMissingNone, "TestOptVariant(123)" + TestLog_ASSERT TestOptVariant(, 456), IsMissingA, "TestOptVariant(, 456)" + TestLog_ASSERT TestOptVariant(123, 456), IsMissingNone, "TestOptVariant(123, 456)" + + ' optionals with variant datatypes (ByRef and ByVal) + TestLog_ASSERT TestOptVariantByRefByVal(), IsMissingA, "TestOptVariantByRefByVal()" + TestLog_ASSERT TestOptVariantByRefByVal(123), IsMissingNone, "TestOptVariantByRefByVal(123)" + TestLog_ASSERT TestOptVariantByRefByVal(, 456), IsMissingA, "TestOptVariantByRefByVal(, 456)" + TestLog_ASSERT TestOptVariantByRefByVal(123, 456), IsMissingNone, "TestOptVariantByRefByVal(123, 456)" + + ' optionals with double datatypes + TestLog_ASSERT TestOptDouble(), IsMissingA, "TestOptDouble()" + TestLog_ASSERT TestOptDouble(123.4), IsMissingNone, "TestOptDouble(123.4)" + TestLog_ASSERT TestOptDouble(, 567.8), IsMissingA, "TestOptDouble(, 567.8)" + TestLog_ASSERT TestOptDouble(123.4, 567.8), IsMissingNone, "TestOptDouble(123.4, 567.8)" + + ' optionals with double datatypes (ByRef and ByVal) + TestLog_ASSERT TestOptDoubleByRefByVal(), IsMissingA, "TestOptDouble()" + TestLog_ASSERT TestOptDoubleByRefByVal(123.4), IsMissingNone, "TestOptDouble(123.4)" + TestLog_ASSERT TestOptDoubleByRefByVal(, 567.8), IsMissingA, "TestOptDoubleByRefByVal(, 567.8)" + TestLog_ASSERT TestOptDoubleByRefByVal(123.4, 567.8), IsMissingNone, "TestOptDoubleByRefByVal(123.4, 567.8)" + + ' optionals with integer datatypes + TestLog_ASSERT TestOptInteger(), IsMissingA, "TestOptInteger()" + TestLog_ASSERT TestOptInteger(123), IsMissingNone, "TestOptInteger(123)" + TestLog_ASSERT TestOptInteger(, 456), IsMissingA, "TestOptInteger(, 456)" + TestLog_ASSERT TestOptInteger(123, 456), IsMissingNone, "TestOptInteger(123, 456)" + + ' optionals with integer datatypes (ByRef and ByVal) + TestLog_ASSERT TestOptIntegerByRefByVal(), IsMissingA, "TestOptIntegerByRefByVal()" + TestLog_ASSERT TestOptIntegerByRefByVal(123), IsMissingNone, "TestOptIntegerByRefByVal(123)" + TestLog_ASSERT TestOptIntegerByRefByVal(, 456), IsMissingA, "TestOptIntegerByRefByVal(, 456)" + TestLog_ASSERT TestOptIntegerByRefByVal(123, 456), IsMissingNone, "TestOptIntegerByRefByVal(123, 456)" + + ' optionals with string datatypes + TestLog_ASSERT TestOptString(), IsMissingA, "TestOptString()" + TestLog_ASSERT TestOptString("123"), IsMissingNone, "TestOptString(""123"")" + TestLog_ASSERT TestOptString(, "456"), IsMissingA, "TestOptString(, ""456"")" + TestLog_ASSERT TestOptString("123", "456"), IsMissingNone, "TestOptString(""123"", ""456"")" + + ' optionals with string datatypes (ByRef and ByVal) + TestLog_ASSERT TestOptStringByRefByVal(), IsMissingA, "TestOptStringByRefByVal()" + TestLog_ASSERT TestOptStringByRefByVal("123"), IsMissingNone, "TestOptStringByRefByVal(""123"")" + TestLog_ASSERT TestOptStringByRefByVal(, "456"), IsMissingA, "TestOptStringByRefByVal(, ""456"")" + TestLog_ASSERT TestOptStringByRefByVal("123", "456"), IsMissingNone, "TestOptStringByRefByVal(""123"", ""456"")" + + ' optionals with object datatypes + Dim cA As New Collection + cA.Add (123) + cA.Add (456) + Dim cB As New Collection + cB.Add (123.4) + cB.Add (567.8) + TestLog_ASSERT TestOptObject(), IsMissingAB, "TestOptObject()" + TestLog_ASSERT TestOptObject(cA), IsMissingB, "TestOptObject(A)" + TestLog_ASSERT TestOptObject(, cB), IsMissingA, "TestOptObject(, B)" + TestLog_ASSERT TestOptObject(cA, cB), IsMissingNone, "TestOptObject(A, B)" + + ' optionals with object datatypes (ByRef and ByVal) + TestLog_ASSERT TestOptObjectByRefByVal(), IsMissingAB, "TestOptObjectByRefByVal()" + TestLog_ASSERT TestOptObjectByRefByVal(cA), IsMissingB, "TestOptObjectByRefByVal(A)" + TestLog_ASSERT TestOptObjectByRefByVal(, cB), IsMissingA, "TestOptObjectByRefByVal(, B)" + TestLog_ASSERT TestOptObjectByRefByVal(cA, cB), IsMissingNone, "TestOptObjectByRefByVal(A, B)" + + ' optionals with array datatypes + Dim aA(0 To 1) As Integer + aA(0) = 123 + aA(1) = 456 + Dim aB(0 To 1) As Variant + aB(0) = 123.4 + aB(1) = 567.8 + TestLog_ASSERT TestOptArray(), IsMissingAB, "TestOptArray()" + TestLog_ASSERT TestOptArray(aA), IsMissingB, "TestOptArray(A)" + TestLog_ASSERT TestOptArray(, aB), IsMissingA, "TestOptArray(, B)" + TestLog_ASSERT TestOptArray(aA, aB), IsMissingNone, "TestOptArray(A, B)" + + ' optionals with array datatypes (ByRef and ByVal) + TestLog_ASSERT TestOptArrayByRefByVal(), IsMissingAB, "TestOptArrayByRefByVal()" + TestLog_ASSERT TestOptArrayByRefByVal(aA), IsMissingB, "TestOptArrayByRefByVal(A)" + TestLog_ASSERT TestOptArrayByRefByVal(, aB), IsMissingA, "TestOptArrayByRefByVal(, B)" + TestLog_ASSERT TestOptArrayByRefByVal(aA, aB), IsMissingNone, "TestOptArrayByRefByVal(A, B)" + + result = result & Chr$(10) & "Tests passed: " & passCount & Chr$(10) & "Tests failed: " & failCount & Chr$(10) + verify_testIsMissingCompatible = result + + Exit Function +errorHandler: + TestLog_ASSERT False, True, Err.Description +End Function + +Function TestOptVariant(Optional A, Optional B As Variant = 123) + TestOptVariant = WhatIsMissing(IsMissing(A), IsMissing(B)) +End Function + +Function TestOptVariantByRefByVal(Optional ByRef A, Optional ByVal B As Variant = 123) + TestOptVariantByRefByVal = WhatIsMissing(IsMissing(A), IsMissing(B)) +End Function + +Function TestOptDouble(Optional A As Double, Optional B As Double = 123.4) + TestOptDouble = WhatIsMissing(IsMissing(A), IsMissing(B)) +End Function + +Function TestOptDoubleByRefByVal(Optional ByRef A As Double, Optional ByVal B As Double = 123.4) + TestOptDoubleByRefByVal = WhatIsMissing(IsMissing(A), IsMissing(B)) +End Function + +Function TestOptInteger(Optional A As Integer, Optional B As Integer = 123) + TestOptInteger = WhatIsMissing(IsMissing(A), IsMissing(B)) +End Function + +Function TestOptIntegerByRefByVal(Optional ByRef A As Integer, Optional ByVal B As Integer = 123) + TestOptIntegerByRefByVal = WhatIsMissing(IsMissing(A), IsMissing(B)) +End Function + +Function TestOptString(Optional A As String, Optional B As String = "123") + TestOptString = WhatIsMissing(IsMissing(A), IsMissing(B)) +End Function + +Function TestOptStringByRefByVal(Optional ByRef A As String, Optional ByVal B As String = "123") + TestOptStringByRefByVal = WhatIsMissing(IsMissing(A), IsMissing(B)) +End Function + +Function TestOptObject(Optional A As Collection, Optional B As Collection) + TestOptObject = WhatIsMissing(IsMissing(A), IsMissing(B)) +End Function + +Function TestOptObjectByRefByVal(Optional ByRef A As Collection, Optional ByVal B As Collection) + TestOptObjectByRefByVal = WhatIsMissing(IsMissing(A), IsMissing(B)) +End Function + +Function TestOptArray(Optional A() As Integer, Optional B() As Variant) + TestOptArray = WhatIsMissing(IsMissing(A), IsMissing(B)) +End Function + +Function TestOptArrayByRefByVal(Optional ByRef A() As Integer, Optional ByVal B() As Variant) + TestOptArrayByRefByVal = WhatIsMissing(IsMissing(A), IsMissing(B)) +End Function + +Function WhatIsMissing(is_missingA, is_missingB) + If is_missingA And is_missingB Then + WhatIsMissing = IsMissingAB + ElseIf is_missingA Then + WhatIsMissing = IsMissingA + ElseIf is_missingB Then + WhatIsMissing = IsMissingB + Else + WhatIsMissing = IsMissingNone + End If +End Function + +Sub TestLog_ASSERT(actual As Variant, expected As Variant, testName As String) + If expected = actual Then + passCount = passCount + 1 + Else + result = result & Chr$(10) & " Failed: " & testName & " returned " & actual & ", expected " & expected + failCount = failCount + 1 + End If +End Sub
\ No newline at end of file diff --git a/basic/qa/basic_coverage/test_isnull_method.vb b/basic/qa/basic_coverage/test_isnull_method.vb new file mode 100644 index 000000000..0d9044d8f --- /dev/null +++ b/basic/qa/basic_coverage/test_isnull_method.vb @@ -0,0 +1,18 @@ +' +' 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/. +' + +Function doUnitTest as Integer + dim aVariant as Variant + aVariant = Null + ' ISNULL + If ( IsNull( aVariant ) = False ) Then + doUnitTest = 0 + Else + doUnitTest = 1 + End If +End Function diff --git a/basic/qa/basic_coverage/test_isnumeric_method.vb b/basic/qa/basic_coverage/test_isnumeric_method.vb new file mode 100644 index 000000000..d3b614f56 --- /dev/null +++ b/basic/qa/basic_coverage/test_isnumeric_method.vb @@ -0,0 +1,18 @@ +' +' 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/. +' + +Function doUnitTest as Integer + dim aVariant as Variant + aVariant = 3 + ' ISNUMERIC + If ( IsNumeric( aVariant ) = False ) Then + doUnitTest = 0 + Else + doUnitTest = 1 + End If +End Function diff --git a/basic/qa/basic_coverage/test_isobject_method.vb b/basic/qa/basic_coverage/test_isobject_method.vb new file mode 100644 index 000000000..bb5e270b3 --- /dev/null +++ b/basic/qa/basic_coverage/test_isobject_method.vb @@ -0,0 +1,17 @@ +' +' 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/. +' + +Function doUnitTest as Integer + dim aVariant as Object + ' ISOBJECT + If ( IsObject( aVariant ) = False ) Then + doUnitTest = 0 + Else + doUnitTest = 1 + End If +End Function diff --git a/basic/qa/basic_coverage/test_isunostruct_method.vb b/basic/qa/basic_coverage/test_isunostruct_method.vb new file mode 100644 index 000000000..ac45f1961 --- /dev/null +++ b/basic/qa/basic_coverage/test_isunostruct_method.vb @@ -0,0 +1,17 @@ +' +' 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/. +' + +Function doUnitTest as Integer + dim aVariant as Object + ' ISUNOSTRUCT + If ( IsUnoStruct( aVariant ) ) Then + doUnitTest = 0 + Else + doUnitTest = 1 + End If +End Function diff --git a/basic/qa/basic_coverage/test_join_method.vb b/basic/qa/basic_coverage/test_join_method.vb new file mode 100644 index 000000000..236062516 --- /dev/null +++ b/basic/qa/basic_coverage/test_join_method.vb @@ -0,0 +1,18 @@ +' 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/. +' + +Function doUnitTest as Integer + ' Join + Dim aStrings(2) as String + aStrings(0) = "Hello" + aStrings(1) = "world" + If ( Join( aStrings, " " ) <> "Hello world " ) Then + doUnitTest = 0 + Else + doUnitTest = 1 + End If +End Function diff --git a/basic/qa/basic_coverage/test_lbound_method.vb b/basic/qa/basic_coverage/test_lbound_method.vb new file mode 100644 index 000000000..b7a91fd3f --- /dev/null +++ b/basic/qa/basic_coverage/test_lbound_method.vb @@ -0,0 +1,19 @@ +' +' 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/. +' + +Function doUnitTest as Integer + dim aVector as Variant + ' ARRAY + aVector = Array( "Hello", -3.14) + ' LBOUND + If ( LBound( aVector() ) <> 0 ) Then + doUnitTest = 0 + Else + doUnitTest = 1 + End If +End Function diff --git a/basic/qa/basic_coverage/test_lcase_method.vb b/basic/qa/basic_coverage/test_lcase_method.vb new file mode 100644 index 000000000..65df764ef --- /dev/null +++ b/basic/qa/basic_coverage/test_lcase_method.vb @@ -0,0 +1,17 @@ +' 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/. +' + +Function doUnitTest as Integer + dim aString as Variant + aString = "Hello" + ' LCASE + If ( LCase( aString ) <> "hello" ) Then + doUnitTest = 0 + Else + doUnitTest = 1 + End If +End Function diff --git a/basic/qa/basic_coverage/test_len_method.vb b/basic/qa/basic_coverage/test_len_method.vb new file mode 100644 index 000000000..0a7e1abf2 --- /dev/null +++ b/basic/qa/basic_coverage/test_len_method.vb @@ -0,0 +1,17 @@ +' 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/. +' + +Function doUnitTest as Integer + dim aString as Variant + aString = "Hello" + ' LEN + If ( Len( aString ) <> 5 ) Then + doUnitTest = 0 + Else + doUnitTest = 1 + End If +End Function diff --git a/basic/qa/basic_coverage/test_lenb_method.vb b/basic/qa/basic_coverage/test_lenb_method.vb new file mode 100644 index 000000000..550b8313a --- /dev/null +++ b/basic/qa/basic_coverage/test_lenb_method.vb @@ -0,0 +1,17 @@ +' 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/. +' + +Function doUnitTest as Integer + dim aString as Variant + aString = "Hello" + ' LENB + If ( LenB( aString ) <> 5 ) Then + doUnitTest = 0 + Else + doUnitTest = 1 + End If +End Function diff --git a/basic/qa/basic_coverage/test_logexp_methods.vb b/basic/qa/basic_coverage/test_logexp_methods.vb new file mode 100644 index 000000000..00db99837 --- /dev/null +++ b/basic/qa/basic_coverage/test_logexp_methods.vb @@ -0,0 +1,15 @@ +' 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/. +' + +Function doUnitTest as Integer + ' EXP LOG + If ( Log( Exp(1) ) <> 1 ) Then + doUnitTest = 0 + Else + doUnitTest = 1 + End If +End Function diff --git a/basic/qa/basic_coverage/test_ltrim_method.vb b/basic/qa/basic_coverage/test_ltrim_method.vb new file mode 100644 index 000000000..562193c8b --- /dev/null +++ b/basic/qa/basic_coverage/test_ltrim_method.vb @@ -0,0 +1,17 @@ +' 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/. +' + +Function doUnitTest as Integer + dim aString as Variant + aString = "Hello" + ' LTRIM + If ( LTrim( " Hello" ) <> aString ) Then + doUnitTest = 0 + Else + doUnitTest = 1 + End If +End Function diff --git a/basic/qa/basic_coverage/test_mid_CountNegative_3args.vb b/basic/qa/basic_coverage/test_mid_CountNegative_3args.vb new file mode 100644 index 000000000..d67370626 --- /dev/null +++ b/basic/qa/basic_coverage/test_mid_CountNegative_3args.vb @@ -0,0 +1,15 @@ +' +' 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/. +' + +Function doUnitTest as Integer + If (Mid("abc", 5, -3) = "") Then + doUnitTest = 1 + Else + doUnitTest = 0 + End If +End Function diff --git a/basic/qa/basic_coverage/test_mid_EndOutOfBounds_3args.vb b/basic/qa/basic_coverage/test_mid_EndOutOfBounds_3args.vb new file mode 100644 index 000000000..f54ee9444 --- /dev/null +++ b/basic/qa/basic_coverage/test_mid_EndOutOfBounds_3args.vb @@ -0,0 +1,15 @@ +' +' 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/. +' + +Function doUnitTest as Integer + If (Mid("abc", 1, 4) = "abc") Then + doUnitTest = 1 + Else + doUnitTest = 0 + End If +End Function diff --git a/basic/qa/basic_coverage/test_mid_StartOutOfBounds_2args.vb b/basic/qa/basic_coverage/test_mid_StartOutOfBounds_2args.vb new file mode 100644 index 000000000..5ab01f987 --- /dev/null +++ b/basic/qa/basic_coverage/test_mid_StartOutOfBounds_2args.vb @@ -0,0 +1,15 @@ +' +' 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/. +' + +Function doUnitTest as Integer + If (Mid("abc", 5) = "") Then + doUnitTest = 1 + Else + doUnitTest = 0 + End If +End Function diff --git a/basic/qa/basic_coverage/test_mid_StartOutOfBounds_3args.vb b/basic/qa/basic_coverage/test_mid_StartOutOfBounds_3args.vb new file mode 100644 index 000000000..9c623ce51 --- /dev/null +++ b/basic/qa/basic_coverage/test_mid_StartOutOfBounds_3args.vb @@ -0,0 +1,15 @@ +' +' 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/. +' + +Function doUnitTest as Integer + If (Mid("abc", 5, 1) = "") Then + doUnitTest = 1 + Else + doUnitTest = 0 + End If +End Function diff --git a/basic/qa/basic_coverage/test_mid_firstletter_3args.vb b/basic/qa/basic_coverage/test_mid_firstletter_3args.vb new file mode 100644 index 000000000..72c65099f --- /dev/null +++ b/basic/qa/basic_coverage/test_mid_firstletter_3args.vb @@ -0,0 +1,15 @@ +' +' 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/. +' + +Function doUnitTest as Integer + If (Mid("abc", 1, 1) = "a") Then + doUnitTest = 1 + Else + doUnitTest = 0 + End If +End Function diff --git a/basic/qa/basic_coverage/test_mid_replace_less.vb b/basic/qa/basic_coverage/test_mid_replace_less.vb new file mode 100644 index 000000000..27a02382c --- /dev/null +++ b/basic/qa/basic_coverage/test_mid_replace_less.vb @@ -0,0 +1,19 @@ +' +' 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/. +' + +' cf. <https://bugs.documentfoundation.org/show_bug.cgi?id=62090> "Mid statement doesn't work as +' expected": +Function doUnitTest as Integer + s = "The lightbrown fox" + Mid(s, 5, 10, "lazy") + If (s = "The lazy fox") Then + doUnitTest = 1 + Else + doUnitTest = 0 + End If +End Function diff --git a/basic/qa/basic_coverage/test_mid_replace_more.vb b/basic/qa/basic_coverage/test_mid_replace_more.vb new file mode 100644 index 000000000..880a3f200 --- /dev/null +++ b/basic/qa/basic_coverage/test_mid_replace_more.vb @@ -0,0 +1,19 @@ +' +' 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/. +' + +' cf. examples at <https://docs.microsoft.com/en-us/dotnet/visual-basic/language-reference/ +' statements/mid-statement>: +Function doUnitTest as Integer + s = "The fox jumps" + Mid(s, 5, 3, "duck") + If (s = "The duc jumps") Then + doUnitTest = 1 + Else + doUnitTest = 0 + End If +End Function diff --git a/basic/qa/basic_coverage/test_mid_replace_more_end.vb b/basic/qa/basic_coverage/test_mid_replace_more_end.vb new file mode 100644 index 000000000..c5d26a46a --- /dev/null +++ b/basic/qa/basic_coverage/test_mid_replace_more_end.vb @@ -0,0 +1,19 @@ +' +' 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/. +' + +' cf. examples at <https://docs.microsoft.com/en-us/dotnet/visual-basic/language-reference/ +' statements/mid-statement>: +Function doUnitTest as Integer + s = "The fox jumps" + Mid(s, 5, 100, "cow jumped over") + If (s = "The cow jumpe") Then + doUnitTest = 1 + Else + doUnitTest = 0 + End If +End Function diff --git a/basic/qa/basic_coverage/test_mid_sub2letters_2args.vb b/basic/qa/basic_coverage/test_mid_sub2letters_2args.vb new file mode 100644 index 000000000..76c5360d8 --- /dev/null +++ b/basic/qa/basic_coverage/test_mid_sub2letters_2args.vb @@ -0,0 +1,15 @@ +' +' 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/. +' + +Function doUnitTest as Integer + If (Mid("abc", 2) = "bc") Then + doUnitTest = 1 + Else + doUnitTest = 0 + End If +End Function diff --git a/basic/qa/basic_coverage/test_minute_method.vb b/basic/qa/basic_coverage/test_minute_method.vb new file mode 100644 index 000000000..0f1230462 --- /dev/null +++ b/basic/qa/basic_coverage/test_minute_method.vb @@ -0,0 +1,16 @@ +' +' 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/. +' + +Function doUnitTest as Integer + ' MINUTE + If ( Minute(TimeSerial(12,30,41)) <> 30 ) Then + doUnitTest = 0 + Else + doUnitTest = 1 + End If +End Function diff --git a/basic/qa/basic_coverage/test_month_method.vb b/basic/qa/basic_coverage/test_month_method.vb new file mode 100644 index 000000000..38d8ae406 --- /dev/null +++ b/basic/qa/basic_coverage/test_month_method.vb @@ -0,0 +1,18 @@ +' +' 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/. +' + +Function doUnitTest as Integer + dim aDate as Date + aDate = Date() + ' MONTH + If ( DatePart( "m", aDate ) <> Month( aDate ) ) Then + doUnitTest = 0 + Else + doUnitTest = 1 + End If +End Function diff --git a/basic/qa/basic_coverage/test_nowtimevalue_methods.vb b/basic/qa/basic_coverage/test_nowtimevalue_methods.vb new file mode 100644 index 000000000..42dce2fc6 --- /dev/null +++ b/basic/qa/basic_coverage/test_nowtimevalue_methods.vb @@ -0,0 +1,20 @@ +' +' 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/. +' + +Function doUnitTest as Integer + dim aDate as Date + dim aTime as Date + aDate = Date() + aTime = Time() + ' NOW TIMEVALUE + If ( Now() < aDate + TimeValue(aTime) ) Then + doUnitTest = 0 + Else + doUnitTest = 1 + End If +End Function diff --git a/basic/qa/basic_coverage/test_numeric_constant_parameter.vb b/basic/qa/basic_coverage/test_numeric_constant_parameter.vb new file mode 100644 index 000000000..96a7e8f9c --- /dev/null +++ b/basic/qa/basic_coverage/test_numeric_constant_parameter.vb @@ -0,0 +1,34 @@ +'
+' 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/.
+'
+
+' assigns a numeric constant (integer) to a parameter of type variant
+Function assignInteger( numericConstant ) As String
+ numericConstant = 1
+ assignInteger = TypeName( numericConstant )
+End Function
+
+' assigns a numeric constant (long) to a parameter of type variant
+Function assignLong( numericConstant ) As String
+ numericConstant = 32768
+ assignLong = TypeName( numericConstant )
+End Function
+ +Function doUnitTest() As Integer + ' tdf#133913 - check if numeric constants are converted correctly to
+ ' their respective types, if they are passed as arguments to a function
+ ' with variant parameter types.
+ On Error GoTo errorHandler
+ If (assignInteger( 1 ) = "Integer" And assignLong( 1 ) = "Long") Then
+ doUnitTest = 1
+ Else
+ doUnitTest = 0
+ End If
+ Exit Function
+errorHandler:
+ doUnitTest = 0 +End Function
\ No newline at end of file diff --git a/basic/qa/basic_coverage/test_oct_method.vb b/basic/qa/basic_coverage/test_oct_method.vb new file mode 100644 index 000000000..4c610539d --- /dev/null +++ b/basic/qa/basic_coverage/test_oct_method.vb @@ -0,0 +1,15 @@ +' 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/. +' + +Function doUnitTest as Integer + ' OCT + If ( Oct(100) <> "144" ) Then + doUnitTest = 0 + Else + doUnitTest = 1 + End If +End Function diff --git a/basic/qa/basic_coverage/test_optional_paramter_type.vb b/basic/qa/basic_coverage/test_optional_paramter_type.vb new file mode 100644 index 000000000..37198ea38 --- /dev/null +++ b/basic/qa/basic_coverage/test_optional_paramter_type.vb @@ -0,0 +1,33 @@ +REM ***** BASIC *****
+Option Compatible
+
+Function doUnitTest() As Integer
+ doUnitTest = 0
+ If CheckType1(32) = 0 Then
+ Exit Function
+ End If
+ If CheckType2(32) = 0 Then
+ Exit Function
+ End If
+ If CheckType2() = 0 Then
+ Exit Function
+ End If
+ doUnitTest = 1
+End Function
+
+Function CheckType1(x As Integer) As Integer
+ If TypeName(x) = "Integer" Then
+ CheckType1 = 1
+ Else
+ CheckType1 = 0
+ End If
+End Function
+
+
+Function CheckType2(Optional y As Integer = 32 ) As Integer
+ If TypeName(y) = "Integer" Then
+ CheckType2 = 1
+ Else
+ CheckType2 = 0
+ End If
+End Function
\ No newline at end of file diff --git a/basic/qa/basic_coverage/test_optional_paramters_basic.vb b/basic/qa/basic_coverage/test_optional_paramters_basic.vb new file mode 100644 index 000000000..92a81a861 --- /dev/null +++ b/basic/qa/basic_coverage/test_optional_paramters_basic.vb @@ -0,0 +1,208 @@ +Dim passCount As Integer +Dim failCount As Integer +Dim result As String + +Function doUnitTest() As String + result = verify_testOptionalsBasic() + If failCount <> 0 Or passCount = 0 Then + doUnitTest = 0 + Else + doUnitTest = 1 + End If +End Function + +' tdf#36737 - Test optionals with different datatypes. In LO Basic, optional +' parameters are allowed, but without any default values. Missing optional +' parameters will not be initialized to their respective default values of +' its datatype, either. +Function verify_testOptionalsBasic() As String + + passCount = 0 + failCount = 0 + + result = "Test Results" & Chr$(10) & "============" & Chr$(10) + testName = "Test optionals (Basic)" + On Error GoTo errorHandler + + ' optionals with variant datatypes + TestLog_ASSERT TestOptVariant(), 0, "TestOptVariant()" + TestLog_ASSERT TestOptVariant(123), 123, "TestOptVariant(123)" + TestLog_ASSERT TestOptVariant(, 456), 456, "TestOptVariant(, 456)" + TestLog_ASSERT TestOptVariant(123, 456), 579, "TestOptVariant(123, 456)" + + ' optionals with variant datatypes (ByRef and ByVal) + TestLog_ASSERT TestOptVariantByRefByVal(), 0, "TestOptVariantByRefByVal()" + TestLog_ASSERT TestOptVariantByRefByVal(123), 123, "TestOptVariantByRefByVal(123)" + TestLog_ASSERT TestOptVariantByRefByVal(, 456), 456, "TestOptVariantByRefByVal(, 456)" + TestLog_ASSERT TestOptVariantByRefByVal(123, 456), 579, "TestOptVariantByRefByVal(123, 456)" + + ' optionals with double datatypes + TestLog_ASSERT TestOptDouble(), 0, "TestOptDouble()" + TestLog_ASSERT TestOptDouble(123.4), 123.4, "TestOptDouble(123.4)" + TestLog_ASSERT TestOptDouble(, 567.8), 567.8, "TestOptDouble(, 567.8)" + TestLog_ASSERT CDbl(Format(TestOptDouble(123.4, 567.8), "0.0")), 691.2, "TestOptDouble(123.4, 567.8)" + + ' optionals with double datatypes (ByRef and ByVal) + TestLog_ASSERT TestOptDoubleByRefByVal(), 0, "TestOptDouble()" + TestLog_ASSERT TestOptDoubleByRefByVal(123.4), 123.4, "TestOptDouble(123.4)" + TestLog_ASSERT TestOptDoubleByRefByVal(, 567.8), 567.8, "TestOptDoubleByRefByVal(, 567.8)" + TestLog_ASSERT CDbl(Format(TestOptDoubleByRefByVal(123.4, 567.8), "0.0")), 691.2, "TestOptDoubleByRefByVal(123.4, 567.8)" + + ' optionals with integer datatypes + TestLog_ASSERT TestOptInteger(), 0, "TestOptInteger()" + TestLog_ASSERT TestOptInteger(123), 123, "TestOptInteger(123)" + TestLog_ASSERT TestOptInteger(, 456), 456, "TestOptInteger(, 456)" + TestLog_ASSERT TestOptInteger(123, 456), 579, "TestOptInteger(123, 456)" + + ' optionals with integer datatypes (ByRef and ByVal) + TestLog_ASSERT TestOptIntegerByRefByVal(), 0, "TestOptIntegerByRefByVal()" + TestLog_ASSERT TestOptIntegerByRefByVal(123), 123, "TestOptIntegerByRefByVal(123)" + TestLog_ASSERT TestOptIntegerByRefByVal(, 456), 456, "TestOptIntegerByRefByVal(, 456)" + TestLog_ASSERT TestOptIntegerByRefByVal(123, 456), 579, "TestOptIntegerByRefByVal(123, 456)" + + ' optionals with string datatypes + TestLog_ASSERT TestOptString(), "", "TestOptString()" + TestLog_ASSERT TestOptString("123"), "123", "TestOptString(""123"")" + TestLog_ASSERT TestOptString(, "456"), "456", "TestOptString(, ""456"")" + TestLog_ASSERT TestOptString("123", "456"), "123456", "TestOptString(""123"", ""456"")" + + ' optionals with string datatypes (ByRef and ByVal) + TestLog_ASSERT TestOptStringByRefByVal(), "", "TestOptStringByRefByVal()" + TestLog_ASSERT TestOptStringByRefByVal("123"), "123", "TestOptStringByRefByVal(""123"")" + TestLog_ASSERT TestOptStringByRefByVal(, "456"), "456", "TestOptStringByRefByVal(, ""456"")" + TestLog_ASSERT TestOptStringByRefByVal("123", "456"), "123456", "TestOptStringByRefByVal(""123"", ""456"")" + + ' optionals with object datatypes + Dim cA As New Collection + cA.Add (123) + cA.Add (456) + Dim cB As New Collection + cB.Add (123.4) + cB.Add (567.8) + TestLog_ASSERT TestOptObject(), 0, "TestOptObject()" + TestLog_ASSERT TestOptObject(cA), 579, "TestOptObject(A)" + TestLog_ASSERT CDbl(Format(TestOptObject(, cB), "0.0")), 691.2, "TestOptObject(, B)" + TestLog_ASSERT CDbl(Format(TestOptObject(cA, cB), "0.0")), 1270.2, "TestOptObject(A, B)" + + ' optionals with object datatypes (ByRef and ByVal) + TestLog_ASSERT TestOptObjectByRefByVal(), 0, "TestOptObjectByRefByVal()" + TestLog_ASSERT TestOptObjectByRefByVal(cA), 579, "TestOptObjectByRefByVal(A)" + TestLog_ASSERT CDbl(Format(TestOptObjectByRefByVal(, cB), "0.0")), 691.2, "TestOptObjectByRefByVal(, B)" + TestLog_ASSERT CDbl(Format(TestOptObjectByRefByVal(cA, cB), "0.0")), 1270.2, "TestOptObjectByRefByVal(A, B)" + + ' optionals with array datatypes + Dim aA(0 To 1) As Integer + aA(0) = 123 + aA(1) = 456 + Dim aB(0 To 1) As Variant + aB(0) = 123.4 + aB(1) = 567.8 + TestLog_ASSERT TestOptArray(), 0, "TestOptArray()" + TestLog_ASSERT TestOptArray(aA), 579, "TestOptArray(A)" + TestLog_ASSERT CDbl(Format(TestOptArray(, aB), "0.0")), 691.2, "TestOptArray(, B)" + TestLog_ASSERT CDbl(Format(TestOptArray(aA, aB), "0.0")), 1270.2, "TestOptArray(A, B)" + + ' optionals with array datatypes (ByRef and ByVal) + TestLog_ASSERT TestOptArrayByRefByVal(), 0, "TestOptArrayByRefByVal()" + TestLog_ASSERT TestOptArrayByRefByVal(aA), 579, "TestOptArrayByRefByVal(A)" + TestLog_ASSERT CDbl(Format(TestOptArrayByRefByVal(, aB), "0.0")), 691.2, "TestOptArrayByRefByVal(, B)" + TestLog_ASSERT CDbl(Format(TestOptArrayByRefByVal(aA, aB), "0.0")), 1270.2, "TestOptArrayByRefByVal(A, B)" + + result = result & Chr$(10) & "Tests passed: " & passCount & Chr$(10) & "Tests failed: " & failCount & Chr$(10) + verify_testOptionalsBasic = result + + Exit Function +errorHandler: + TestLog_ASSERT False, True, Err.Description +End Function + +Function TestOptVariant(Optional A, Optional B As Variant) + TestOptVariant = OptNumberSum(IsMissing(A), A, IsMissing(B), B) +End Function + +Function TestOptVariantByRefByVal(Optional ByRef A, Optional ByVal B As Variant) + TestOptVariantByRefByVal = OptNumberSum(IsMissing(A), A, IsMissing(B), B) +End Function + +Function TestOptDouble(Optional A As Double, Optional B As Double) + TestOptDouble = OptNumberSum(IsMissing(A), A, IsMissing(B), B) +End Function + +Function TestOptDoubleByRefByVal(Optional ByRef A As Double, Optional ByVal B As Double) + TestOptDoubleByRefByVal = OptNumberSum(IsMissing(A), A, IsMissing(B), B) +End Function + +Function TestOptInteger(Optional A As Integer, Optional B As Integer) + TestOptInteger = OptNumberSum(IsMissing(A), A, IsMissing(B), B) +End Function + +Function TestOptIntegerByRefByVal(Optional ByRef A As Integer, Optional ByVal B As Integer) + TestOptIntegerByRefByVal = OptNumberSum(IsMissing(A), A, IsMissing(B), B) +End Function + +Function TestOptString(Optional A As String, Optional B As String) + TestOptString = OptStringConcat(IsMissing(A), A, IsMissing(B), B) +End Function + +Function TestOptStringByRefByVal(Optional ByRef A As String, Optional ByVal B As String) + TestOptStringByRefByVal = OptStringConcat(IsMissing(A), A, IsMissing(B), B) +End Function + +Function TestOptObject(Optional A As Collection, Optional B As Collection) + TestOptObject = 0 + If Not IsMissing(A) Then TestOptObject = CollectionSum(A) + If Not IsMissing(B) Then TestOptObject = TestOptObject + CollectionSum(B) +End Function + +Function TestOptObjectByRefByVal(Optional ByRef A As Collection, Optional ByVal B As Collection) + TestOptObjectByRefByVal = 0 + If Not IsMissing(A) Then TestOptObjectByRefByVal = CollectionSum(A) + If Not IsMissing(B) Then TestOptObjectByRefByVal = TestOptObjectByRefByVal + CollectionSum(B) +End Function + +Function TestOptArray(Optional A() As Integer, Optional B() As Variant) + TestOptArray = ArraySum(IsMissing(A), A) + ArraySum(IsMissing(B), B) +End Function + +Function TestOptArrayByRefByVal(Optional ByRef A() As Integer, Optional ByVal B() As Variant) + TestOptArrayByRefByVal = ArraySum(IsMissing(A), A) + ArraySum(IsMissing(B), B) +End Function + +Function OptNumberSum(is_missingA As Boolean, A, is_missingB As Boolean, B) + OptNumberSum = 0 + If Not is_missingA Then OptNumberSum = A + If Not is_missingB Then OptNumberSum = OptNumberSum + B +End Function + +Function OptStringConcat(is_missingA As Boolean, A, is_missingB As Boolean, B) + OptStringConcat = "" + If Not is_missingA Then OptStringConcat = A + If Not is_missingB Then OptStringConcat = OptStringConcat & B +End Function + +Function CollectionSum(C) + Dim idx As Integer + CollectionSum = 0 + For idx = 1 To C.Count + CollectionSum = CollectionSum + C.Item(idx) + Next idx +End Function + +Function ArraySum(is_missingC As Boolean, C) + Dim idx As Integer + ArraySum = 0 + If Not is_missingC Then + For idx = LBound(C) To UBound(C) + ArraySum = ArraySum + C(idx) + Next idx + End If +End Function + +Sub TestLog_ASSERT(actual As Variant, expected As Variant, testName As String) + If expected = actual Then + passCount = passCount + 1 + Else + result = result & Chr$(10) & " Failed: " & testName & " returned " & actual & ", expected " & expected + failCount = failCount + 1 + End If +End Sub
\ No newline at end of file diff --git a/basic/qa/basic_coverage/test_optional_paramters_compatible.vb b/basic/qa/basic_coverage/test_optional_paramters_compatible.vb new file mode 100644 index 000000000..9ea475508 --- /dev/null +++ b/basic/qa/basic_coverage/test_optional_paramters_compatible.vb @@ -0,0 +1,210 @@ +Option Compatible + +Dim passCount As Integer +Dim failCount As Integer +Dim result As String + +Function doUnitTest() As String + result = verify_testOptionalsCompatible() + If failCount <> 0 Or passCount = 0 Then + doUnitTest = 0 + Else + doUnitTest = 1 + End If +End Function + +' tdf#36737 - Test optionals with different datatypes. In LO Basic +' with option Compatible, optional parameters are allowed with default values. +' Missing optional parameters that don't have explicit default values will +' not be initialized to their default values of its datatype. +Function verify_testOptionalsCompatible() As String + + passCount = 0 + failCount = 0 + + result = "Test Results" & Chr$(10) & "============" & Chr$(10) + testName = "Test optionals (Compatible)" + On Error GoTo errorHandler + + ' optionals with variant datatypes + TestLog_ASSERT TestOptVariant(), 123, "TestOptVariant()" + TestLog_ASSERT TestOptVariant(123), 246, "TestOptVariant(123)" + TestLog_ASSERT TestOptVariant(, 456), 456, "TestOptVariant(, 456)" + TestLog_ASSERT TestOptVariant(123, 456), 579, "TestOptVariant(123, 456)" + + ' optionals with variant datatypes (ByRef and ByVal) + TestLog_ASSERT TestOptVariantByRefByVal(), 123, "TestOptVariantByRefByVal()" + TestLog_ASSERT TestOptVariantByRefByVal(123), 246, "TestOptVariantByRefByVal(123)" + TestLog_ASSERT TestOptVariantByRefByVal(, 456), 456, "TestOptVariantByRefByVal(, 456)" + TestLog_ASSERT TestOptVariantByRefByVal(123, 456), 579, "TestOptVariantByRefByVal(123, 456)" + + ' optionals with double datatypes + TestLog_ASSERT TestOptDouble(), 123.4, "TestOptDouble()" + TestLog_ASSERT TestOptDouble(123.4), 246.8, "TestOptDouble(123.4)" + TestLog_ASSERT TestOptDouble(, 567.8), 567.8, "TestOptDouble(, 567.8)" + TestLog_ASSERT CDbl(Format(TestOptDouble(123.4, 567.8), "0.0")), 691.2, "TestOptDouble(123.4, 567.8)" + + ' optionals with double datatypes (ByRef and ByVal) + TestLog_ASSERT TestOptDoubleByRefByVal(), 123.4, "TestOptDouble()" + TestLog_ASSERT TestOptDoubleByRefByVal(123.4), 246.8, "TestOptDouble(123.4)" + TestLog_ASSERT TestOptDoubleByRefByVal(, 567.8), 567.8, "TestOptDoubleByRefByVal(, 567.8)" + TestLog_ASSERT CDbl(Format(TestOptDoubleByRefByVal(123.4, 567.8), "0.0")), 691.2, "TestOptDoubleByRefByVal(123.4, 567.8)" + + ' optionals with integer datatypes + TestLog_ASSERT TestOptInteger(), 123, "TestOptInteger()" + TestLog_ASSERT TestOptInteger(123), 246, "TestOptInteger(123)" + TestLog_ASSERT TestOptInteger(, 456), 456, "TestOptInteger(, 456)" + TestLog_ASSERT TestOptInteger(123, 456), 579, "TestOptInteger(123, 456)" + + ' optionals with integer datatypes (ByRef and ByVal) + TestLog_ASSERT TestOptIntegerByRefByVal(), 123, "TestOptIntegerByRefByVal()" + TestLog_ASSERT TestOptIntegerByRefByVal(123), 246, "TestOptIntegerByRefByVal(123)" + TestLog_ASSERT TestOptIntegerByRefByVal(, 456), 456, "TestOptIntegerByRefByVal(, 456)" + TestLog_ASSERT TestOptIntegerByRefByVal(123, 456), 579, "TestOptIntegerByRefByVal(123, 456)" + + ' optionals with string datatypes + TestLog_ASSERT TestOptString(), "123", "TestOptString()" + TestLog_ASSERT TestOptString("123"), "123123", "TestOptString(""123"")" + TestLog_ASSERT TestOptString(, "456"), "456", "TestOptString(, ""456"")" + TestLog_ASSERT TestOptString("123", "456"), "123456", "TestOptString(""123"", ""456"")" + + ' optionals with string datatypes (ByRef and ByVal) + TestLog_ASSERT TestOptStringByRefByVal(), "123", "TestOptStringByRefByVal()" + TestLog_ASSERT TestOptStringByRefByVal("123"), "123123", "TestOptStringByRefByVal(""123"")" + TestLog_ASSERT TestOptStringByRefByVal(, "456"), "456", "TestOptStringByRefByVal(, ""456"")" + TestLog_ASSERT TestOptStringByRefByVal("123", "456"), "123456", "TestOptStringByRefByVal(""123"", ""456"")" + + ' optionals with object datatypes + Dim cA As New Collection + cA.Add (123) + cA.Add (456) + Dim cB As New Collection + cB.Add (123.4) + cB.Add (567.8) + TestLog_ASSERT TestOptObject(), 0, "TestOptObject()" + TestLog_ASSERT TestOptObject(cA), 579, "TestOptObject(A)" + TestLog_ASSERT CDbl(Format(TestOptObject(, cB), "0.0")), 691.2, "TestOptObject(, B)" + TestLog_ASSERT CDbl(Format(TestOptObject(cA, cB), "0.0")), 1270.2, "TestOptObject(A, B)" + + ' optionals with object datatypes (ByRef and ByVal) + TestLog_ASSERT TestOptObjectByRefByVal(), 0, "TestOptObjectByRefByVal()" + TestLog_ASSERT TestOptObjectByRefByVal(cA), 579, "TestOptObjectByRefByVal(A)" + TestLog_ASSERT CDbl(Format(TestOptObjectByRefByVal(, cB), "0.0")), 691.2, "TestOptObjectByRefByVal(, B)" + TestLog_ASSERT CDbl(Format(TestOptObjectByRefByVal(cA, cB), "0.0")), 1270.2, "TestOptObjectByRefByVal(A, B)" + + ' optionals with array datatypes + Dim aA(0 To 1) As Integer + aA(0) = 123 + aA(1) = 456 + Dim aB(0 To 1) As Variant + aB(0) = 123.4 + aB(1) = 567.8 + TestLog_ASSERT TestOptArray(), 0, "TestOptArray()" + TestLog_ASSERT TestOptArray(aA), 579, "TestOptArray(A)" + TestLog_ASSERT CDbl(Format(TestOptArray(, aB), "0.0")), 691.2, "TestOptArray(, B)" + TestLog_ASSERT CDbl(Format(TestOptArray(aA, aB), "0.0")), 1270.2, "TestOptArray(A, B)" + + ' optionals with array datatypes (ByRef and ByVal) + TestLog_ASSERT TestOptArrayByRefByVal(), 0, "TestOptArrayByRefByVal()" + TestLog_ASSERT TestOptArrayByRefByVal(aA), 579, "TestOptArrayByRefByVal(A)" + TestLog_ASSERT CDbl(Format(TestOptArrayByRefByVal(, aB), "0.0")), 691.2, "TestOptArrayByRefByVal(, B)" + TestLog_ASSERT CDbl(Format(TestOptArrayByRefByVal(aA, aB), "0.0")), 1270.2, "TestOptArrayByRefByVal(A, B)" + + result = result & Chr$(10) & "Tests passed: " & passCount & Chr$(10) & "Tests failed: " & failCount & Chr$(10) + verify_testOptionalsCompatible = result + + Exit Function +errorHandler: + TestLog_ASSERT False, True, Err.Description +End Function + +Function TestOptVariant(Optional A, Optional B As Variant = 123) + TestOptVariant = OptNumberSum(IsMissing(A), A, IsMissing(B), B) +End Function + +Function TestOptVariantByRefByVal(Optional ByRef A, Optional ByVal B As Variant = 123) + TestOptVariantByRefByVal = OptNumberSum(IsMissing(A), A, IsMissing(B), B) +End Function + +Function TestOptDouble(Optional A As Double, Optional B As Double = 123.4) + TestOptDouble = OptNumberSum(IsMissing(A), A, IsMissing(B), B) +End Function + +Function TestOptDoubleByRefByVal(Optional ByRef A As Double, Optional ByVal B As Double = 123.4) + TestOptDoubleByRefByVal = OptNumberSum(IsMissing(A), A, IsMissing(B), B) +End Function + +Function TestOptInteger(Optional A As Integer, Optional B As Integer = 123) + TestOptInteger = OptNumberSum(IsMissing(A), A, IsMissing(B), B) +End Function + +Function TestOptIntegerByRefByVal(Optional ByRef A As Integer, Optional ByVal B As Integer = 123) + TestOptIntegerByRefByVal = OptNumberSum(IsMissing(A), A, IsMissing(B), B) +End Function + +Function TestOptString(Optional A As String, Optional B As String = "123") + TestOptString = OptStringConcat(IsMissing(A), A, IsMissing(B), B) +End Function + +Function TestOptStringByRefByVal(Optional ByRef A As String, Optional ByVal B As String = "123") + TestOptStringByRefByVal = OptStringConcat(IsMissing(A), A, IsMissing(B), B) +End Function + +Function TestOptObject(Optional A As Collection, Optional B As Collection) + TestOptObject = 0 + If Not IsMissing(A) Then TestOptObject = CollectionSum(A) + If Not IsMissing(B) Then TestOptObject = TestOptObject + CollectionSum(B) +End Function + +Function TestOptObjectByRefByVal(Optional ByRef A As Collection, Optional ByVal B As Collection) + TestOptObjectByRefByVal = 0 + If Not IsMissing(A) Then TestOptObjectByRefByVal = CollectionSum(A) + If Not IsMissing(B) Then TestOptObjectByRefByVal = TestOptObjectByRefByVal + CollectionSum(B) +End Function + +Function TestOptArray(Optional A() As Integer, Optional B() As Variant) + TestOptArray = ArraySum(IsMissing(A), A) + ArraySum(IsMissing(B), B) +End Function + +Function TestOptArrayByRefByVal(Optional ByRef A() As Integer, Optional ByVal B() As Variant) + TestOptArrayByRefByVal = ArraySum(IsMissing(A), A) + ArraySum(IsMissing(B), B) +End Function + +Function OptNumberSum(is_missingA As Boolean, A, is_missingB As Boolean, B) + OptNumberSum = 0 + If Not is_missingA Then OptNumberSum = A + If Not is_missingB Then OptNumberSum = OptNumberSum + B +End Function + +Function OptStringConcat(is_missingA As Boolean, A, is_missingB As Boolean, B) + OptStringConcat = "" + If Not is_missingA Then OptStringConcat = A + If Not is_missingB Then OptStringConcat = OptStringConcat & B +End Function + +Function CollectionSum(C) + Dim idx As Integer + CollectionSum = 0 + For idx = 1 To C.Count + CollectionSum = CollectionSum + C.Item(idx) + Next idx +End Function + +Function ArraySum(is_missingC As Boolean, C) + Dim idx As Integer + ArraySum = 0 + If Not is_missingC Then + For idx = LBound(C) To UBound(C) + ArraySum = ArraySum + C(idx) + Next idx + End If +End Function + +Sub TestLog_ASSERT(actual As Variant, expected As Variant, testName As String) + If expected = actual Then + passCount = passCount + 1 + Else + result = result & Chr$(10) & " Failed: " & testName & " returned " & actual & ", expected " & expected + failCount = failCount + 1 + End If +End Sub
\ No newline at end of file diff --git a/basic/qa/basic_coverage/test_qbcolor_method.vb b/basic/qa/basic_coverage/test_qbcolor_method.vb new file mode 100644 index 000000000..8051a80b6 --- /dev/null +++ b/basic/qa/basic_coverage/test_qbcolor_method.vb @@ -0,0 +1,15 @@ +' 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/. +' + +Function doUnitTest as Integer + ' QBCOLOR + If ( QBColor(7) <> 12632256 ) Then + doUnitTest = 0 + Else + doUnitTest = 1 + End If +End Function diff --git a/basic/qa/basic_coverage/test_random_methods.vb b/basic/qa/basic_coverage/test_random_methods.vb new file mode 100644 index 000000000..ea5d1c979 --- /dev/null +++ b/basic/qa/basic_coverage/test_random_methods.vb @@ -0,0 +1,16 @@ +' 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/. +' + +Function doUnitTest as Integer + Randomize 42 + ' RND + If ( Rnd >= 1 ) Then + doUnitTest = 0 + Else + doUnitTest = 1 + End If +End Function diff --git a/basic/qa/basic_coverage/test_resolvepath_method.vb b/basic/qa/basic_coverage/test_resolvepath_method.vb new file mode 100644 index 000000000..888a29dfb --- /dev/null +++ b/basic/qa/basic_coverage/test_resolvepath_method.vb @@ -0,0 +1,15 @@ +' 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/. +' + +Function doUnitTest as Integer + ' RESOLVEPATH + If ( ResolvePath( "" ) <> "" ) Then + doUnitTest = 0 + Else + doUnitTest = 1 + End If +End Function diff --git a/basic/qa/basic_coverage/test_rgb_method.vb b/basic/qa/basic_coverage/test_rgb_method.vb new file mode 100644 index 000000000..7bdaf9660 --- /dev/null +++ b/basic/qa/basic_coverage/test_rgb_method.vb @@ -0,0 +1,15 @@ +' 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/. +' + +Function doUnitTest as Integer + ' RGB + If ( RGB( 128, 50, 200 ) <> 8401608 ) Then + doUnitTest = 0 + Else + doUnitTest = 1 + End If +End Function diff --git a/basic/qa/basic_coverage/test_rtrim_method.vb b/basic/qa/basic_coverage/test_rtrim_method.vb new file mode 100644 index 000000000..79a8093fe --- /dev/null +++ b/basic/qa/basic_coverage/test_rtrim_method.vb @@ -0,0 +1,17 @@ +' 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/. +' + +Function doUnitTest as Integer + dim aString as Variant + aString = "Hello" + ' RTRIM + If ( RTrim( "Hello " ) <> aString ) Then + doUnitTest = 0 + Else + doUnitTest = 1 + End If +End Function diff --git a/basic/qa/basic_coverage/test_second_method.vb b/basic/qa/basic_coverage/test_second_method.vb new file mode 100644 index 000000000..77311e9d3 --- /dev/null +++ b/basic/qa/basic_coverage/test_second_method.vb @@ -0,0 +1,16 @@ +' +' 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/. +' + +Function doUnitTest as Integer + ' SECOND + If ( Second(TimeSerial(12,30,41)) <> 41 ) Then + doUnitTest = 0 + Else + doUnitTest = 1 + End If +End Function diff --git a/basic/qa/basic_coverage/test_sgn_method.vb b/basic/qa/basic_coverage/test_sgn_method.vb new file mode 100644 index 000000000..da2cf6757 --- /dev/null +++ b/basic/qa/basic_coverage/test_sgn_method.vb @@ -0,0 +1,15 @@ +' 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/. +' + +Function doUnitTest as Integer + ' SGN + If ( Sgn(-3.14) <> -1 ) Then + doUnitTest = 0 + Else + doUnitTest = 1 + End If +End Function diff --git a/basic/qa/basic_coverage/test_space_method.vb b/basic/qa/basic_coverage/test_space_method.vb new file mode 100644 index 000000000..8b35b108b --- /dev/null +++ b/basic/qa/basic_coverage/test_space_method.vb @@ -0,0 +1,15 @@ +' 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/. +' + +Function doUnitTest as Integer + ' SPACE + If ( Space(3) <> " " ) Then + doUnitTest = 0 + Else + doUnitTest = 1 + End If +End Function diff --git a/basic/qa/basic_coverage/test_spc_method.vb b/basic/qa/basic_coverage/test_spc_method.vb new file mode 100644 index 000000000..7ed291e13 --- /dev/null +++ b/basic/qa/basic_coverage/test_spc_method.vb @@ -0,0 +1,15 @@ +' 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/. +' + +Function doUnitTest as Integer + ' SPC + If ( Spc(3) <> " " ) Then + doUnitTest = 0 + Else + doUnitTest = 1 + End If +End Function diff --git a/basic/qa/basic_coverage/test_split_method.vb b/basic/qa/basic_coverage/test_split_method.vb new file mode 100644 index 000000000..d09e8c3e7 --- /dev/null +++ b/basic/qa/basic_coverage/test_split_method.vb @@ -0,0 +1,15 @@ +' 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/. +' + +Function doUnitTest as Integer + ' SPLIT + If ( Split( "Hello world" )(1) <> "world" ) Then + doUnitTest = 0 + Else + doUnitTest = 1 + End If +End Function diff --git a/basic/qa/basic_coverage/test_sqr_method.vb b/basic/qa/basic_coverage/test_sqr_method.vb new file mode 100644 index 000000000..55db95403 --- /dev/null +++ b/basic/qa/basic_coverage/test_sqr_method.vb @@ -0,0 +1,15 @@ +' 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/. +' + +Function doUnitTest as Integer + ' SQR + If ( Sqr( 4 ) <> 2 ) Then + doUnitTest = 0 + Else + doUnitTest = 1 + End If +End Function diff --git a/basic/qa/basic_coverage/test_strcomp_method.vb b/basic/qa/basic_coverage/test_strcomp_method.vb new file mode 100644 index 000000000..aeb146e57 --- /dev/null +++ b/basic/qa/basic_coverage/test_strcomp_method.vb @@ -0,0 +1,17 @@ +' 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/. +' + +Function doUnitTest as Integer + dim aString as Variant + aString = "Hello" + ' STRCOMP + If ( StrComp( aString, "Hello" ) <> 0 ) Then + doUnitTest = 0 + Else + doUnitTest = 1 + End If +End Function diff --git a/basic/qa/basic_coverage/test_string_method.vb b/basic/qa/basic_coverage/test_string_method.vb new file mode 100644 index 000000000..8664ac011 --- /dev/null +++ b/basic/qa/basic_coverage/test_string_method.vb @@ -0,0 +1,15 @@ +' 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/. +' + +Function doUnitTest as Integer + ' STRING + If ( String( 3, "H" ) <> "HHH" ) Then + doUnitTest = 0 + Else + doUnitTest = 1 + End If +End Function diff --git a/basic/qa/basic_coverage/test_string_overflow_safe.vb b/basic/qa/basic_coverage/test_string_overflow_safe.vb new file mode 100644 index 000000000..148cc910c --- /dev/null +++ b/basic/qa/basic_coverage/test_string_overflow_safe.vb @@ -0,0 +1,22 @@ +Option Explicit + +Function doUnitTest As Integer + ' Trying to create too long string should generate proper BASIC overflow error. + ' Longest possible string is 2147483638 wchar_t (2G - 10). + ' This tries to create string with 2G wchar_t. If it does not overflow, test fails. + ' If overflow is not safe, it segfaults. + On Error GoTo errorHandler + Dim s As String, i As Integer + s = "0" + For i=1 To 31 + s = s & s + Next i + doUnitTest = 0 + Exit Function +errorHandler: + If ( Err <> 6 ) Then + doUnitTest = 0 + Else + doUnitTest = 1 + Endif +End Function diff --git a/basic/qa/basic_coverage/test_string_replace.vb b/basic/qa/basic_coverage/test_string_replace.vb new file mode 100644 index 000000000..99eafdba6 --- /dev/null +++ b/basic/qa/basic_coverage/test_string_replace.vb @@ -0,0 +1,37 @@ +Dim passCount As Integer +Dim failCount As Integer +Dim result As String + +Function doUnitTest() As String + result = verify_stringReplace() + If failCount <> 0 Or passCount = 0 Then + doUnitTest = 0 + Else + doUnitTest = 1 + End If +End Function + +Function verify_stringReplace() As String + passCount = 0 + failCount = 0 + + result = "Test Results" & Chr$(10) & "============" & Chr$(10) + + ' tdf#132389 - case-insensitive operation for non-ASCII characters + retStr = Replace("ABCabc", "b", "*") + TestLog_ASSERT retStr, "A*Ca*c", "case-insensitive ASCII: " & retStr + retStr = Replace("АБВабв", "б", "*") + TestLog_ASSERT retStr, "А*Ва*в", "case-insensitive non-ASCII: " & retStr + + result = result & Chr$(10) & "Tests passed: " & passCount & Chr$(10) & "Tests failed: " & failCount & Chr$(10) + verify_stringReplace = result +End Function + +Sub TestLog_ASSERT(actual As Variant, expected As Variant, testName As String) + If expected = actual Then + passCount = passCount + 1 + Else + result = result & Chr$(10) & "Failed: " & testName & " returned " & actual & ", expected " & expected + failCount = failCount + 1 + End If +End Sub diff --git a/basic/qa/basic_coverage/test_strtrim_methods.vb b/basic/qa/basic_coverage/test_strtrim_methods.vb new file mode 100644 index 000000000..b9da11d7f --- /dev/null +++ b/basic/qa/basic_coverage/test_strtrim_methods.vb @@ -0,0 +1,15 @@ +' 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/. +' + +Function doUnitTest as Integer + ' STR TRIM + If ( Trim( Str( 4 ) ) <> "4" ) Then + doUnitTest = 0 + Else + doUnitTest = 1 + End If +End Function diff --git a/basic/qa/basic_coverage/test_switch_method.vb b/basic/qa/basic_coverage/test_switch_method.vb new file mode 100644 index 000000000..9dc00fa52 --- /dev/null +++ b/basic/qa/basic_coverage/test_switch_method.vb @@ -0,0 +1,20 @@ +' +' 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/. +' + +Function doUnitTest as Integer + dim aVariant as Object + ' SWITCH + If ( Switch( False, 10,_ + True, 11,_ + False, 12,_ + True, 13 ) <> 11 ) Then + doUnitTest = 0 + Else + doUnitTest = 1 + End If +End Function diff --git a/basic/qa/basic_coverage/test_tab_method.vb b/basic/qa/basic_coverage/test_tab_method.vb new file mode 100644 index 000000000..a5e4e9815 --- /dev/null +++ b/basic/qa/basic_coverage/test_tab_method.vb @@ -0,0 +1,15 @@ +' 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/. +' + +Function doUnitTest as Integer + ' TAB + If ( "Hello" & Tab(0) & "World" <> "HelloWorld" ) Then + doUnitTest = 0 + Else + doUnitTest = 1 + End If +End Function diff --git a/basic/qa/basic_coverage/test_tan_method.vb b/basic/qa/basic_coverage/test_tan_method.vb new file mode 100644 index 000000000..117d2824b --- /dev/null +++ b/basic/qa/basic_coverage/test_tan_method.vb @@ -0,0 +1,15 @@ +' 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/. +' + +Function doUnitTest as Integer + ' TAN + If ( Abs( Tan(PI/4) - 1 ) > 1E-6 ) Then + doUnitTest = 0 + Else + doUnitTest = 1 + End If +End Function diff --git a/basic/qa/basic_coverage/test_timer_method.vb b/basic/qa/basic_coverage/test_timer_method.vb new file mode 100644 index 000000000..3ccb120f6 --- /dev/null +++ b/basic/qa/basic_coverage/test_timer_method.vb @@ -0,0 +1,16 @@ +' +' 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/. +' + +Function doUnitTest as Integer + ' TIMER max value = 24*3600 + If ( Timer() > 86400 ) Then + doUnitTest = 0 + Else + doUnitTest = 1 + End If +End Function diff --git a/basic/qa/basic_coverage/test_timeserialtimevalue_methods.vb b/basic/qa/basic_coverage/test_timeserialtimevalue_methods.vb new file mode 100644 index 000000000..6e84329d0 --- /dev/null +++ b/basic/qa/basic_coverage/test_timeserialtimevalue_methods.vb @@ -0,0 +1,16 @@ +' +' 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/. +' + +Function doUnitTest as Integer + ' TIMESERIAL TIMEVALUE + If ( TimeSerial(13,54,48) <> TimeValue("13:54:48") ) Then + doUnitTest = 0 + Else + doUnitTest = 1 + End If +End Function diff --git a/basic/qa/basic_coverage/test_twipsperpixelx_method.vb b/basic/qa/basic_coverage/test_twipsperpixelx_method.vb new file mode 100644 index 000000000..2b8890ad7 --- /dev/null +++ b/basic/qa/basic_coverage/test_twipsperpixelx_method.vb @@ -0,0 +1,16 @@ +' +' 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/. +' + +Function doUnitTest as Integer + ' TWIPSPERPIXELX + If ( TwipsPerPixelX < 0 ) Then + doUnitTest = 0 + Else + doUnitTest = 1 + End If +End Function diff --git a/basic/qa/basic_coverage/test_twipsperpixely_method.vb b/basic/qa/basic_coverage/test_twipsperpixely_method.vb new file mode 100644 index 000000000..efc41e1ff --- /dev/null +++ b/basic/qa/basic_coverage/test_twipsperpixely_method.vb @@ -0,0 +1,16 @@ +' +' 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/. +' + +Function doUnitTest as Integer + ' TWIPSPERPIXELY + If ( TwipsPerPixelY < 0 ) Then + doUnitTest = 0 + Else + doUnitTest = 1 + End If +End Function diff --git a/basic/qa/basic_coverage/test_typelen_method.vb b/basic/qa/basic_coverage/test_typelen_method.vb new file mode 100644 index 000000000..468479007 --- /dev/null +++ b/basic/qa/basic_coverage/test_typelen_method.vb @@ -0,0 +1,16 @@ +' +' 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/. +' + +Function doUnitTest as Integer + ' TYPELEN + If ( TypeLen("Hello") <> 5 ) Then + doUnitTest = 0 + Else + doUnitTest = 1 + End If +End Function diff --git a/basic/qa/basic_coverage/test_typename_method.vb b/basic/qa/basic_coverage/test_typename_method.vb new file mode 100644 index 000000000..eba2d86c4 --- /dev/null +++ b/basic/qa/basic_coverage/test_typename_method.vb @@ -0,0 +1,16 @@ +' +' 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/. +' + +Function doUnitTest as Integer + ' TYPENAME + If ( TypeName("Hello") <> "String" ) Then + doUnitTest = 0 + Else + doUnitTest = 1 + End If +End Function diff --git a/basic/qa/basic_coverage/test_types_conversion.vb b/basic/qa/basic_coverage/test_types_conversion.vb new file mode 100644 index 000000000..0868f4d3e --- /dev/null +++ b/basic/qa/basic_coverage/test_types_conversion.vb @@ -0,0 +1,64 @@ +' +' 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/. +' +Option Explicit + +Dim nTotalCount As Integer +Dim nPassCount As Integer +Dim nFailCount As Integer + +' For the following tests the en-US (English - United States) locale is required +Function doUnitTest() As Integer + nTotalCount = 0 + nPassCount = 0 + nFailCount = 0 + + ' Test implicit conversions from string to number + Dim nVal As Double + ' Simple integer + StartTest() + nVal = "123" + AssertTest(nVal = 123) + + ' Negative integer + StartTest() + nVal = "-123" + AssertTest(nVal = -123) + + ' Negative floating-point + StartTest() + nVal = "-123.45" + AssertTest(nVal = -123.45) + + ' Negative floating-point with leading and trailing spaces + StartTest() + nVal = " -123.456 " + AssertTest(nVal = -123.456) + + ' Wrong decimal separator (interpreted as group separator) + StartTest() + nVal = " -123,456 " + AssertTest(nVal = -123456) + + If ((nFailCount > 0) Or (nPassCount <> nTotalCount)) Then + doUnitTest = 0 + Else + doUnitTest = 1 + End If +End Function + +Sub StartTest() + nTotalCount = nTotalCount + 1 +End Sub + +Sub AssertTest(testResult As Boolean) + If (testResult) Then + nPassCount = nPassCount + 1 + Else + nFailCount = nFailCount + 1 + End If +End Sub diff --git a/basic/qa/basic_coverage/test_ucase_method.vb b/basic/qa/basic_coverage/test_ucase_method.vb new file mode 100644 index 000000000..940c0897b --- /dev/null +++ b/basic/qa/basic_coverage/test_ucase_method.vb @@ -0,0 +1,17 @@ +' 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/. +' + +Function doUnitTest as Integer + dim aString as Variant + aString = "Hello" + ' UCASE + If ( UCase( aString ) <> "HELLO" ) Then + doUnitTest = 0 + Else + doUnitTest = 1 + End If +End Function diff --git a/basic/qa/basic_coverage/test_val_method.vb b/basic/qa/basic_coverage/test_val_method.vb new file mode 100644 index 000000000..c25610ceb --- /dev/null +++ b/basic/qa/basic_coverage/test_val_method.vb @@ -0,0 +1,16 @@ +' +' 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/. +' + +Function doUnitTest as Integer + ' VAL + If ( Val("4") <> 4 ) Then + doUnitTest = 0 + Else + doUnitTest = 1 + End If +End Function diff --git a/basic/qa/basic_coverage/test_vartype_method.vb b/basic/qa/basic_coverage/test_vartype_method.vb new file mode 100644 index 000000000..bd45adef0 --- /dev/null +++ b/basic/qa/basic_coverage/test_vartype_method.vb @@ -0,0 +1,16 @@ +' +' 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/. +' + +Function doUnitTest as Integer + ' VARTYPE + If ( VarType("Hello") <> 8 ) Then + doUnitTest = 0 + Else + doUnitTest = 1 + End If +End Function diff --git a/basic/qa/basic_coverage/test_wait_method.vb b/basic/qa/basic_coverage/test_wait_method.vb new file mode 100644 index 000000000..776a2efad --- /dev/null +++ b/basic/qa/basic_coverage/test_wait_method.vb @@ -0,0 +1,12 @@ +' 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/. +' + +Function doUnitTest as Integer + ' WAIT + Wait(0) + doUnitTest = 1 +End Function diff --git a/basic/qa/basic_coverage/test_weekday_method.vb b/basic/qa/basic_coverage/test_weekday_method.vb new file mode 100644 index 000000000..48279434d --- /dev/null +++ b/basic/qa/basic_coverage/test_weekday_method.vb @@ -0,0 +1,18 @@ +' +' 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/. +' + +Function doUnitTest as Integer + dim aDate as Date + aDate = Date() + ' WEEKDAY + If ( Weekday( aDate ) <> WeekDay( aDate ) ) Then + doUnitTest = 0 + Else + doUnitTest = 1 + End If +End Function diff --git a/basic/qa/basic_coverage/test_year_method.vb b/basic/qa/basic_coverage/test_year_method.vb new file mode 100644 index 000000000..0863e11b3 --- /dev/null +++ b/basic/qa/basic_coverage/test_year_method.vb @@ -0,0 +1,18 @@ +' +' 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/. +' + +Function doUnitTest as Integer + dim aDate as Date + aDate = Date() + ' YEAR + If ( DatePart( "yyyy", aDate ) <> Year( aDate ) ) Then + doUnitTest = 0 + Else + doUnitTest = 1 + End If +End Function diff --git a/basic/qa/basic_coverage/uno_struct_assign.vb b/basic/qa/basic_coverage/uno_struct_assign.vb new file mode 100644 index 000000000..23812de2c --- /dev/null +++ b/basic/qa/basic_coverage/uno_struct_assign.vb @@ -0,0 +1,15 @@ +' +' 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/. +' + + +Function doUnitTest as Integer + Dim oNamedValue as new com.sun.star.beans.NamedValue + Dim oCellAddress as new com.sun.star.table.CellAddress + oNamedValue.Value = oCellAddress ' fdo#60065 - this would throw an error + doUnitTest = 1 +End Function diff --git a/basic/qa/cppunit/basic_coverage.cxx b/basic/qa/cppunit/basic_coverage.cxx new file mode 100644 index 000000000..0dfc7d94e --- /dev/null +++ b/basic/qa/cppunit/basic_coverage.cxx @@ -0,0 +1,161 @@ +/* -*- Mode: C++; tab-width: 4; indent-tabs-mode: nil; c-basic-offset: 4 -*- */ +/* + * 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/. + */ + +#include "basictest.hxx" +#include <osl/file.hxx> +#include <i18nlangtag/languagetag.hxx> +#include <unotools/syslocaleoptions.hxx> + +namespace +{ + +class Coverage : public test::BootstrapFixture +{ +private: + int m_nb_tests_ok; + OUString m_sCurrentTest; + void process_directory(const OUString& sDirName); + void run_test(const OUString& sFileName); + void test_failed(); + void test_success(); + std::vector< OUString > get_subdirnames( const OUString& sDirName ); + +public: + Coverage(); + virtual ~Coverage() override; + + void Coverage_Iterator(); + + // Adds code needed to register the test suite + CPPUNIT_TEST_SUITE(Coverage); + + // Declares the method as a test to call + CPPUNIT_TEST(Coverage_Iterator); + + // End of test suite definition + CPPUNIT_TEST_SUITE_END(); +}; + +Coverage::Coverage() + : BootstrapFixture(true, false) + , m_nb_tests_ok(0) +{ +} + +Coverage::~Coverage() +{ + fprintf(stderr,"basic coverage Summary : pass:%d\n", m_nb_tests_ok ); +} + +void Coverage::test_failed() +{ + CPPUNIT_FAIL( + OUStringToOString(m_sCurrentTest, RTL_TEXTENCODING_UTF8).getStr()); +} + +void Coverage::test_success() +{ + m_nb_tests_ok += 1; + fprintf(stderr,"%s,PASS\n", OUStringToOString( m_sCurrentTest, RTL_TEXTENCODING_UTF8 ).getStr() ); +} + +void Coverage::run_test(const OUString& sFileURL) +{ + m_sCurrentTest = sFileURL; + bool bResult = false; + MacroSnippet testMacro; + testMacro.LoadSourceFromFile( sFileURL ); + testMacro.Compile(); + if( !testMacro.HasError() ) + { + SbxVariableRef pResult = testMacro.Run(); + if( pResult.is() && pResult->GetInteger() == 1 ) + { + bResult = true; + } + } + if(bResult) + { + test_success(); + } + else + { + test_failed(); + } +} + +std::vector< OUString > Coverage::get_subdirnames( const OUString& sDirName ) +{ + std::vector< OUString > sSubDirNames; + osl::Directory aDir(sDirName); + osl::DirectoryItem aItem; + osl::FileStatus aFileStatus(osl_FileStatus_Mask_FileURL|osl_FileStatus_Mask_Type); + + if(aDir.open() == osl::FileBase::E_None) + { + while (aDir.getNextItem(aItem) == osl::FileBase::E_None) + { + aItem.getFileStatus(aFileStatus); + if(aFileStatus.isDirectory()) + sSubDirNames.push_back( aFileStatus.getFileURL() ); + } + } + return sSubDirNames; +} +void Coverage::process_directory(const OUString& sDirName) +{ + osl::Directory aDir(sDirName); + osl::DirectoryItem aItem; + osl::FileStatus aFileStatus(osl_FileStatus_Mask_FileURL|osl_FileStatus_Mask_Type); + + if(aDir.open() == osl::FileBase::E_None) + { + while (aDir.getNextItem(aItem) == osl::FileBase::E_None) + { + aItem.getFileStatus(aFileStatus); + if(aFileStatus.isRegular()) + { + run_test(aFileStatus.getFileURL()); + } + } + } + fprintf(stderr,"end process directory\n"); +} + +void Coverage::Coverage_Iterator() +{ + OUString sDirName = m_directories.getURLFromSrc("/basic/qa/basic_coverage/"); + + CPPUNIT_ASSERT(!sDirName.isEmpty()); + process_directory(sDirName); // any files in the root test dir are run in test harness default locale ( en-US ) + std::vector< OUString > sLangDirs = get_subdirnames( sDirName ); + + for (auto const& langDir : sLangDirs) + { + sal_Int32 nSlash = langDir.lastIndexOf('/'); + if ( nSlash != -1 ) + { + OUString sLangISO = langDir.copy( nSlash + 1 ); + LanguageTag aLocale( sLangISO ); + if ( aLocale.isValidBcp47() ) + { + SvtSysLocaleOptions aLocalOptions; + // set locale for test dir + aLocalOptions.SetLocaleConfigString( sLangISO ); + process_directory(langDir); + } + } + } +} + + CPPUNIT_TEST_SUITE_REGISTRATION(Coverage); + +} + +/* vim:set shiftwidth=4 softtabstop=4 expandtab: */ diff --git a/basic/qa/cppunit/basictest.cxx b/basic/qa/cppunit/basictest.cxx new file mode 100644 index 000000000..635da6e5e --- /dev/null +++ b/basic/qa/cppunit/basictest.cxx @@ -0,0 +1,125 @@ +/* -*- Mode: C++; tab-width: 4; indent-tabs-mode: nil; c-basic-offset: 4 -*- */ +/* + * 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/. + */ + +#include "basictest.hxx" +#include <cppunit/plugin/TestPlugIn.h> +#include <basic/sbstar.hxx> +#include <basic/sbmod.hxx> +#include <basic/sbmeth.hxx> +#include <basic/sbuno.hxx> +#include <osl/file.hxx> + +void MacroSnippet::InitSnippet() +{ + mpBasic = new StarBASIC(); + StarBASIC::SetGlobalErrorHdl( LINK( this, MacroSnippet, BasicErrorHdl ) ); +} + +void MacroSnippet::MakeModule( const OUString& sSource ) +{ + mpMod = mpBasic->MakeModule( "TestModule", sSource ); +} + +MacroSnippet::MacroSnippet( const OUString& sSource ) + : mbError(false) +{ + InitSnippet(); + MakeModule( sSource ); +} + +MacroSnippet::MacroSnippet() + : mbError(false) +{ + InitSnippet(); +} + +void MacroSnippet::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(aFile.open(osl_File_OpenFlag_Read) == osl::FileBase::E_None) + { + sal_uInt64 size; + sal_uInt64 size_read; + if(aFile.getSize(size) == osl::FileBase::E_None) + { + void* buffer = calloc(1, size+1); + CPPUNIT_ASSERT(buffer); + if(aFile.read( buffer, size, size_read) == osl::FileBase::E_None) + { + if(size == size_read) + { + OUString sCode(static_cast<char*>(buffer), size, RTL_TEXTENCODING_UTF8); + sSource = sCode; + } + } + + free(buffer); + } + } + CPPUNIT_ASSERT_MESSAGE( "Source is empty", ( sSource.getLength() > 0 ) ); + MakeModule( sSource ); +} + +SbxVariableRef MacroSnippet::Run( const css::uno::Sequence< css::uno::Any >& rArgs ) +{ + SbxVariableRef pReturn; + if ( !Compile() ) + return pReturn; + SbMethod* pMeth = mpMod.is() ? static_cast<SbMethod*>(mpMod->Find( "doUnitTest", SbxClassType::Method )) : nullptr; + if ( pMeth ) + { + if ( rArgs.hasElements() ) + { + SbxArrayRef aArgs = new SbxArray; + for ( int i=0; i < rArgs.getLength(); ++i ) + { + SbxVariable* pVar = new SbxVariable(); + unoToSbxValue( pVar, rArgs[ i ] ); + aArgs->Put32( pVar, i + 1 ); + } + pMeth->SetParameters( aArgs.get() ); + } + pReturn = new SbxMethod( *static_cast<SbxMethod*>(pMeth)); + } + return pReturn; +} + +SbxVariableRef MacroSnippet::Run() +{ + css::uno::Sequence< css::uno::Any > aArgs; + return Run( aArgs ); +} + +bool MacroSnippet::Compile() +{ + CPPUNIT_ASSERT_MESSAGE("module is NULL", mpMod.get() != nullptr ); + mpMod->Compile(); + return !mbError; +} + +bool MacroSnippet::HasError() const { return mbError; } + +const ErrCode& MacroSnippet::getError() const { return maErrCode; } + +IMPL_LINK( MacroSnippet, BasicErrorHdl, StarBASIC *, /*pBasic*/, bool) +{ + fprintf(stderr,"(%d:%d)\n", + StarBASIC::GetLine(), StarBASIC::GetCol1()); + fprintf(stderr,"Basic error: %s\n", OUStringToOString( StarBASIC::GetErrorText(), RTL_TEXTENCODING_UTF8 ).getStr() ); + mbError = true; + maErrCode = StarBASIC::GetErrorCode(); + return false; +} + +CPPUNIT_PLUGIN_IMPLEMENT(); + +/* vim:set shiftwidth=4 softtabstop=4 expandtab: */ diff --git a/basic/qa/cppunit/basictest.hxx b/basic/qa/cppunit/basictest.hxx new file mode 100644 index 000000000..c8d262ee6 --- /dev/null +++ b/basic/qa/cppunit/basictest.hxx @@ -0,0 +1,55 @@ +/* -*- Mode: C++; tab-width: 4; indent-tabs-mode: nil; c-basic-offset: 4 -*- */ +/* + * 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/. + */ +#ifndef INCLUDED_BASIC_QA_CPPUNIT_BASICTEST_HXX +#define INCLUDED_BASIC_QA_CPPUNIT_BASICTEST_HXX + +#include <sal/types.h> +#include <cppunit/TestFixture.h> +#include <cppunit/extensions/HelperMacros.h> +#include <cppunit/plugin/TestPlugIn.h> +#include <test/bootstrapfixture.hxx> +#include <basic/sbstar.hxx> +#include <basic/basrdll.hxx> +#include <basic/sbmod.hxx> +#include <basic/sbmeth.hxx> +#include <basic/sbuno.hxx> + +class MacroSnippet +{ +private: + bool mbError; + ErrCode maErrCode; + BasicDLL maDll; // we need a dll instance for resource manager etc. + SbModuleRef mpMod; + StarBASICRef mpBasic; + + void InitSnippet(); + void MakeModule( const OUString& sSource ); + +public: + explicit MacroSnippet( const OUString& sSource ); + MacroSnippet(); + + void LoadSourceFromFile( const OUString& sMacroFileURL ); + + SbxVariableRef Run( const css::uno::Sequence< css::uno::Any >& rArgs ); + + SbxVariableRef Run(); + + bool Compile(); + + DECL_LINK( BasicErrorHdl, StarBASIC *, bool ); + + bool HasError() const; + const ErrCode& getError() const; +}; + +#endif + +/* vim:set shiftwidth=4 softtabstop=4 expandtab: */ diff --git a/basic/qa/cppunit/test_append.cxx b/basic/qa/cppunit/test_append.cxx new file mode 100644 index 000000000..7ff58012b --- /dev/null +++ b/basic/qa/cppunit/test_append.cxx @@ -0,0 +1,80 @@ +/* -*- Mode: C++; tab-width: 4; indent-tabs-mode: nil; c-basic-offset: 4 -*- */ +/* + * 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/. + */ + +#include "basictest.hxx" + +namespace +{ + class EnableTest : public test::BootstrapFixture + { + public: + EnableTest() : BootstrapFixture(true, false) {}; + void testDimEnable(); + void testWin64(); + void testEnableRuntime(); + // Adds code needed to register the test suite + CPPUNIT_TEST_SUITE(EnableTest); + + // Declares the method as a test to call + CPPUNIT_TEST(testDimEnable); + CPPUNIT_TEST(testWin64); + CPPUNIT_TEST(testEnableRuntime); + + // End of test suite definition + CPPUNIT_TEST_SUITE_END(); + }; + +OUString sTestEnableRuntime( + "Function doUnitTest as Integer\n" + "Dim Enable as Integer\n" + "Enable = 1\n" + "Enable = Enable + 2\n" + "doUnitTest = Enable\n" + "End Function\n" +); + +OUString sTestDimEnable( + "Sub doUnitTest\n" + "Dim Enable as String\n" + "End Sub\n" +); + +void EnableTest::testEnableRuntime() +{ + MacroSnippet myMacro(sTestEnableRuntime); + myMacro.Compile(); + CPPUNIT_ASSERT_MESSAGE("testEnableRuntime fails with compile error",!myMacro.HasError() ); + SbxVariableRef pNew = myMacro.Run(); + CPPUNIT_ASSERT_EQUAL(static_cast<sal_Int16>(3), pNew->GetInteger()); +} + +void EnableTest::testDimEnable() +{ + MacroSnippet myMacro(sTestDimEnable); + myMacro.Compile(); + CPPUNIT_ASSERT_MESSAGE("Dim causes compile error", !myMacro.HasError() ); +} + +void EnableTest::testWin64() +{ + OUString aSource1 = " #If Win64\n" + "Declare PtrSafe Function aht_apiGetOpenFileName Lib \"comdlg32.dll\"" + "\n" + "#End if\n"; + + MacroSnippet myMacro(aSource1); + myMacro.Compile(); + CPPUNIT_ASSERT_MESSAGE("#if Win64 Declare PtrSafe causes compile error", !myMacro.HasError() ); +} + + // Put the test suite in the registry + CPPUNIT_TEST_SUITE_REGISTRATION(EnableTest); +} + +/* vim:set shiftwidth=4 softtabstop=4 expandtab: */ diff --git a/basic/qa/cppunit/test_compiler_checks.cxx b/basic/qa/cppunit/test_compiler_checks.cxx new file mode 100644 index 000000000..24b380ed2 --- /dev/null +++ b/basic/qa/cppunit/test_compiler_checks.cxx @@ -0,0 +1,36 @@ +/* -*- Mode: C++; tab-width: 4; indent-tabs-mode: nil; c-basic-offset: 4; fill-column: 100 -*- */ +/* + * 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/. + */ + +#include <sal/config.h> +#include "basictest.hxx" +#include <basic/sberrors.hxx> +#include <unotest/bootstrapfixturebase.hxx> + +CPPUNIT_TEST_FIXTURE(CppUnit::TestFixture, testRedefineArgument) +{ + MacroSnippet aMacro("Sub doUnitTest(argName)\n" + " If False Then\n" + " Dim argName\n" + " End If\n" + "End Sub\n"); + aMacro.Compile(); + CPPUNIT_ASSERT(aMacro.HasError()); + CPPUNIT_ASSERT_EQUAL(ERRCODE_BASIC_VAR_DEFINED, aMacro.getError().StripDynamic()); +} + +CPPUNIT_TEST_FIXTURE(CppUnit::TestFixture, testDoubleArgument) +{ + MacroSnippet aMacro("Sub doUnitTest(argName, argName)\n" + "End Sub\n"); + aMacro.Compile(); + CPPUNIT_ASSERT(aMacro.HasError()); + CPPUNIT_ASSERT_EQUAL(ERRCODE_BASIC_VAR_DEFINED, aMacro.getError().StripDynamic()); +} + +/* vim:set shiftwidth=4 softtabstop=4 expandtab cinoptions=b1,g0,N-s cinkeys+=0=break: */ diff --git a/basic/qa/cppunit/test_language_conditionals.cxx b/basic/qa/cppunit/test_language_conditionals.cxx new file mode 100644 index 000000000..53d6b6ec4 --- /dev/null +++ b/basic/qa/cppunit/test_language_conditionals.cxx @@ -0,0 +1,173 @@ +/* -*- Mode: C++; tab-width: 4; indent-tabs-mode: nil; c-basic-offset: 4; fill-column: 100 -*- */ +/* + * 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/. + */ + +#include "basictest.hxx" +#include <rtl/ustring.hxx> + +#include <cppunit/TestAssert.h> +#include <cppunit/TestFixture.h> +#include <cppunit/extensions/HelperMacros.h> + +namespace +{ +class Language_Conditionals : public CppUnit::TestFixture +{ +public: + void testIfNot(); + void testIfAndNot(); + void testNENot(); + + CPPUNIT_TEST_SUITE(Language_Conditionals); + + CPPUNIT_TEST(testIfNot); + CPPUNIT_TEST(testIfAndNot); + CPPUNIT_TEST(testNENot); + + CPPUNIT_TEST_SUITE_END(); +}; + +void Language_Conditionals::testIfNot() +{ + { // need a block to ensure MacroSnippet is cleaned properly + const OUString aSnippet("Option VBASupport 1\n" + "Option Explicit\n" + "\n" + "Function doUnitTest() As Integer\n" + "Dim op1 As Boolean\n" + "op1 = False\n" + "If Not op1 Then\n" + "doUnitTest = 1\n" + "Else\n" + "doUnitTest = 0\n" + "End If\n" + "End Function\n"); + MacroSnippet myMacro(aSnippet); + myMacro.Compile(); + CPPUNIT_ASSERT(!myMacro.HasError()); + SbxVariableRef pNew = myMacro.Run(); + CPPUNIT_ASSERT_EQUAL(static_cast<sal_Int16>(1), pNew->GetInteger()); + } + { // need a block to ensure MacroSnippet is cleaned properly + const OUString aSnippet("Option VBASupport 0\n" + "Option Explicit\n" + "\n" + "Function doUnitTest() As Integer\n" + "Dim op1 As Boolean\n" + "op1 = False\n" + "If Not op1 Then\n" + "doUnitTest = 1\n" + "Else\n" + "doUnitTest = 0\n" + "End If\n" + "End Function\n"); + MacroSnippet myMacro(aSnippet); + myMacro.Compile(); + CPPUNIT_ASSERT(!myMacro.HasError()); + SbxVariableRef pNew = myMacro.Run(); + CPPUNIT_ASSERT_EQUAL(static_cast<sal_Int16>(1), pNew->GetInteger()); + } +} + +void Language_Conditionals::testIfAndNot() +{ + { // need a block to ensure MacroSnippet is cleaned properly + const OUString aSnippet("Option VBASupport 1\n" + "Option Explicit\n" + "\n" + "Function doUnitTest() As Integer\n" + "Dim op1 As Boolean\n" + "Dim op2 As Boolean\n" + "op1 = True\n" + "op2 = False\n" + "If op1 And Not op2 Then\n" + "doUnitTest = 1\n" + "Else\n" + "doUnitTest = 0\n" + "End If\n" + "End Function\n"); + MacroSnippet myMacro(aSnippet); + myMacro.Compile(); + CPPUNIT_ASSERT(!myMacro.HasError()); + SbxVariableRef pNew = myMacro.Run(); + CPPUNIT_ASSERT_EQUAL(static_cast<sal_Int16>(1), pNew->GetInteger()); + } + { // need a block to ensure MacroSnippet is cleaned properly + const OUString aSnippet("Option VBASupport 0\n" + "Option Explicit\n" + "\n" + "Function doUnitTest() As Integer\n" + "Dim op1 As Boolean\n" + "Dim op2 As Boolean\n" + "op1 = True\n" + "op2 = False\n" + "If op1 And Not op2 Then\n" + "doUnitTest = 1\n" + "Else\n" + "doUnitTest = 0\n" + "End If\n" + "End Function\n"); + MacroSnippet myMacro(aSnippet); + myMacro.Compile(); + CPPUNIT_ASSERT(!myMacro.HasError()); + SbxVariableRef pNew = myMacro.Run(); + CPPUNIT_ASSERT_EQUAL(static_cast<sal_Int16>(1), pNew->GetInteger()); + } +} + +void Language_Conditionals::testNENot() +{ + { // need a block to ensure MacroSnippet is cleaned properly + const OUString aSnippet("Option VBASupport 1\n" + "Option Explicit\n" + "\n" + "Function doUnitTest() As Integer\n" + "Dim op1 As Boolean\n" + "Dim op2 As Boolean\n" + "op1 = False\n" + "op2 = False\n" + "If op1 <> Not op2 Then\n" + "doUnitTest = 1\n" + "Else\n" + "doUnitTest = 0\n" + "End If\n" + "End Function\n"); + MacroSnippet myMacro(aSnippet); + myMacro.Compile(); + CPPUNIT_ASSERT(!myMacro.HasError()); + SbxVariableRef pNew = myMacro.Run(); + CPPUNIT_ASSERT_EQUAL(static_cast<sal_Int16>(1), pNew->GetInteger()); + } + { // need a block to ensure MacroSnippet is cleaned properly + const OUString aSnippet("Option VBASupport 0\n" + "Option Explicit\n" + "\n" + "Function doUnitTest() As Integer\n" + "Dim op1 As Boolean\n" + "Dim op2 As Boolean\n" + "op1 = False\n" + "op2 = False\n" + "If op1 <> Not op2 Then\n" + "doUnitTest = 1\n" + "Else\n" + "doUnitTest = 0\n" + "End If\n" + "End Function\n"); + MacroSnippet myMacro(aSnippet); + myMacro.Compile(); + CPPUNIT_ASSERT(!myMacro.HasError()); + SbxVariableRef pNew = myMacro.Run(); + CPPUNIT_ASSERT_EQUAL(static_cast<sal_Int16>(1), pNew->GetInteger()); + } +} + +CPPUNIT_TEST_SUITE_REGISTRATION(Language_Conditionals); + +} // namespace + +/* vim:set shiftwidth=4 softtabstop=4 expandtab cinoptions=b1,g0,N-s cinkeys+=0=break: */ diff --git a/basic/qa/cppunit/test_nested_struct.cxx b/basic/qa/cppunit/test_nested_struct.cxx new file mode 100644 index 000000000..009d832b1 --- /dev/null +++ b/basic/qa/cppunit/test_nested_struct.cxx @@ -0,0 +1,303 @@ +/* -*- Mode: C++; tab-width: 4; indent-tabs-mode: nil; c-basic-offset: 4 -*- */ +/* + * 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/. + */ +#include "basictest.hxx" + +#include <com/sun/star/awt/WindowDescriptor.hpp> +#include <com/sun/star/table/TableBorder.hpp> +#include <basic/sbuno.hxx> + +namespace +{ + using namespace com::sun::star; + class Nested_Struct : public test::BootstrapFixture + { + public: + Nested_Struct(): BootstrapFixture(true, false) {}; + void testAssign1(); + void testAssign1Alt(); // result is uno-ised and tested + void testOldAssign(); + void testOldAssignAlt(); // result is uno-ised and tested + void testUnfixedVarAssign(); + void testUnfixedVarAssignAlt(); // result is uno-ised and tested + void testFixedVarAssign(); + void testFixedVarAssignAlt(); // result is uno-ised and tested + void testUnoAccess(); // fdo#60117 specific test + + // Adds code needed to register the test suite + CPPUNIT_TEST_SUITE(Nested_Struct); + + // Declares the method as a test to call + CPPUNIT_TEST(testAssign1); + CPPUNIT_TEST(testAssign1Alt); + CPPUNIT_TEST(testOldAssign); + CPPUNIT_TEST(testOldAssignAlt); + CPPUNIT_TEST(testUnfixedVarAssign); + CPPUNIT_TEST(testUnfixedVarAssignAlt); + CPPUNIT_TEST(testFixedVarAssign); + CPPUNIT_TEST(testFixedVarAssignAlt); + CPPUNIT_TEST(testUnoAccess); + + // End of test suite definition + CPPUNIT_TEST_SUITE_END(); + }; + +// tests the new behaviour, we should be able to +// directly modify the value of the nested 'HorizontalLine' struct +OUString sTestSource1( + "Function doUnitTest() as Integer\n" + "Dim b0 as new \"com.sun.star.table.TableBorder\"\n" + "b0.HorizontalLine.OuterLineWidth = 9\n" + "doUnitTest = b0.HorizontalLine.OuterLineWidth\n" + "End Function\n" +); + +OUString sTestSource1Alt( + "Function doUnitTest() as Object\n" + "Dim b0 as new \"com.sun.star.table.TableBorder\"\n" + "b0.HorizontalLine.OuterLineWidth = 9\n" + "doUnitTest = b0\n" + "End Function\n" +); + +// tests the old behaviour, we should still be able +// to use the old workaround of +// a) creating a new instance BorderLine, +// b) cloning the new instance with the value of b0.HorizontalLine +// c) modifying the new instance +// d) setting b0.HorizontalLine with the value of the new instance +OUString sTestSource2( + "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" + "doUnitTest = b0.HorizontalLine.OuterLineWidth\n" +"End Function\n" +); + +OUString sTestSource2Alt( + "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" + "doUnitTest = b0\n" +"End Function\n" +); +// it should be legal to assign a variant to a struct ( and copy by val ) +// make sure we aren't copying by reference, we make sure that l is not +// a reference copy of b0.HorizontalLine, each one should have an +// 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 ) +OUString sTestSource3( + "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" + "doUnitTest = b0.HorizontalLine.OuterLineWidth + l.OuterLineWidth\n" +"End Function\n" +); + +OUString sTestSource3Alt( + "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" + "Dim result(1)\n" + "result(0) = b0\n" + "result(1) = l\n" + "doUnitTest = result\n" +"End Function\n" +); + +// nearly the same as above but this time for a fixed type +// variable +OUString sTestSource4( + "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" + "doUnitTest = b0.HorizontalLine.OuterLineWidth + l.OuterLineWidth\n" +"End Function\n" +); + +OUString sTestSource4Alt( + "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" + "Dim result(1)\n" + "result(0) = b0\n" + "result(1) = l\n" + "doUnitTest = result\n" +"End Function\n" +); + +// Although basic might appear to correctly change nested struct elements +// fdo#60117 shows that basic can be fooled ( and even the watch(ed) variable +// in the debugger shows the expected values ) +// We need to additionally check the actual uno struct to see if the +// changes made are *really* reflected in the object +OUString sTestSource5( + "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" + "doUnitTest = aWinDesc\n" +"End Function\n" +); + + +void Nested_Struct::testAssign1() +{ + MacroSnippet myMacro( sTestSource1 ); + myMacro.Compile(); + CPPUNIT_ASSERT_MESSAGE("testAssign1 fails with compile error",!myMacro.HasError() ); + SbxVariableRef pNew = myMacro.Run(); + CPPUNIT_ASSERT_EQUAL(static_cast<sal_Int16>(9), pNew->GetInteger()); +} + +void Nested_Struct::testAssign1Alt() +{ + MacroSnippet myMacro( sTestSource1Alt ); + myMacro.Compile(); + CPPUNIT_ASSERT_MESSAGE("testAssign1Alt fails with compile error",!myMacro.HasError() ); + SbxVariableRef pNew = myMacro.Run(); + uno::Any aRet = sbxToUnoValue( pNew.get() ); + table::TableBorder aBorder; + aRet >>= aBorder; + + int result = aBorder.HorizontalLine.OuterLineWidth; + CPPUNIT_ASSERT_EQUAL( 9, result ); +} + +void Nested_Struct::testOldAssign() +{ + MacroSnippet myMacro( sTestSource2 ); + myMacro.Compile(); + CPPUNIT_ASSERT_MESSAGE("testOldAssign fails with compile error",!myMacro.HasError() ); + SbxVariableRef pNew = myMacro.Run(); + CPPUNIT_ASSERT_EQUAL(static_cast<sal_Int16>(9), pNew->GetInteger()); +} + +void Nested_Struct::testOldAssignAlt() +{ + MacroSnippet myMacro( sTestSource2Alt ); + myMacro.Compile(); + CPPUNIT_ASSERT_MESSAGE("testOldAssign fails with compile error",!myMacro.HasError() ); + SbxVariableRef pNew = myMacro.Run(); + uno::Any aRet = sbxToUnoValue( pNew.get() ); + table::TableBorder aBorder; + aRet >>= aBorder; + + int result = aBorder.HorizontalLine.OuterLineWidth; + CPPUNIT_ASSERT_EQUAL( 9, result ); +} + +void Nested_Struct::testUnfixedVarAssign() +{ + MacroSnippet myMacro( sTestSource3 ); + myMacro.Compile(); + CPPUNIT_ASSERT_MESSAGE("testUnfixedVarAssign fails with compile error",!myMacro.HasError() ); + // forces a broadcast + SbxVariableRef pNew = myMacro.Run(); + CPPUNIT_ASSERT_EQUAL(static_cast<sal_Int16>(13), pNew->GetInteger()); +} + +void Nested_Struct::testUnfixedVarAssignAlt() +{ + MacroSnippet myMacro( sTestSource3Alt ); + myMacro.Compile(); + CPPUNIT_ASSERT_MESSAGE("testUnfixedVarAssignAlt fails with compile error",!myMacro.HasError() ); + SbxVariableRef pNew = myMacro.Run(); + uno::Any aRet = sbxToUnoValue( pNew.get() ); + + uno::Sequence< uno::Any > aResult; + bool bRes = aRet >>= aResult; + CPPUNIT_ASSERT_EQUAL(true, bRes ); + + int result = aResult.getLength(); + // should have 2 elements in a sequence returned + CPPUNIT_ASSERT_EQUAL(2, result ); + + table::TableBorder aBorder; + aResult[0] >>= aBorder; + + table::BorderLine aBorderLine; + aResult[1] >>= aBorderLine; + result = aBorder.HorizontalLine.OuterLineWidth; + CPPUNIT_ASSERT_EQUAL(9, result ); + result = aBorderLine.OuterLineWidth; + CPPUNIT_ASSERT_EQUAL(4, result ); +} + +void Nested_Struct::testFixedVarAssign() +{ + MacroSnippet myMacro( sTestSource4 ); + myMacro.Compile(); + CPPUNIT_ASSERT_MESSAGE("testFixedVarAssign fails with compile error",!myMacro.HasError() ); + SbxVariableRef pNew = myMacro.Run(); + CPPUNIT_ASSERT_EQUAL(static_cast<sal_Int16>(13), pNew->GetInteger()); +} + +void Nested_Struct::testFixedVarAssignAlt() +{ + MacroSnippet myMacro( sTestSource4Alt ); + myMacro.Compile(); + CPPUNIT_ASSERT_MESSAGE("testFixedVarAssignAlt fails with compile error",!myMacro.HasError() ); + SbxVariableRef pNew = myMacro.Run(); + uno::Any aRet = sbxToUnoValue( pNew.get() ); + + uno::Sequence< uno::Any > aResult; + bool bRes = aRet >>= aResult; + CPPUNIT_ASSERT_EQUAL(true, bRes ); + + int result = aResult.getLength(); + // should have 2 elements in a sequence returned + CPPUNIT_ASSERT_EQUAL(2, result ); + + table::TableBorder aBorder; + aResult[0] >>= aBorder; + + table::BorderLine aBorderLine; + aResult[1] >>= aBorderLine; + result = aBorder.HorizontalLine.OuterLineWidth; + CPPUNIT_ASSERT_EQUAL(9, result ); + result = aBorderLine.OuterLineWidth; + CPPUNIT_ASSERT_EQUAL(4, result ); +} + +void Nested_Struct::testUnoAccess() +{ + MacroSnippet myMacro( sTestSource5 ); + myMacro.Compile(); + CPPUNIT_ASSERT_MESSAGE("testUnoAccess fails with compile error",!myMacro.HasError() ); + SbxVariableRef pNew = myMacro.Run(); + uno::Any aRet = sbxToUnoValue( pNew.get() ); + awt::WindowDescriptor aWinDesc; + aRet >>= aWinDesc; + + int result = aWinDesc.Bounds.X; + CPPUNIT_ASSERT_EQUAL(200, result ); +} + + // Put the test suite in the registry + CPPUNIT_TEST_SUITE_REGISTRATION(Nested_Struct); +} + +/* vim:set shiftwidth=4 softtabstop=4 expandtab: */ diff --git a/basic/qa/cppunit/test_scanner.cxx b/basic/qa/cppunit/test_scanner.cxx new file mode 100644 index 000000000..068006128 --- /dev/null +++ b/basic/qa/cppunit/test_scanner.cxx @@ -0,0 +1,1166 @@ +/* -*- Mode: C++; tab-width: 4; indent-tabs-mode: nil; c-basic-offset: 4 -*- */ +/* + * 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/. + */ + +#include <sal/types.h> +#include <cppunit/TestAssert.h> +#include <cppunit/TestFixture.h> +#include <cppunit/extensions/HelperMacros.h> +#include <cppunit/plugin/TestPlugIn.h> + +#include <rtl/math.hxx> + +#include <scanner.hxx> + +namespace +{ + struct Symbol + { + sal_uInt16 line; + sal_uInt16 col1; + OUString text; + double number; + SbxDataType type; + bool ws; + }; + + /** + * Perform tests on Scanner. + */ + class ScannerTest : public CppUnit::TestFixture + { + private: + void testBlankLines(); + void testOperators(); + void testAlphanum(); + void testComments(); + void testGoto(); + void testGotoCompatible(); + void testExclamation(); + void testNumbers(); + void testDataType(); + void testHexOctal(); + void testTdf103104(); + void testTdf136032(); + + // Adds code needed to register the test suite + CPPUNIT_TEST_SUITE(ScannerTest); + + // Declares the method as a test to call + CPPUNIT_TEST(testBlankLines); + CPPUNIT_TEST(testOperators); + CPPUNIT_TEST(testAlphanum); + CPPUNIT_TEST(testComments); + CPPUNIT_TEST(testGoto); + CPPUNIT_TEST(testGotoCompatible); + CPPUNIT_TEST(testExclamation); + CPPUNIT_TEST(testNumbers); + CPPUNIT_TEST(testDataType); + CPPUNIT_TEST(testHexOctal); + CPPUNIT_TEST(testTdf103104); + CPPUNIT_TEST(testTdf136032); + + // End of test suite definition + CPPUNIT_TEST_SUITE_END(); + }; + + static const OUString cr = "\n"; + static const OUString rem = "REM"; + static const OUString asdf = "asdf"; + static const OUString dot = "."; + static const OUString goto_ = "goto"; + static const OUString excl = "!"; + + std::vector<Symbol> getSymbols(const OUString& source, sal_Int32& errors, bool bCompatible = false) + { + std::vector<Symbol> symbols; + SbiScanner scanner(source); + scanner.EnableErrors(); + scanner.SetCompatible(bCompatible); + while(scanner.NextSym()) + { + Symbol symbol; + symbol.line = scanner.GetLine(); + symbol.col1 = scanner.GetCol1(); + symbol.text = scanner.GetSym(); + symbol.number = scanner.GetDbl(); + symbol.type = scanner.GetType(); + symbol.ws = scanner.WhiteSpace(); + symbols.push_back(symbol); + } + errors = scanner.GetErrors(); + return symbols; + } + + std::vector<Symbol> getSymbols(const OUString& source, bool bCompatible = false) + { + sal_Int32 i; + return getSymbols(source, i, bCompatible); + } + + void ScannerTest::testBlankLines() + { + const OUString source1(""); + const OUString source2("\r\n"); + const OUString source3("\n"); + const OUString source4("\r"); + const OUString source5("\r\n\r\n"); + const OUString source6("\n\r"); + const OUString source7("\n\r\n"); + const OUString source8("\r\n\r"); + const OUString source9(" "); + + std::vector<Symbol> symbols; + symbols = getSymbols(source1); + CPPUNIT_ASSERT(symbols.empty()); + + symbols = getSymbols(source2); + CPPUNIT_ASSERT_EQUAL(size_t(1), symbols.size()); + CPPUNIT_ASSERT_EQUAL(cr, symbols[0].text); + CPPUNIT_ASSERT_EQUAL(SbxVARIANT, symbols[0].type); + + symbols = getSymbols(source3); + CPPUNIT_ASSERT_EQUAL(size_t(1), symbols.size()); + CPPUNIT_ASSERT_EQUAL(cr, symbols[0].text); + CPPUNIT_ASSERT_EQUAL(SbxVARIANT, symbols[0].type); + + symbols = getSymbols(source4); + CPPUNIT_ASSERT_EQUAL(size_t(1), symbols.size()); + CPPUNIT_ASSERT_EQUAL(cr, symbols[0].text); + CPPUNIT_ASSERT_EQUAL(SbxVARIANT, symbols[0].type); + + symbols = getSymbols(source5); + CPPUNIT_ASSERT_EQUAL(size_t(2), symbols.size()); + CPPUNIT_ASSERT_EQUAL(cr, symbols[0].text); + CPPUNIT_ASSERT_EQUAL(SbxVARIANT, symbols[0].type); + CPPUNIT_ASSERT_EQUAL(cr, symbols[1].text); + CPPUNIT_ASSERT_EQUAL(SbxVARIANT, symbols[1].type); + + symbols = getSymbols(source6); + CPPUNIT_ASSERT_EQUAL(size_t(2), symbols.size()); + CPPUNIT_ASSERT_EQUAL(cr, symbols[0].text); + CPPUNIT_ASSERT_EQUAL(SbxVARIANT, symbols[0].type); + CPPUNIT_ASSERT_EQUAL(cr, symbols[1].text); + CPPUNIT_ASSERT_EQUAL(SbxVARIANT, symbols[1].type); + + symbols = getSymbols(source7); + CPPUNIT_ASSERT_EQUAL(size_t(2), symbols.size()); + CPPUNIT_ASSERT_EQUAL(cr, symbols[0].text); + CPPUNIT_ASSERT_EQUAL(SbxVARIANT, symbols[0].type); + CPPUNIT_ASSERT_EQUAL(cr, symbols[1].text); + CPPUNIT_ASSERT_EQUAL(SbxVARIANT, symbols[1].type); + + symbols = getSymbols(source8); + CPPUNIT_ASSERT_EQUAL(size_t(2), symbols.size()); + CPPUNIT_ASSERT_EQUAL(cr, symbols[0].text); + CPPUNIT_ASSERT_EQUAL(SbxVARIANT, symbols[0].type); + CPPUNIT_ASSERT_EQUAL(cr, symbols[1].text); + CPPUNIT_ASSERT_EQUAL(SbxVARIANT, symbols[1].type); + + symbols = getSymbols(source9); + CPPUNIT_ASSERT_EQUAL(size_t(1), symbols.size()); + CPPUNIT_ASSERT_EQUAL(cr, symbols[0].text); + CPPUNIT_ASSERT_EQUAL(SbxVARIANT, symbols[0].type); + } + + void ScannerTest::testOperators() + { + const OUString sourceE("="); + const OUString sourceLT("<"); + const OUString sourceGT(">"); + const OUString sourceLTE("<="); + const OUString sourceGTE(">="); + const OUString sourceEE("=="); + const OUString sourceNE("<>"); + const OUString sourceA(":="); + const OUString sourceNot("Not"); + + std::vector<Symbol> symbols; + + symbols = getSymbols(sourceE); + CPPUNIT_ASSERT_EQUAL(size_t(2), symbols.size()); + CPPUNIT_ASSERT_EQUAL(sourceE, symbols[0].text); + CPPUNIT_ASSERT_EQUAL(SbxVARIANT, symbols[0].type); + CPPUNIT_ASSERT_EQUAL(cr, symbols[1].text); + CPPUNIT_ASSERT_EQUAL(SbxVARIANT, symbols[1].type); + + symbols = getSymbols(sourceLT); + CPPUNIT_ASSERT_EQUAL(size_t(2), symbols.size()); + CPPUNIT_ASSERT_EQUAL(sourceLT, symbols[0].text); + CPPUNIT_ASSERT_EQUAL(SbxVARIANT, symbols[0].type); + CPPUNIT_ASSERT_EQUAL(cr, symbols[1].text); + CPPUNIT_ASSERT_EQUAL(SbxVARIANT, symbols[1].type); + + symbols = getSymbols(sourceGT); + CPPUNIT_ASSERT_EQUAL(size_t(2), symbols.size()); + CPPUNIT_ASSERT_EQUAL(sourceGT, symbols[0].text); + CPPUNIT_ASSERT_EQUAL(SbxVARIANT, symbols[0].type); + CPPUNIT_ASSERT_EQUAL(cr, symbols[1].text); + CPPUNIT_ASSERT_EQUAL(SbxVARIANT, symbols[1].type); + + symbols = getSymbols(sourceLTE); + CPPUNIT_ASSERT_EQUAL(size_t(2), symbols.size()); + CPPUNIT_ASSERT_EQUAL(sourceLTE, symbols[0].text); + CPPUNIT_ASSERT_EQUAL(SbxVARIANT, symbols[0].type); + CPPUNIT_ASSERT_EQUAL(cr, symbols[1].text); + CPPUNIT_ASSERT_EQUAL(SbxVARIANT, symbols[1].type); + + symbols = getSymbols(sourceGTE); + CPPUNIT_ASSERT_EQUAL(size_t(2), symbols.size()); + CPPUNIT_ASSERT_EQUAL(sourceGTE, symbols[0].text); + CPPUNIT_ASSERT_EQUAL(SbxVARIANT, symbols[0].type); + CPPUNIT_ASSERT_EQUAL(cr, symbols[1].text); + CPPUNIT_ASSERT_EQUAL(SbxVARIANT, symbols[1].type); + + symbols = getSymbols(sourceEE); + CPPUNIT_ASSERT_EQUAL(size_t(3), symbols.size()); + CPPUNIT_ASSERT_EQUAL(sourceE, symbols[0].text); + CPPUNIT_ASSERT_EQUAL(SbxVARIANT, symbols[0].type); + CPPUNIT_ASSERT_EQUAL(sourceE, symbols[1].text); + CPPUNIT_ASSERT_EQUAL(SbxVARIANT, symbols[1].type); + CPPUNIT_ASSERT_EQUAL(cr, symbols[2].text); + CPPUNIT_ASSERT_EQUAL(SbxVARIANT, symbols[2].type); + + symbols = getSymbols(sourceNE); + CPPUNIT_ASSERT_EQUAL(size_t(2), symbols.size()); + CPPUNIT_ASSERT_EQUAL(sourceNE, symbols[0].text); + CPPUNIT_ASSERT_EQUAL(SbxVARIANT, symbols[0].type); + CPPUNIT_ASSERT_EQUAL(cr, symbols[1].text); + CPPUNIT_ASSERT_EQUAL(SbxVARIANT, symbols[1].type); + + symbols = getSymbols(sourceA); + CPPUNIT_ASSERT_EQUAL(size_t(2), symbols.size()); + CPPUNIT_ASSERT_EQUAL(sourceA, symbols[0].text); + CPPUNIT_ASSERT_EQUAL(SbxVARIANT, symbols[0].type); + CPPUNIT_ASSERT_EQUAL(cr, symbols[1].text); + CPPUNIT_ASSERT_EQUAL(SbxVARIANT, symbols[1].type); + + symbols = getSymbols(sourceNot); + CPPUNIT_ASSERT_EQUAL(size_t(2), symbols.size()); + CPPUNIT_ASSERT_EQUAL(sourceNot, symbols[0].text); + CPPUNIT_ASSERT_EQUAL(SbxVARIANT, symbols[0].type); + CPPUNIT_ASSERT_EQUAL(cr, symbols[1].text); + CPPUNIT_ASSERT_EQUAL(SbxVARIANT, symbols[1].type); + } + + void ScannerTest::testAlphanum() + { + const OUString source1("asdfghefg"); + const OUString source2("1asfdasfd"); + const OUString source3("AdfsaAUdsl10987"); + const OUString source4("asdfa_mnvcnm"); + const OUString source5("_asdf1"); + const OUString source6("_6"); + const OUString source7("joxclk_"); + const OUString source8(" asdf "); + const OUString source9(" 19395 asdfa "); + const OUString source10("\n1\n2\na sdf"); + const OUString source11("asdf.asdf"); + const OUString source12(".."); + + std::vector<Symbol> symbols; + + symbols = getSymbols(source1); + CPPUNIT_ASSERT_EQUAL(size_t(2), symbols.size()); + CPPUNIT_ASSERT_EQUAL(source1, symbols[0].text); + CPPUNIT_ASSERT_EQUAL(SbxVARIANT, symbols[0].type); + CPPUNIT_ASSERT_EQUAL(cr, symbols[1].text); + CPPUNIT_ASSERT_EQUAL(SbxVARIANT, symbols[1].type); + + symbols = getSymbols(source2); + CPPUNIT_ASSERT_EQUAL(size_t(3), symbols.size()); + CPPUNIT_ASSERT(symbols[0].text.isEmpty()); // Can't start symbol with a digit + CPPUNIT_ASSERT_DOUBLES_EQUAL(1.0, symbols[0].number, 1E-12); + CPPUNIT_ASSERT_EQUAL(SbxINTEGER, symbols[0].type); + CPPUNIT_ASSERT_EQUAL(OUString("asfdasfd"), symbols[1].text); + CPPUNIT_ASSERT_EQUAL(SbxVARIANT, symbols[1].type); + CPPUNIT_ASSERT_EQUAL(cr, symbols[2].text); + CPPUNIT_ASSERT_EQUAL(SbxVARIANT, symbols[2].type); + + symbols = getSymbols(source3); + CPPUNIT_ASSERT_EQUAL(size_t(2), symbols.size()); + CPPUNIT_ASSERT_EQUAL(source3, symbols[0].text); + CPPUNIT_ASSERT_EQUAL(SbxVARIANT, symbols[0].type); + CPPUNIT_ASSERT_EQUAL(cr, symbols[1].text); + CPPUNIT_ASSERT_EQUAL(SbxVARIANT, symbols[1].type); + + symbols = getSymbols(source4); + CPPUNIT_ASSERT_EQUAL(size_t(2), symbols.size()); + CPPUNIT_ASSERT_EQUAL(source4, symbols[0].text); + CPPUNIT_ASSERT_EQUAL(SbxVARIANT, symbols[0].type); + CPPUNIT_ASSERT_EQUAL(cr, symbols[1].text); + CPPUNIT_ASSERT_EQUAL(SbxVARIANT, symbols[1].type); + + symbols = getSymbols(source5); + CPPUNIT_ASSERT_EQUAL(size_t(2), symbols.size()); + CPPUNIT_ASSERT_EQUAL(source5, symbols[0].text); + CPPUNIT_ASSERT_EQUAL(SbxVARIANT, symbols[0].type); + CPPUNIT_ASSERT_EQUAL(cr, symbols[1].text); + CPPUNIT_ASSERT_EQUAL(SbxVARIANT, symbols[1].type); + + symbols = getSymbols(source6); + CPPUNIT_ASSERT_EQUAL(size_t(2), symbols.size()); + CPPUNIT_ASSERT_EQUAL(source6, symbols[0].text); + CPPUNIT_ASSERT_EQUAL(SbxVARIANT, symbols[0].type); + CPPUNIT_ASSERT_EQUAL(cr, symbols[1].text); + CPPUNIT_ASSERT_EQUAL(SbxVARIANT, symbols[1].type); + + symbols = getSymbols(source7); + CPPUNIT_ASSERT_EQUAL(size_t(2), symbols.size()); + CPPUNIT_ASSERT_EQUAL(OUString("joxclk_"), symbols[0].text); + CPPUNIT_ASSERT_EQUAL(SbxVARIANT, symbols[0].type); + CPPUNIT_ASSERT_EQUAL(OUString("joxclk "), source7); // Change the trailing '_' to a ' ' + CPPUNIT_ASSERT_EQUAL(cr, symbols[1].text); + CPPUNIT_ASSERT_EQUAL(SbxVARIANT, symbols[1].type); + + symbols = getSymbols(source8); + CPPUNIT_ASSERT_EQUAL(size_t(2), symbols.size()); + CPPUNIT_ASSERT_EQUAL(OUString("asdf"), symbols[0].text); + CPPUNIT_ASSERT_EQUAL(SbxVARIANT, symbols[0].type); + CPPUNIT_ASSERT_EQUAL(cr, symbols[1].text); + CPPUNIT_ASSERT_EQUAL(SbxVARIANT, symbols[1].type); + + symbols = getSymbols(source9); + CPPUNIT_ASSERT_EQUAL(size_t(3), symbols.size()); + CPPUNIT_ASSERT(symbols[0].text.isEmpty()); + CPPUNIT_ASSERT_DOUBLES_EQUAL(19395.0, symbols[0].number, 1E-12); + CPPUNIT_ASSERT_EQUAL(SbxINTEGER, symbols[0].type); + CPPUNIT_ASSERT_EQUAL(OUString("asdfa"), symbols[1].text); + CPPUNIT_ASSERT_EQUAL(SbxVARIANT, symbols[1].type); + CPPUNIT_ASSERT_EQUAL(cr, symbols[2].text); + CPPUNIT_ASSERT_EQUAL(SbxVARIANT, symbols[2].type); + + symbols = getSymbols(source10); + CPPUNIT_ASSERT_EQUAL(size_t(8), symbols.size()); + CPPUNIT_ASSERT_EQUAL(cr, symbols[0].text); + CPPUNIT_ASSERT_EQUAL(SbxVARIANT, symbols[0].type); + CPPUNIT_ASSERT(symbols[1].text.isEmpty()); + CPPUNIT_ASSERT_DOUBLES_EQUAL(1.0, symbols[1].number, 1E-12); + CPPUNIT_ASSERT_EQUAL(SbxINTEGER, symbols[1].type); + CPPUNIT_ASSERT_EQUAL(cr, symbols[2].text); + CPPUNIT_ASSERT_EQUAL(SbxVARIANT, symbols[2].type); + CPPUNIT_ASSERT(symbols[3].text.isEmpty()); + CPPUNIT_ASSERT_DOUBLES_EQUAL(2.0, symbols[3].number, 1E-12); + CPPUNIT_ASSERT_EQUAL(SbxINTEGER, symbols[3].type); + CPPUNIT_ASSERT_EQUAL(cr, symbols[4].text); + CPPUNIT_ASSERT_EQUAL(SbxVARIANT, symbols[4].type); + CPPUNIT_ASSERT_EQUAL(1u, static_cast<unsigned int>(symbols[5].text.getLength())); + CPPUNIT_ASSERT_EQUAL('a', static_cast<char>(symbols[5].text[0])); + CPPUNIT_ASSERT_EQUAL(SbxVARIANT, symbols[5].type); + CPPUNIT_ASSERT_EQUAL(OUString("sdf"), symbols[6].text); + CPPUNIT_ASSERT_EQUAL(SbxVARIANT, symbols[6].type); + CPPUNIT_ASSERT_EQUAL(cr, symbols[7].text); + CPPUNIT_ASSERT_EQUAL(SbxVARIANT, symbols[7].type); + + symbols = getSymbols(source11); + CPPUNIT_ASSERT_EQUAL(size_t(4), symbols.size()); + CPPUNIT_ASSERT_EQUAL(asdf, symbols[0].text); + CPPUNIT_ASSERT_EQUAL(SbxVARIANT, symbols[0].type); + CPPUNIT_ASSERT_EQUAL(dot, symbols[1].text); + CPPUNIT_ASSERT_EQUAL(SbxVARIANT, symbols[1].type); + CPPUNIT_ASSERT_EQUAL(asdf, symbols[2].text); + CPPUNIT_ASSERT_EQUAL(SbxVARIANT, symbols[2].type); + CPPUNIT_ASSERT_EQUAL(cr, symbols[3].text); + CPPUNIT_ASSERT_EQUAL(SbxVARIANT, symbols[3].type); + + symbols = getSymbols(source12); + CPPUNIT_ASSERT_EQUAL(size_t(3), symbols.size()); + CPPUNIT_ASSERT_EQUAL(dot, symbols[0].text); + CPPUNIT_ASSERT_EQUAL(SbxVARIANT, symbols[0].type); + CPPUNIT_ASSERT_EQUAL(dot, symbols[1].text); + CPPUNIT_ASSERT_EQUAL(SbxVARIANT, symbols[1].type); + CPPUNIT_ASSERT_EQUAL(cr, symbols[2].text); + CPPUNIT_ASSERT_EQUAL(SbxVARIANT, symbols[2].type); + } + + void ScannerTest::testComments() + { + const OUString source1("REM asdf"); + const OUString source2("REMasdf"); + const OUString source3("'asdf"); + const OUString source4("asdf _\n'100"); + const OUString source5("'asdf _\n100"); + const OUString source6("'asdf _\n'100"); + const OUString source7("'asdf _\n 1234 _\n asdf'"); + + std::vector<Symbol> symbols; + + symbols = getSymbols(source1); + CPPUNIT_ASSERT_EQUAL(size_t(1), symbols.size()); + CPPUNIT_ASSERT_EQUAL(rem, symbols[0].text); + CPPUNIT_ASSERT_EQUAL(SbxVARIANT, symbols[0].type); + + symbols = getSymbols(source2); + CPPUNIT_ASSERT_EQUAL(size_t(2), symbols.size()); + CPPUNIT_ASSERT_EQUAL(OUString("REMasdf"), symbols[0].text); + CPPUNIT_ASSERT_EQUAL(SbxVARIANT, symbols[0].type); + CPPUNIT_ASSERT_EQUAL(cr, symbols[1].text); + CPPUNIT_ASSERT_EQUAL(SbxVARIANT, symbols[1].type); + + symbols = getSymbols(source3); + CPPUNIT_ASSERT_EQUAL(size_t(1), symbols.size()); + CPPUNIT_ASSERT_EQUAL(rem, symbols[0].text); + CPPUNIT_ASSERT_EQUAL(SbxVARIANT, symbols[0].type); + + symbols = getSymbols(source4); + CPPUNIT_ASSERT_EQUAL(size_t(2), symbols.size()); + CPPUNIT_ASSERT_EQUAL(asdf, symbols[0].text); + CPPUNIT_ASSERT_EQUAL(SbxVARIANT, symbols[0].type); + CPPUNIT_ASSERT_EQUAL(rem, symbols[1].text); + CPPUNIT_ASSERT_EQUAL(SbxVARIANT, symbols[1].type); + + symbols = getSymbols(source5); + CPPUNIT_ASSERT_EQUAL(size_t(3), symbols.size()); + CPPUNIT_ASSERT_EQUAL(rem, symbols[0].text); + CPPUNIT_ASSERT_EQUAL(SbxVARIANT, symbols[0].type); + CPPUNIT_ASSERT(symbols[1].text.isEmpty()); + CPPUNIT_ASSERT_DOUBLES_EQUAL(100.0, symbols[1].number, 1E-12); + CPPUNIT_ASSERT_EQUAL(SbxINTEGER, symbols[1].type); + CPPUNIT_ASSERT_EQUAL(cr, symbols[2].text); + CPPUNIT_ASSERT_EQUAL(SbxVARIANT, symbols[2].type); + + symbols = getSymbols(source6); + CPPUNIT_ASSERT_EQUAL(size_t(2), symbols.size()); + CPPUNIT_ASSERT_EQUAL(rem, symbols[0].text); + CPPUNIT_ASSERT_EQUAL(SbxVARIANT, symbols[0].type); + CPPUNIT_ASSERT_EQUAL(rem, symbols[1].text); + CPPUNIT_ASSERT_EQUAL(SbxVARIANT, symbols[1].type); + + symbols = getSymbols(source7); + CPPUNIT_ASSERT_EQUAL(size_t(4), symbols.size()); + CPPUNIT_ASSERT_EQUAL(rem, symbols[0].text); + CPPUNIT_ASSERT_EQUAL(SbxVARIANT, symbols[0].type); + CPPUNIT_ASSERT(symbols[1].text.isEmpty()); + CPPUNIT_ASSERT_DOUBLES_EQUAL(1234.0, symbols[1].number, 1E-12); + CPPUNIT_ASSERT_EQUAL(SbxINTEGER, symbols[1].type); + CPPUNIT_ASSERT_EQUAL(asdf, symbols[2].text); + CPPUNIT_ASSERT_EQUAL(SbxVARIANT, symbols[2].type); + CPPUNIT_ASSERT_EQUAL(rem, symbols[3].text); + CPPUNIT_ASSERT_EQUAL(SbxVARIANT, symbols[3].type); + } + + void ScannerTest::testGoto() + { + const OUString source1("goto"); + const OUString source2("go to"); + const OUString source3("go\nto"); + + std::vector<Symbol> symbols; + + symbols = getSymbols(source1); + CPPUNIT_ASSERT_EQUAL(size_t(2), symbols.size()); + CPPUNIT_ASSERT_EQUAL(goto_, symbols[0].text); + CPPUNIT_ASSERT_EQUAL(SbxVARIANT, symbols[0].type); + CPPUNIT_ASSERT_EQUAL(cr, symbols[1].text); + CPPUNIT_ASSERT_EQUAL(SbxVARIANT, symbols[1].type); + + symbols = getSymbols(source2); + CPPUNIT_ASSERT_EQUAL(size_t(3), symbols.size()); + CPPUNIT_ASSERT_EQUAL(OUString("go"), symbols[0].text); + CPPUNIT_ASSERT_EQUAL(SbxVARIANT, symbols[0].type); + CPPUNIT_ASSERT_EQUAL(OUString("to"), symbols[1].text); + CPPUNIT_ASSERT_EQUAL(SbxVARIANT, symbols[1].type); + CPPUNIT_ASSERT_EQUAL(cr, symbols[2].text); + CPPUNIT_ASSERT_EQUAL(SbxVARIANT, symbols[2].type); + + symbols = getSymbols(source3); + CPPUNIT_ASSERT_EQUAL(size_t(4), symbols.size()); + CPPUNIT_ASSERT_EQUAL(OUString("go"), symbols[0].text); + CPPUNIT_ASSERT_EQUAL(SbxVARIANT, symbols[0].type); + CPPUNIT_ASSERT_EQUAL(cr, symbols[1].text); + CPPUNIT_ASSERT_EQUAL(SbxVARIANT, symbols[1].type); + CPPUNIT_ASSERT_EQUAL(OUString("to"), symbols[2].text); + CPPUNIT_ASSERT_EQUAL(SbxVARIANT, symbols[2].type); + CPPUNIT_ASSERT_EQUAL(cr, symbols[3].text); + CPPUNIT_ASSERT_EQUAL(SbxVARIANT, symbols[3].type); + } + + void ScannerTest::testGotoCompatible() + { + const OUString source1("goto"); + const OUString source2("go to"); + const OUString source3("go\nto"); + + std::vector<Symbol> symbols; + + symbols = getSymbols(source1, true); + CPPUNIT_ASSERT_EQUAL(size_t(2), symbols.size()); + CPPUNIT_ASSERT_EQUAL(goto_, symbols[0].text); + CPPUNIT_ASSERT_EQUAL(cr, symbols[1].text); + + symbols = getSymbols(source2, true); + CPPUNIT_ASSERT_EQUAL(size_t(2), symbols.size()); + CPPUNIT_ASSERT_EQUAL(goto_, symbols[0].text); + CPPUNIT_ASSERT_EQUAL(cr, symbols[1].text); + + symbols = getSymbols(source3, true); + CPPUNIT_ASSERT_EQUAL(size_t(4), symbols.size()); + CPPUNIT_ASSERT_EQUAL(OUString("go"), symbols[0].text); + CPPUNIT_ASSERT_EQUAL(cr, symbols[1].text); + CPPUNIT_ASSERT_EQUAL(OUString("to"), symbols[2].text); + CPPUNIT_ASSERT_EQUAL(cr, symbols[3].text); + } + + void ScannerTest::testExclamation() + { + const OUString source1("asdf!asdf"); + const OUString source2("!1234"); + const OUString source3("!_3"); + const OUString source4("!$"); + const OUString source5("!%"); + const OUString source6("!\n"); + + std::vector<Symbol> symbols; + + symbols = getSymbols(source1); + CPPUNIT_ASSERT_EQUAL(size_t(4), symbols.size()); + CPPUNIT_ASSERT_EQUAL(asdf, symbols[0].text); + CPPUNIT_ASSERT_EQUAL(excl, symbols[1].text); + CPPUNIT_ASSERT_EQUAL(asdf, symbols[2].text); + CPPUNIT_ASSERT_EQUAL(cr, symbols[3].text); + + symbols = getSymbols(source2); + CPPUNIT_ASSERT_EQUAL(size_t(3), symbols.size()); + CPPUNIT_ASSERT_EQUAL(excl, symbols[0].text); + CPPUNIT_ASSERT(symbols[1].text.isEmpty()); + CPPUNIT_ASSERT_DOUBLES_EQUAL(1234.0, symbols[1].number, 1E-12); + CPPUNIT_ASSERT_EQUAL(cr, symbols[2].text); + + symbols = getSymbols(source3); + CPPUNIT_ASSERT_EQUAL(size_t(3), symbols.size()); + CPPUNIT_ASSERT_EQUAL(excl, symbols[0].text); + CPPUNIT_ASSERT_EQUAL(OUString("_3"), symbols[1].text); + CPPUNIT_ASSERT_EQUAL(cr, symbols[2].text); + + symbols = getSymbols(source4); + CPPUNIT_ASSERT_EQUAL(size_t(3), symbols.size()); + CPPUNIT_ASSERT_EQUAL(excl, symbols[0].text); + CPPUNIT_ASSERT_EQUAL(OUString("$"), symbols[1].text); + CPPUNIT_ASSERT_EQUAL(cr, symbols[2].text); + + symbols = getSymbols(source5); + CPPUNIT_ASSERT_EQUAL(size_t(3), symbols.size()); + CPPUNIT_ASSERT_EQUAL(excl, symbols[0].text); + CPPUNIT_ASSERT_EQUAL(OUString("%"), symbols[1].text); + CPPUNIT_ASSERT_EQUAL(cr, symbols[2].text); + + symbols = getSymbols(source6); + CPPUNIT_ASSERT_EQUAL(size_t(2), symbols.size()); + CPPUNIT_ASSERT_EQUAL(excl, symbols[0].text); + CPPUNIT_ASSERT_EQUAL(cr, symbols[1].text); + } + + void ScannerTest::testNumbers() + { + const OUString source1("12345"); + const OUString source2("1.2.3"); + const OUString source3("123.4"); + const OUString source4("0.5"); + const OUString source5("5.0"); + const OUString source6("0.0"); + const OUString source7("-3"); + const OUString source8("-0.0"); + const OUString source9("12dE3"); + const OUString source10("12e3"); + const OUString source11("12D+3"); + const OUString source12("12e++3"); + const OUString source13("12e-3"); + const OUString source14("12e-3+"); + const OUString source15("1,2,3"); + const OUString source16("1.0000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000000"); + const OUString source17("10e308"); + + std::vector<Symbol> symbols; + sal_Int32 errors; + + symbols = getSymbols(source1, errors); + CPPUNIT_ASSERT_EQUAL(size_t(2), symbols.size()); + CPPUNIT_ASSERT_DOUBLES_EQUAL(12345.0, symbols[0].number, 1E-12); + CPPUNIT_ASSERT_EQUAL(SbxINTEGER, symbols[0].type); + CPPUNIT_ASSERT_EQUAL(cr, symbols[1].text); + CPPUNIT_ASSERT_EQUAL(0u, static_cast<unsigned int>(errors)); + + symbols = getSymbols(source2, errors); + CPPUNIT_ASSERT_EQUAL(size_t(3), symbols.size()); + CPPUNIT_ASSERT_DOUBLES_EQUAL(1.2, symbols[0].number, 1E-12); + CPPUNIT_ASSERT_EQUAL(SbxDOUBLE, symbols[0].type); + CPPUNIT_ASSERT_DOUBLES_EQUAL(.3, symbols[1].number, 1E-12); + CPPUNIT_ASSERT_EQUAL(SbxDOUBLE, symbols[1].type); + CPPUNIT_ASSERT_EQUAL(cr, symbols[2].text); + CPPUNIT_ASSERT_EQUAL(1u, static_cast<unsigned int>(errors)); + + symbols = getSymbols(source3, errors); + CPPUNIT_ASSERT_EQUAL(size_t(2), symbols.size()); + CPPUNIT_ASSERT_DOUBLES_EQUAL(123.4, symbols[0].number, 1E-12); + CPPUNIT_ASSERT_EQUAL(SbxDOUBLE, symbols[0].type); + CPPUNIT_ASSERT_EQUAL(cr, symbols[1].text); + CPPUNIT_ASSERT_EQUAL(0u, static_cast<unsigned int>(errors)); + + symbols = getSymbols(source4, errors); + CPPUNIT_ASSERT_EQUAL(size_t(2), symbols.size()); + CPPUNIT_ASSERT_DOUBLES_EQUAL(.5, symbols[0].number, 1E-12); + CPPUNIT_ASSERT_EQUAL(SbxDOUBLE, symbols[0].type); + CPPUNIT_ASSERT_EQUAL(cr, symbols[1].text); + CPPUNIT_ASSERT_EQUAL(0u, static_cast<unsigned int>(errors)); + + symbols = getSymbols(source5, errors); + CPPUNIT_ASSERT_EQUAL(size_t(2), symbols.size()); + CPPUNIT_ASSERT_DOUBLES_EQUAL(5.0, symbols[0].number, 1E-12); + CPPUNIT_ASSERT_EQUAL(SbxDOUBLE, symbols[0].type); + CPPUNIT_ASSERT_EQUAL(cr, symbols[1].text); + CPPUNIT_ASSERT_EQUAL(0u, static_cast<unsigned int>(errors)); + + symbols = getSymbols(source6, errors); + CPPUNIT_ASSERT_EQUAL(size_t(2), symbols.size()); + CPPUNIT_ASSERT_DOUBLES_EQUAL(0.0, symbols[0].number, 1E-12); + CPPUNIT_ASSERT_EQUAL(SbxDOUBLE, symbols[0].type); + CPPUNIT_ASSERT_EQUAL(cr, symbols[1].text); + CPPUNIT_ASSERT_EQUAL(0u, static_cast<unsigned int>(errors)); + + symbols = getSymbols(source7, errors); + CPPUNIT_ASSERT_EQUAL(size_t(3), symbols.size()); + CPPUNIT_ASSERT_EQUAL(OUString("-"), symbols[0].text); + CPPUNIT_ASSERT_DOUBLES_EQUAL(3.0, symbols[1].number, 1E-12); + CPPUNIT_ASSERT_EQUAL(SbxINTEGER, symbols[1].type); + CPPUNIT_ASSERT_EQUAL(cr, symbols[2].text); + CPPUNIT_ASSERT_EQUAL(0u, static_cast<unsigned int>(errors)); + + symbols = getSymbols(source8, errors); + CPPUNIT_ASSERT_EQUAL(size_t(3), symbols.size()); + CPPUNIT_ASSERT_EQUAL(OUString("-"), symbols[0].text); + CPPUNIT_ASSERT_DOUBLES_EQUAL(0.0, symbols[1].number, 1E-12); + CPPUNIT_ASSERT_EQUAL(SbxDOUBLE, symbols[1].type); + CPPUNIT_ASSERT_EQUAL(cr, symbols[2].text); + CPPUNIT_ASSERT_EQUAL(0u, static_cast<unsigned int>(errors)); + + symbols = getSymbols(source9, errors); + CPPUNIT_ASSERT_EQUAL(size_t(3), symbols.size()); + CPPUNIT_ASSERT_DOUBLES_EQUAL(12.0, symbols[0].number, 1E-12); + CPPUNIT_ASSERT_EQUAL(SbxDOUBLE, symbols[0].type); + CPPUNIT_ASSERT_EQUAL(OUString("dE3"), symbols[1].text); + CPPUNIT_ASSERT_EQUAL(cr, symbols[2].text); + CPPUNIT_ASSERT_EQUAL(1u, static_cast<unsigned int>(errors)); + + symbols = getSymbols(source10, errors); + CPPUNIT_ASSERT_EQUAL(size_t(2), symbols.size()); + CPPUNIT_ASSERT_DOUBLES_EQUAL(12000.0, symbols[0].number, 1E-12); + CPPUNIT_ASSERT_EQUAL(SbxDOUBLE, symbols[0].type); + CPPUNIT_ASSERT_EQUAL(cr, symbols[1].text); + CPPUNIT_ASSERT_EQUAL(0u, static_cast<unsigned int>(errors)); + + symbols = getSymbols(source11, errors); + CPPUNIT_ASSERT_EQUAL(size_t(2), symbols.size()); + CPPUNIT_ASSERT_DOUBLES_EQUAL(12000.0, symbols[0].number, 1E-12); + CPPUNIT_ASSERT_EQUAL(SbxDOUBLE, symbols[0].type); + CPPUNIT_ASSERT_EQUAL(cr, symbols[1].text); + CPPUNIT_ASSERT_EQUAL(0u, static_cast<unsigned int>(errors)); + + symbols = getSymbols(source12, errors); + CPPUNIT_ASSERT_EQUAL(size_t(6), symbols.size()); + CPPUNIT_ASSERT_DOUBLES_EQUAL(12.0, symbols[0].number, 1E-12); + CPPUNIT_ASSERT_EQUAL(SbxDOUBLE, symbols[0].type); + CPPUNIT_ASSERT_EQUAL(OUString("e"), symbols[1].text); + CPPUNIT_ASSERT_EQUAL(OUString("+"), symbols[2].text); + CPPUNIT_ASSERT_EQUAL(OUString("+"), symbols[3].text); + CPPUNIT_ASSERT_DOUBLES_EQUAL(3.0, symbols[4].number, 1E-12); + CPPUNIT_ASSERT_EQUAL(SbxINTEGER, symbols[4].type); + CPPUNIT_ASSERT_EQUAL(cr, symbols[5].text); + CPPUNIT_ASSERT_EQUAL(1u, static_cast<unsigned int>(errors)); + + symbols = getSymbols(source13, errors); + CPPUNIT_ASSERT_EQUAL(size_t(2), symbols.size()); + CPPUNIT_ASSERT_DOUBLES_EQUAL(.012, symbols[0].number, 1E-12); + CPPUNIT_ASSERT_EQUAL(SbxDOUBLE, symbols[0].type); + CPPUNIT_ASSERT_EQUAL(cr, symbols[1].text); + CPPUNIT_ASSERT_EQUAL(0u, static_cast<unsigned int>(errors)); + + symbols = getSymbols(source14, errors); + CPPUNIT_ASSERT_EQUAL(size_t(3), symbols.size()); + CPPUNIT_ASSERT_DOUBLES_EQUAL(.012, symbols[0].number, 1E-12); + CPPUNIT_ASSERT_EQUAL(SbxDOUBLE, symbols[0].type); + CPPUNIT_ASSERT_EQUAL(OUString("+"), symbols[1].text); + CPPUNIT_ASSERT_EQUAL(cr, symbols[2].text); + CPPUNIT_ASSERT_EQUAL(0u, static_cast<unsigned int>(errors)); + + symbols = getSymbols(source15, errors); + CPPUNIT_ASSERT_EQUAL(size_t(6), symbols.size()); + CPPUNIT_ASSERT_DOUBLES_EQUAL(1.0, symbols[0].number, 1E-12); + CPPUNIT_ASSERT_EQUAL(SbxINTEGER, symbols[0].type); + CPPUNIT_ASSERT_EQUAL(OUString(","), symbols[1].text); + CPPUNIT_ASSERT_DOUBLES_EQUAL(2.0, symbols[2].number, 1E-12); + CPPUNIT_ASSERT_EQUAL(SbxINTEGER, symbols[2].type); + CPPUNIT_ASSERT_EQUAL(OUString(","), symbols[3].text); + CPPUNIT_ASSERT_DOUBLES_EQUAL(3.0, symbols[4].number, 1E-12); + CPPUNIT_ASSERT_EQUAL(SbxINTEGER, symbols[4].type); + CPPUNIT_ASSERT_EQUAL(cr, symbols[5].text); + CPPUNIT_ASSERT_EQUAL(0u, static_cast<unsigned int>(errors)); + + symbols = getSymbols(source16, errors); + CPPUNIT_ASSERT_EQUAL(size_t(2), symbols.size()); + CPPUNIT_ASSERT_DOUBLES_EQUAL(1.0, symbols[0].number, 1E-12); + CPPUNIT_ASSERT_EQUAL(SbxDOUBLE, symbols[0].type); + CPPUNIT_ASSERT_EQUAL(cr, symbols[1].text); + // This error is from a "buffer overflow" which is stupid because + // the buffer is artificially constrained by the scanner. + CPPUNIT_ASSERT_EQUAL(1u, static_cast<unsigned int>(errors)); // HACK + + double fInf = 0.0; + rtl::math::setInf( &fInf, false); + symbols = getSymbols(source17, errors); + CPPUNIT_ASSERT_EQUAL(size_t(2), symbols.size()); + CPPUNIT_ASSERT_EQUAL(fInf, symbols[0].number); + CPPUNIT_ASSERT_EQUAL(SbxDOUBLE, symbols[0].type); + CPPUNIT_ASSERT_EQUAL(cr, symbols[1].text); + CPPUNIT_ASSERT_EQUAL(1u, static_cast<unsigned int>(errors)); // math error, overflow + + // trailing data type character % = SbxINTEGER + symbols = getSymbols("1.23%"); + CPPUNIT_ASSERT_EQUAL(size_t(2), symbols.size()); + CPPUNIT_ASSERT_DOUBLES_EQUAL(1.23, symbols[0].number, 1E-12); + CPPUNIT_ASSERT_EQUAL(OUString(), symbols[0].text); + CPPUNIT_ASSERT_EQUAL(SbxINTEGER, symbols[0].type); + CPPUNIT_ASSERT_EQUAL(cr, symbols[1].text); + + // trailing data type character & = SbxLONG + symbols = getSymbols("1.23&"); + CPPUNIT_ASSERT_EQUAL(size_t(2), symbols.size()); + CPPUNIT_ASSERT_DOUBLES_EQUAL(1.23, symbols[0].number, 1E-12); + CPPUNIT_ASSERT_EQUAL(OUString(), symbols[0].text); + CPPUNIT_ASSERT_EQUAL(SbxLONG, symbols[0].type); + CPPUNIT_ASSERT_EQUAL(cr, symbols[1].text); + + // trailing data type character ! = SbxSINGLE + symbols = getSymbols("1.23!"); + CPPUNIT_ASSERT_EQUAL(size_t(2), symbols.size()); + CPPUNIT_ASSERT_DOUBLES_EQUAL(1.23, symbols[0].number, 1E-12); + CPPUNIT_ASSERT_EQUAL(OUString(), symbols[0].text); + CPPUNIT_ASSERT_EQUAL(SbxSINGLE, symbols[0].type); + CPPUNIT_ASSERT_EQUAL(cr, symbols[1].text); + + // trailing data type character # = SbxDOUBLE + symbols = getSymbols("1.23#"); + CPPUNIT_ASSERT_EQUAL(size_t(2), symbols.size()); + CPPUNIT_ASSERT_DOUBLES_EQUAL(1.23, symbols[0].number, 1E-12); + CPPUNIT_ASSERT_EQUAL(OUString(), symbols[0].text); + CPPUNIT_ASSERT_EQUAL(SbxDOUBLE, symbols[0].type); + CPPUNIT_ASSERT_EQUAL(cr, symbols[1].text); + + // trailing data type character @ = SbxCURRENCY + symbols = getSymbols("1.23@"); + CPPUNIT_ASSERT_EQUAL(size_t(2), symbols.size()); + CPPUNIT_ASSERT_DOUBLES_EQUAL(1.23, symbols[0].number, 1E-12); + CPPUNIT_ASSERT_EQUAL(OUString(), symbols[0].text); + CPPUNIT_ASSERT_EQUAL(SbxCURRENCY, symbols[0].type); + CPPUNIT_ASSERT_EQUAL(cr, symbols[1].text); + + // trailing data type character $ = SbxSTRING + symbols = getSymbols("1.23$", errors); + CPPUNIT_ASSERT_EQUAL(size_t(2), symbols.size()); + CPPUNIT_ASSERT_DOUBLES_EQUAL(1.23, symbols[0].number, 1E-12); + CPPUNIT_ASSERT_EQUAL(OUString(), symbols[0].text); + CPPUNIT_ASSERT_EQUAL(SbxSTRING, symbols[0].type); + CPPUNIT_ASSERT_EQUAL(cr, symbols[1].text); + // ERRCODE_BASIC_SYNTAX + CPPUNIT_ASSERT_EQUAL(1u, static_cast<unsigned int>(errors)); + } + + void ScannerTest::testDataType() + { + const OUString source1("asdf%"); + const OUString source2("asdf&"); + const OUString source3("asdf!"); + const OUString source4("asdf#"); + const OUString source5("asdf@"); + const OUString source6("asdf$"); + const OUString source7("asdf "); + + std::vector<Symbol> symbols; + + symbols = getSymbols(source1); + CPPUNIT_ASSERT_EQUAL(size_t(2), symbols.size()); + CPPUNIT_ASSERT_EQUAL(SbxINTEGER, symbols[0].type); + CPPUNIT_ASSERT_EQUAL(cr, symbols[1].text); + + symbols = getSymbols(source2); + CPPUNIT_ASSERT_EQUAL(size_t(2), symbols.size()); + CPPUNIT_ASSERT_EQUAL(SbxLONG, symbols[0].type); + CPPUNIT_ASSERT_EQUAL(cr, symbols[1].text); + + symbols = getSymbols(source3); + CPPUNIT_ASSERT_EQUAL(size_t(2), symbols.size()); + CPPUNIT_ASSERT_EQUAL(SbxSINGLE, symbols[0].type); + CPPUNIT_ASSERT_EQUAL(cr, symbols[1].text); + + symbols = getSymbols(source4); + CPPUNIT_ASSERT_EQUAL(size_t(2), symbols.size()); + CPPUNIT_ASSERT_EQUAL(SbxDOUBLE, symbols[0].type); + CPPUNIT_ASSERT_EQUAL(cr, symbols[1].text); + + symbols = getSymbols(source5); + CPPUNIT_ASSERT_EQUAL(size_t(2), symbols.size()); + CPPUNIT_ASSERT_EQUAL(SbxCURRENCY, symbols[0].type); + CPPUNIT_ASSERT_EQUAL(cr, symbols[1].text); + + symbols = getSymbols(source6); + CPPUNIT_ASSERT_EQUAL(size_t(2), symbols.size()); + CPPUNIT_ASSERT_EQUAL(SbxSTRING, symbols[0].type); + CPPUNIT_ASSERT_EQUAL(cr, symbols[1].text); + + symbols = getSymbols(source7); + CPPUNIT_ASSERT_EQUAL(size_t(2), symbols.size()); + CPPUNIT_ASSERT_EQUAL(SbxVARIANT, symbols[0].type); + CPPUNIT_ASSERT_EQUAL(cr, symbols[1].text); + } + + void ScannerTest::testHexOctal() + { + const OUString source1("&HA"); + const OUString source2("&HASDF"); + const OUString source3("&H10"); + const OUString source4("&&H&1H1&H1"); + const OUString source5("&O&O12"); + const OUString source6("&O10"); + const OUString source7("&HO"); + const OUString source8("&O123000000000000000000000"); + const OUString source9("&H1.23"); + + sal_Int32 errors; + std::vector<Symbol> symbols; + + symbols = getSymbols(source1); + CPPUNIT_ASSERT_EQUAL(size_t(2), symbols.size()); + CPPUNIT_ASSERT_DOUBLES_EQUAL(10.0, symbols[0].number, 1E-12); + CPPUNIT_ASSERT_EQUAL(OUString(), symbols[0].text); + CPPUNIT_ASSERT_EQUAL(SbxINTEGER, symbols[0].type); + CPPUNIT_ASSERT_EQUAL(cr, symbols[1].text); + + symbols = getSymbols(source2); + CPPUNIT_ASSERT_EQUAL(size_t(2), symbols.size()); + CPPUNIT_ASSERT_DOUBLES_EQUAL(2783.0, symbols[0].number, 1E-12); + CPPUNIT_ASSERT_EQUAL(OUString(), symbols[0].text); + CPPUNIT_ASSERT_EQUAL(SbxINTEGER, symbols[0].type); + CPPUNIT_ASSERT_EQUAL(cr, symbols[1].text); + + symbols = getSymbols(source3); + CPPUNIT_ASSERT_EQUAL(size_t(2), symbols.size()); + CPPUNIT_ASSERT_DOUBLES_EQUAL(16.0, symbols[0].number, 1E-12); + CPPUNIT_ASSERT_EQUAL(OUString(), symbols[0].text); + CPPUNIT_ASSERT_EQUAL(SbxINTEGER, symbols[0].type); + CPPUNIT_ASSERT_EQUAL(cr, symbols[1].text); + + symbols = getSymbols(source4); + CPPUNIT_ASSERT_EQUAL(size_t(6), symbols.size()); + CPPUNIT_ASSERT_DOUBLES_EQUAL(0.0, symbols[0].number, 1E-12); + CPPUNIT_ASSERT_EQUAL(OUString("&"), symbols[0].text); + CPPUNIT_ASSERT_EQUAL(SbxVARIANT, symbols[0].type); + CPPUNIT_ASSERT_DOUBLES_EQUAL(0.0, symbols[1].number, 1E-12); + CPPUNIT_ASSERT_EQUAL(OUString(), symbols[1].text); + CPPUNIT_ASSERT_EQUAL(SbxLONG, symbols[1].type); + CPPUNIT_ASSERT_DOUBLES_EQUAL(1.0, symbols[2].number, 1E-12); + CPPUNIT_ASSERT_EQUAL(OUString(), symbols[2].text); + CPPUNIT_ASSERT_EQUAL(SbxINTEGER, symbols[2].type); + CPPUNIT_ASSERT_DOUBLES_EQUAL(1.0, symbols[3].number, 1E-12); + CPPUNIT_ASSERT_EQUAL(OUString("H1"), symbols[3].text); + CPPUNIT_ASSERT_EQUAL(SbxLONG, symbols[3].type); + CPPUNIT_ASSERT_DOUBLES_EQUAL(1.0, symbols[4].number, 1E-12); + CPPUNIT_ASSERT_EQUAL(OUString("H1"), symbols[4].text); + CPPUNIT_ASSERT_EQUAL(SbxVARIANT, symbols[4].type); + CPPUNIT_ASSERT_EQUAL(cr, symbols[5].text); + + symbols = getSymbols(source5); + CPPUNIT_ASSERT_EQUAL(size_t(3), symbols.size()); + CPPUNIT_ASSERT_DOUBLES_EQUAL(0.0, symbols[0].number, 1E-12); + CPPUNIT_ASSERT_EQUAL(OUString(), symbols[0].text); + CPPUNIT_ASSERT_EQUAL(SbxLONG, symbols[0].type); + CPPUNIT_ASSERT_DOUBLES_EQUAL(0.0, symbols[1].number, 1E-12); + CPPUNIT_ASSERT_EQUAL(OUString("O12"), symbols[1].text); + CPPUNIT_ASSERT_EQUAL(SbxVARIANT, symbols[1].type); + CPPUNIT_ASSERT_EQUAL(cr, symbols[2].text); + + symbols = getSymbols(source6); + CPPUNIT_ASSERT_EQUAL(size_t(2), symbols.size()); + CPPUNIT_ASSERT_DOUBLES_EQUAL(8.0, symbols[0].number, 1E-12); + CPPUNIT_ASSERT_EQUAL(OUString(), symbols[0].text); + CPPUNIT_ASSERT_EQUAL(SbxINTEGER, symbols[0].type); + CPPUNIT_ASSERT_EQUAL(cr, symbols[1].text); + + symbols = getSymbols(source7); + CPPUNIT_ASSERT_EQUAL(size_t(2), symbols.size()); + CPPUNIT_ASSERT_DOUBLES_EQUAL(0.0, symbols[0].number, 1E-12); + CPPUNIT_ASSERT_EQUAL(OUString(), symbols[0].text); + CPPUNIT_ASSERT_EQUAL(cr, symbols[1].text); + + symbols = getSymbols(source8); + CPPUNIT_ASSERT_EQUAL(size_t(2), symbols.size()); + // TODO: this line fails on 64 bit systems!!! + // CPPUNIT_ASSERT_EQUAL(symbols[0].number, -1744830464); + CPPUNIT_ASSERT_EQUAL(OUString(), symbols[0].text); + CPPUNIT_ASSERT_EQUAL(cr, symbols[1].text); + + symbols = getSymbols(source9); + CPPUNIT_ASSERT_EQUAL(size_t(3), symbols.size()); + CPPUNIT_ASSERT_EQUAL(OUString(), symbols[0].text); + CPPUNIT_ASSERT_DOUBLES_EQUAL(1.0, symbols[0].number, 1E-12); + CPPUNIT_ASSERT_EQUAL(SbxINTEGER, symbols[0].type); + CPPUNIT_ASSERT_DOUBLES_EQUAL(.23, symbols[1].number, 1E-12); + CPPUNIT_ASSERT_EQUAL(OUString(), symbols[1].text); + CPPUNIT_ASSERT_EQUAL(SbxDOUBLE, symbols[1].type); + CPPUNIT_ASSERT_EQUAL(cr, symbols[2].text); + + /* tdf#62323, tdf#62326 - conversion of Hex literals to basic signed Integers */ + + // &H0 = 0 + symbols = getSymbols("&H0"); + CPPUNIT_ASSERT_EQUAL(size_t(2), symbols.size()); + CPPUNIT_ASSERT_DOUBLES_EQUAL(0.0, symbols[0].number, 1E-12); + CPPUNIT_ASSERT_EQUAL(OUString(), symbols[0].text); + CPPUNIT_ASSERT_EQUAL(SbxINTEGER, symbols[0].type); + CPPUNIT_ASSERT_EQUAL(cr, symbols[1].text); + + // &H8000 = -32768 + symbols = getSymbols("&H8000"); + CPPUNIT_ASSERT_EQUAL(size_t(2), symbols.size()); + CPPUNIT_ASSERT_DOUBLES_EQUAL(SbxMININT, symbols[0].number, 1E-12); + CPPUNIT_ASSERT_EQUAL(OUString(), symbols[0].text); + CPPUNIT_ASSERT_EQUAL(SbxINTEGER, symbols[0].type); + CPPUNIT_ASSERT_EQUAL(cr, symbols[1].text); + + // &H80000000 = -2147483648 + symbols = getSymbols("&H80000000"); + CPPUNIT_ASSERT_EQUAL(size_t(2), symbols.size()); + CPPUNIT_ASSERT_DOUBLES_EQUAL(SbxMINLNG, symbols[0].number, 1E-12); + CPPUNIT_ASSERT_EQUAL(OUString(), symbols[0].text); + CPPUNIT_ASSERT_EQUAL(SbxLONG, symbols[0].type); + CPPUNIT_ASSERT_EQUAL(cr, symbols[1].text); + + // &HFFFF = -1 + symbols = getSymbols("&HFFFF"); + CPPUNIT_ASSERT_EQUAL(size_t(2), symbols.size()); + CPPUNIT_ASSERT_DOUBLES_EQUAL(-1.0, symbols[0].number, 1E-12); + CPPUNIT_ASSERT_EQUAL(OUString(), symbols[0].text); + CPPUNIT_ASSERT_EQUAL(SbxINTEGER, symbols[0].type); + CPPUNIT_ASSERT_EQUAL(cr, symbols[1].text); + + // &HFFFFFFFF = -1 + symbols = getSymbols("&HFFFFFFFF"); + CPPUNIT_ASSERT_EQUAL(size_t(2), symbols.size()); + CPPUNIT_ASSERT_DOUBLES_EQUAL(-1.0, symbols[0].number, 1E-12); + CPPUNIT_ASSERT_EQUAL(OUString(), symbols[0].text); + CPPUNIT_ASSERT_EQUAL(SbxINTEGER, symbols[0].type); + CPPUNIT_ASSERT_EQUAL(cr, symbols[1].text); + + // &H7FFF = 32767 + symbols = getSymbols("&H7FFF"); + CPPUNIT_ASSERT_EQUAL(size_t(2), symbols.size()); + CPPUNIT_ASSERT_DOUBLES_EQUAL(SbxMAXINT, symbols[0].number, 1E-12); + CPPUNIT_ASSERT_EQUAL(OUString(), symbols[0].text); + CPPUNIT_ASSERT_EQUAL(SbxINTEGER, symbols[0].type); + CPPUNIT_ASSERT_EQUAL(cr, symbols[1].text); + + // &H7FFFFFFF = 2147483647 + symbols = getSymbols("&H7FFFFFFF"); + CPPUNIT_ASSERT_EQUAL(size_t(2), symbols.size()); + CPPUNIT_ASSERT_DOUBLES_EQUAL(SbxMAXLNG, symbols[0].number, 1E-12); + CPPUNIT_ASSERT_EQUAL(OUString(), symbols[0].text); + CPPUNIT_ASSERT_EQUAL(SbxLONG, symbols[0].type); + CPPUNIT_ASSERT_EQUAL(cr, symbols[1].text); + + /* tdf#130476 - trailing data type characters */ + + // % = SbxINTEGER + symbols = getSymbols("&H0%"); + CPPUNIT_ASSERT_EQUAL(size_t(2), symbols.size()); + CPPUNIT_ASSERT_DOUBLES_EQUAL(0.0, symbols[0].number, 1E-12); + CPPUNIT_ASSERT_EQUAL(OUString(), symbols[0].text); + CPPUNIT_ASSERT_EQUAL(SbxINTEGER, symbols[0].type); + CPPUNIT_ASSERT_EQUAL(cr, symbols[1].text); + + // & = SbxLONG + symbols = getSymbols("&H0&"); + CPPUNIT_ASSERT_EQUAL(size_t(2), symbols.size()); + CPPUNIT_ASSERT_DOUBLES_EQUAL(0.0, symbols[0].number, 1E-12); + CPPUNIT_ASSERT_EQUAL(OUString(), symbols[0].text); + CPPUNIT_ASSERT_EQUAL(SbxLONG, symbols[0].type); + CPPUNIT_ASSERT_EQUAL(cr, symbols[1].text); + + // ! = SbxSINGLE + symbols = getSymbols("&H0!"); + CPPUNIT_ASSERT_EQUAL(size_t(2), symbols.size()); + CPPUNIT_ASSERT_DOUBLES_EQUAL(0.0, symbols[0].number, 1E-12); + CPPUNIT_ASSERT_EQUAL(OUString(), symbols[0].text); + CPPUNIT_ASSERT_EQUAL(SbxSINGLE, symbols[0].type); + CPPUNIT_ASSERT_EQUAL(cr, symbols[1].text); + + // # = SbxDOUBLE + symbols = getSymbols("&H0#"); + CPPUNIT_ASSERT_EQUAL(size_t(2), symbols.size()); + CPPUNIT_ASSERT_DOUBLES_EQUAL(0.0, symbols[0].number, 1E-12); + CPPUNIT_ASSERT_EQUAL(OUString(), symbols[0].text); + CPPUNIT_ASSERT_EQUAL(SbxDOUBLE, symbols[0].type); + CPPUNIT_ASSERT_EQUAL(cr, symbols[1].text); + + // @ = SbxCURRENCY + symbols = getSymbols("&H0@"); + CPPUNIT_ASSERT_EQUAL(size_t(2), symbols.size()); + CPPUNIT_ASSERT_DOUBLES_EQUAL(0.0, symbols[0].number, 1E-12); + CPPUNIT_ASSERT_EQUAL(OUString(), symbols[0].text); + CPPUNIT_ASSERT_EQUAL(SbxCURRENCY, symbols[0].type); + CPPUNIT_ASSERT_EQUAL(cr, symbols[1].text); + + // $ = SbxSTRING + symbols = getSymbols("&H0$", errors); + CPPUNIT_ASSERT_EQUAL(size_t(2), symbols.size()); + CPPUNIT_ASSERT_DOUBLES_EQUAL(0.0, symbols[0].number, 1E-12); + CPPUNIT_ASSERT_EQUAL(OUString(), symbols[0].text); + CPPUNIT_ASSERT_EQUAL(SbxSTRING, symbols[0].type); + CPPUNIT_ASSERT_EQUAL(cr, symbols[1].text); + // ERRCODE_BASIC_SYNTAX + CPPUNIT_ASSERT_EQUAL(1u, static_cast<unsigned int>(errors)); + + // % = SbxINTEGER + symbols = getSymbols("&O0%"); + CPPUNIT_ASSERT_EQUAL(size_t(2), symbols.size()); + CPPUNIT_ASSERT_DOUBLES_EQUAL(0.0, symbols[0].number, 1E-12); + CPPUNIT_ASSERT_EQUAL(OUString(), symbols[0].text); + CPPUNIT_ASSERT_EQUAL(SbxINTEGER, symbols[0].type); + CPPUNIT_ASSERT_EQUAL(cr, symbols[1].text); + + // & = SbxLONG + symbols = getSymbols("&O0&"); + CPPUNIT_ASSERT_EQUAL(size_t(2), symbols.size()); + CPPUNIT_ASSERT_DOUBLES_EQUAL(0.0, symbols[0].number, 1E-12); + CPPUNIT_ASSERT_EQUAL(OUString(), symbols[0].text); + CPPUNIT_ASSERT_EQUAL(SbxLONG, symbols[0].type); + CPPUNIT_ASSERT_EQUAL(cr, symbols[1].text); + + // ! = SbxSINGLE + symbols = getSymbols("&O0!"); + CPPUNIT_ASSERT_EQUAL(size_t(2), symbols.size()); + CPPUNIT_ASSERT_DOUBLES_EQUAL(0.0, symbols[0].number, 1E-12); + CPPUNIT_ASSERT_EQUAL(OUString(), symbols[0].text); + CPPUNIT_ASSERT_EQUAL(SbxSINGLE, symbols[0].type); + CPPUNIT_ASSERT_EQUAL(cr, symbols[1].text); + + // # = SbxDOUBLE + symbols = getSymbols("&O0#"); + CPPUNIT_ASSERT_EQUAL(size_t(2), symbols.size()); + CPPUNIT_ASSERT_DOUBLES_EQUAL(0.0, symbols[0].number, 1E-12); + CPPUNIT_ASSERT_EQUAL(OUString(), symbols[0].text); + CPPUNIT_ASSERT_EQUAL(SbxDOUBLE, symbols[0].type); + CPPUNIT_ASSERT_EQUAL(cr, symbols[1].text); + + // @ = SbxCURRENCY + symbols = getSymbols("&O0@"); + CPPUNIT_ASSERT_EQUAL(size_t(2), symbols.size()); + CPPUNIT_ASSERT_DOUBLES_EQUAL(0.0, symbols[0].number, 1E-12); + CPPUNIT_ASSERT_EQUAL(OUString(), symbols[0].text); + CPPUNIT_ASSERT_EQUAL(SbxCURRENCY, symbols[0].type); + CPPUNIT_ASSERT_EQUAL(cr, symbols[1].text); + + // $ = SbxSTRING + symbols = getSymbols("&O0$", errors); + CPPUNIT_ASSERT_EQUAL(size_t(2), symbols.size()); + CPPUNIT_ASSERT_DOUBLES_EQUAL(0.0, symbols[0].number, 1E-12); + CPPUNIT_ASSERT_EQUAL(OUString(), symbols[0].text); + CPPUNIT_ASSERT_EQUAL(SbxSTRING, symbols[0].type); + CPPUNIT_ASSERT_EQUAL(cr, symbols[1].text); + // ERRCODE_BASIC_SYNTAX + CPPUNIT_ASSERT_EQUAL(1u, static_cast<unsigned int>(errors)); + + // maximum for Hex % = SbxINTEGER + symbols = getSymbols("&HFFFF%"); + CPPUNIT_ASSERT_EQUAL(size_t(2), symbols.size()); + CPPUNIT_ASSERT_DOUBLES_EQUAL(-1.0, symbols[0].number, 1E-12); + CPPUNIT_ASSERT_EQUAL(OUString(), symbols[0].text); + CPPUNIT_ASSERT_EQUAL(SbxINTEGER, symbols[0].type); + CPPUNIT_ASSERT_EQUAL(cr, symbols[1].text); + + // overflow for Hex % = SbxINTEGER + symbols = getSymbols("&H10000%", errors); + CPPUNIT_ASSERT_EQUAL(size_t(2), symbols.size()); + CPPUNIT_ASSERT_DOUBLES_EQUAL(0, symbols[0].number, 1E-12); + CPPUNIT_ASSERT_EQUAL(OUString(), symbols[0].text); + CPPUNIT_ASSERT_EQUAL(SbxINTEGER, symbols[0].type); + CPPUNIT_ASSERT_EQUAL(cr, symbols[1].text); + // ERRCODE_BASIC_MATH_OVERFLOW + CPPUNIT_ASSERT_EQUAL(1u, static_cast<unsigned int>(errors)); + + // maximum for Octal % = SbxINTEGER + symbols = getSymbols("&O177777%"); + CPPUNIT_ASSERT_EQUAL(size_t(2), symbols.size()); + CPPUNIT_ASSERT_DOUBLES_EQUAL(-1.0, symbols[0].number, 1E-12); + CPPUNIT_ASSERT_EQUAL(OUString(), symbols[0].text); + CPPUNIT_ASSERT_EQUAL(SbxINTEGER, symbols[0].type); + CPPUNIT_ASSERT_EQUAL(cr, symbols[1].text); + + // overflow for Octal % = SbxINTEGER + symbols = getSymbols("&O200000%", errors); + CPPUNIT_ASSERT_EQUAL(size_t(2), symbols.size()); + CPPUNIT_ASSERT_DOUBLES_EQUAL(0, symbols[0].number, 1E-12); + CPPUNIT_ASSERT_EQUAL(OUString(), symbols[0].text); + CPPUNIT_ASSERT_EQUAL(SbxINTEGER, symbols[0].type); + CPPUNIT_ASSERT_EQUAL(cr, symbols[1].text); + // ERRCODE_BASIC_MATH_OVERFLOW + CPPUNIT_ASSERT_EQUAL(1u, static_cast<unsigned int>(errors)); + } + + void ScannerTest::testTdf103104() + { + const OUString source1("asdf _\n asdf"); + const OUString source2("asdf. _\n asdf"); + const OUString source3("asdf _\n .asdf"); + + std::vector<Symbol> symbols; + + symbols = getSymbols(source1); + CPPUNIT_ASSERT_EQUAL(size_t(3), symbols.size()); + CPPUNIT_ASSERT_EQUAL(asdf, symbols[0].text); + CPPUNIT_ASSERT_EQUAL(asdf, symbols[1].text); + CPPUNIT_ASSERT(symbols[1].ws); + CPPUNIT_ASSERT_EQUAL(cr, symbols[2].text); + + symbols = getSymbols(source2); + CPPUNIT_ASSERT_EQUAL(size_t(4), symbols.size()); + CPPUNIT_ASSERT_EQUAL(asdf, symbols[0].text); + CPPUNIT_ASSERT_EQUAL(dot, symbols[1].text); + CPPUNIT_ASSERT(!symbols[1].ws); + CPPUNIT_ASSERT_EQUAL(asdf, symbols[2].text); + CPPUNIT_ASSERT(symbols[2].ws); + CPPUNIT_ASSERT_EQUAL(cr, symbols[3].text); + + symbols = getSymbols(source3); + CPPUNIT_ASSERT_EQUAL(size_t(4), symbols.size()); + CPPUNIT_ASSERT_EQUAL(asdf, symbols[0].text); + CPPUNIT_ASSERT_EQUAL(dot, symbols[1].text); + CPPUNIT_ASSERT(!symbols[1].ws); + CPPUNIT_ASSERT_EQUAL(asdf, symbols[2].text); + CPPUNIT_ASSERT(!symbols[2].ws); + CPPUNIT_ASSERT_EQUAL(cr, symbols[3].text); + } + + void ScannerTest::testTdf136032() + { + std::vector<Symbol> symbols; + sal_Int32 errors; + + // tdf#136032 - abort scan of a string beginning with a hashtag, + // if a comma/whitespace is found. Otherwise, the compiler raises a syntax error. + symbols = getSymbols("Print #i,\"A#B\"", errors); + CPPUNIT_ASSERT_EQUAL(size_t(5), symbols.size()); + CPPUNIT_ASSERT_EQUAL(0u, static_cast<unsigned int>(errors)); + symbols = getSymbols("Print #i, \"A#B\"", errors); + CPPUNIT_ASSERT_EQUAL(size_t(5), symbols.size()); + CPPUNIT_ASSERT_EQUAL(0u, static_cast<unsigned int>(errors)); + } + + // Put the test suite in the registry + CPPUNIT_TEST_SUITE_REGISTRATION(ScannerTest); +} // namespace +CPPUNIT_PLUGIN_IMPLEMENT(); + +/* vim:set shiftwidth=4 softtabstop=4 expandtab: */ diff --git a/basic/qa/cppunit/test_vba.cxx b/basic/qa/cppunit/test_vba.cxx new file mode 100644 index 000000000..235bcc2cf --- /dev/null +++ b/basic/qa/cppunit/test_vba.cxx @@ -0,0 +1,256 @@ +/* -*- Mode: C++; tab-width: 4; indent-tabs-mode: nil; c-basic-offset: 4 -*- */ +/* + * 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/. + */ +#include "basictest.hxx" +#include <unotools/syslocaleoptions.hxx> + +#ifdef _WIN32 +#include <string.h> +#include <comphelper/processfactory.hxx> +#include <o3tl/char16_t2wchar_t.hxx> + +#if !defined WIN32_LEAN_AND_MEAN +# define WIN32_LEAN_AND_MEAN +#endif +#include <windows.h> +#include <odbcinst.h> +#endif + +using namespace ::com::sun::star; + +namespace +{ + class VBATest : public test::BootstrapFixture + { + public: + VBATest() : BootstrapFixture(true, false) {} + void testMiscVBAFunctions(); + void testMiscOLEStuff(); + // Adds code needed to register the test suite + CPPUNIT_TEST_SUITE(VBATest); + + // Declares the method as a test to call + CPPUNIT_TEST(testMiscVBAFunctions); + CPPUNIT_TEST(testMiscOLEStuff); + + // End of test suite definition + CPPUNIT_TEST_SUITE_END(); + + }; + +void VBATest::testMiscVBAFunctions() +{ + const char* macroSource[] = { + "bytearraystring.vb", +#ifdef _WIN32 + "cdec.vb", // currently CDec is implemented only on Windows +#endif + "constants.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", + "chr.vb", + "abs.vb", + "array.vb", + "asc.vb", + "atn.vb", + "cbool.vb", + "cdate.vb", + "cdbl.vb", + "choose.vb", + "cos.vb", + "cint.vb", + "clng.vb", + "csng.vb", + "cstr.vb", + "cvdate.vb", + "cverr.vb", + "dateadd.vb", + "datediff.vb", + "datepart.vb", + "day.vb", + "enum.vb", + "error.vb", + "Err.Raise.vb", + "exp.vb", + "fix.vb", + "hex.vb", + "hour.vb", + "formatnumber.vb", + "iif.vb", + "instr.vb", + "instrrev.vb", + "int.vb", + "iserror.vb", + "ismissing.vb", + "isnull.vb", + "isobject.vb", + "join.vb", + "lbound.vb", + "isarray.vb", + "isdate.vb", + "isempty.vb", + "isnumeric.vb", + "lcase.vb", + "left.vb", + "len.vb", + "log.vb", + "ltrim.vb", + "mid.vb", + "minute.vb", + "month.vb", + "monthname.vb", + "oct.vb", + "optional_paramters.vb", + "qbcolor.vb", + "rgb.vb", + "rtrim.vb", + "right.vb", + "second.vb", + "sgn.vb", + "sin.vb", + "space.vb", + "sqr.vb", + "str.vb", + "strcomp.vb", + "string.vb", + "strreverse.vb", + "switch.vb", + "timeserial.vb", + "timevalue.vb", + "trim.vb", + "typename.vb", + "ubound.vb", + "ucase.vb", + "val.vb", + "vartype.vb", + "weekday.vb", + "weekdayname.vb", + "year.vb", +#ifndef _WIN32 // missing 64bit Currency marshalling. + "win32compat.vb", // windows compatibility hooks. +#endif + "win32compatb.vb" // same methods, different signatures. + }; + OUString sMacroPathURL = m_directories.getURLFromSrc("/basic/qa/vba_tests/"); + // Some test data expects the uk locale + LanguageTag aLocale(LANGUAGE_ENGLISH_UK); + SvtSysLocaleOptions aLocalOptions; + aLocalOptions.SetLocaleConfigString( aLocale.getBcp47() ); + + for ( size_t i=0; i<SAL_N_ELEMENTS( macroSource ); ++i ) + { + OUString sMacroURL = sMacroPathURL + + OUString::createFromAscii( macroSource[ i ] ); + + MacroSnippet myMacro; + myMacro.LoadSourceFromFile( sMacroURL ); + SbxVariableRef pReturn = myMacro.Run(); + CPPUNIT_ASSERT_MESSAGE("No return variable huh?", pReturn.is()); + 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_EQUAL_MESSAGE("Result not as expected", OUString("OK"), + pReturn->GetOUString()); + } +} + +void VBATest::testMiscOLEStuff() +{ +// Not much point even trying to run except on Windows. +// (Without Excel doesn't really do anything anyway, +// see "so skip test" below.) + +// Since some time, on a properly updated Windows 10, this works +// only with a 64-bit LibreOffice + +#if defined(_WIN64) + // test if we have the necessary runtime environment + // to run the OLE tests. + uno::Reference< lang::XMultiServiceFactory > xOLEFactory; + uno::Reference< uno::XComponentContext > xContext( + comphelper::getProcessComponentContext() ); + if( xContext.is() ) + { + uno::Reference<lang::XMultiComponentFactory> xSMgr = xContext->getServiceManager(); + xOLEFactory.set( xSMgr->createInstanceWithContext( "com.sun.star.bridge.OleObjectFactory", xContext ), + uno::UNO_QUERY ); + } + bool bOk = false; + if( xOLEFactory.is() ) + { + uno::Reference< uno::XInterface > xADODB = xOLEFactory->createInstance( "ADODB.Connection" ); + bOk = xADODB.is(); + } + if ( !bOk ) + return; // can't do anything, skip test + + const int nBufSize = 1024 * 4; + wchar_t sBuf[nBufSize]; + SQLGetInstalledDriversW( sBuf, nBufSize, nullptr ); + + const wchar_t *pODBCDriverName = sBuf; + bool bFound = false; + for (; wcslen( pODBCDriverName ) != 0; pODBCDriverName += wcslen( pODBCDriverName ) + 1 ) { + if( wcscmp( pODBCDriverName, L"Microsoft Excel Driver (*.xls)" ) == 0 || + wcscmp( pODBCDriverName, L"Microsoft Excel Driver (*.xls, *.xlsx, *.xlsm, *.xlsb)" ) == 0 ) { + bFound = true; + break; + } + } + if ( !bFound ) + return; // can't find ODBC driver needed test, so skip test + + const char* macroSource[] = { + "ole_ObjAssignNoDflt.vb", + "ole_ObjAssignToNothing.vb", + }; + + OUString sMacroPathURL = m_directories.getURLFromSrc("/basic/qa/vba_tests/"); + + uno::Sequence< uno::Any > aArgs(2); + // path to test document + OUString sPath = m_directories.getPathFromSrc("/basic/qa/vba_tests/data/ADODBdata.xls"); + sPath = sPath.replaceAll( "/", "\\" ); + + aArgs[ 0 ] <<= sPath; + aArgs[ 1 ] <<= OUString(o3tl::toU(pODBCDriverName)); + + for ( sal_uInt32 i=0; i<SAL_N_ELEMENTS( macroSource ); ++i ) + { + OUString sMacroURL = sMacroPathURL + + OUString::createFromAscii( macroSource[ i ] ); + MacroSnippet myMacro; + myMacro.LoadSourceFromFile( sMacroURL ); + SbxVariableRef pReturn = myMacro.Run( aArgs ); + CPPUNIT_ASSERT_MESSAGE("No return variable huh?", pReturn.is()); + 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_EQUAL_MESSAGE("Result not as expected", OUString("OK"), + pReturn->GetOUString()); + } +#else + // Avoid "this method is empty and should be removed" warning + (void) 42; +#endif +} + + // Put the test suite in the registry + CPPUNIT_TEST_SUITE_REGISTRATION(VBATest); +} + +/* vim:set shiftwidth=4 softtabstop=4 expandtab: */ diff --git a/basic/qa/vba_tests/Err.Raise.vb b/basic/qa/vba_tests/Err.Raise.vb new file mode 100644 index 000000000..fa04856cc --- /dev/null +++ b/basic/qa/vba_tests/Err.Raise.vb @@ -0,0 +1,86 @@ +' +' 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/. +' + +Option VBASupport 1 +Option Explicit +Dim passCount As Integer +Dim failCount As Integer +Dim result As String + +Function doUnitTest() + ''' This routine is QA/…/test_vba.cxx main entry point ''' + passCount = 0 : failCount = 0 + Const MIN_ERR = &hFFFFFFFF : Const MAX_ERR = 2^31-1 + + ''' Raise one-to-many User-Defined Errors as signed Int32 ''' + result = "Test Results" & vbNewLine & "============" & vbNewLine + ' test_Description | Err # | Err_Source | Err_Description + Call TestErrRaise("MAXimum error value", MAX_ERR, "doUnitTest.vb", "Custom Error Maximum value") + Call TestErrRaise("Positive custom error", 1789, "" , "User-Defined Error Number") + Call TestErrRaise("Negative custom error", -1793, "doUnitTest.vb", "Negative User-Defined Error Number") + Call TestErrRaise("MINimum error value", MIN_ERR, "" , "Custom Error Minimum value") + + If failCount <> 0 Or passCount = 0 Then + doUnitTest = result + Else + doUnitTest = "OK" + End If +End Function + +Sub TestErrRaise(TestName As String, CurErrNo As Long, CurErrSource As String, CurErrDescription As String) + result = result & vbNewLine & TestName + Dim origPassCount As Integer, origFailCount As Integer + origPassCount = passCount + origFailCount = failCount + +try: On Error Goto catch + Err.Raise(CurErrNo, CurErrSource, CurErrDescription, "", "") + + 'result = result & vbNewLine & "Testing after error handler" + TestLog_ASSERT (passCount + failCount) > (origPassCount + origFailCount), TestName, "error handler did not execute!" + TestLog_ASSERT Erl = 0, TestName, "Erl = " & Erl + TestLog_ASSERT Err = 0, TestName, "Err = " & Err + TestLog_ASSERT Error = "", TestName, "Error = " & Error + TestLog_ASSERT Err.Description = "", "Err.Description reset", "Err.Description = "& Err.Description + TestLog_ASSERT Err.Number = 0, "Err.Number reset", "Err.Number = " & Err.Number + TestLog_ASSERT Err.Source = "", "Err.Source reset", "Err.Source = " & Err.Source + Exit Sub + +catch: + 'result = result & vbNewLine & "Testing in error handler" + TestLog_ASSERT Err.Number = CurErrNo, "Err.Number failure", "Err.Number = " & Err.Number + TestLog_ASSERT Err.Source = CurErrSource, "Err.Source failure", "Err.Source = " & Err.Source + TestLog_ASSERT Err.Description = CurErrDescription, "Err.Description failure", "Err.Description = " & Err.Description + + TestLog_ASSERT Erl = 42, "line# failure", "Erl = " & Erl ' WATCH OUT for HARDCODED LINE # HERE ! + TestLog_ASSERT Err = CurErrNo, "Err# failure", "Err = " & Err + TestLog_ASSERT Error = CurErrDescription, "Error description failure", "Error$ = " & Error$ + + Resume Next ' Err object properties reset from here … +End Sub + +Sub DEV_TEST : doUnitTest : MsgBox result : 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 & vbNewLine & "Failed: " & testMsg + failCount = failCount + 1 + End If + +End Sub diff --git a/basic/qa/vba_tests/abs.vb b/basic/qa/vba_tests/abs.vb new file mode 100644 index 000000000..bc9516fb6 --- /dev/null +++ b/basic/qa/vba_tests/abs.vb @@ -0,0 +1,70 @@ +Rem Attribute VBA_ModuleType=VBAModule +Option VBASupport 1 +Option Explicit +Dim passCount As Integer +Dim failCount As Integer +Dim result As String + +Function doUnitTest() As String +result = verify_testABS() +If failCount <> 0 Or passCount = 0 Then + doUnitTest = result +Else + doUnitTest = "OK" +End If +End Function + + + +Function verify_testABS() As String + + passCount = 0 + failCount = 0 + + result = "Test Results" & Chr$(10) & "============" & Chr$(10) + + Dim testName As String + Dim nr1, nr2 As Double + + testName = "Test ABS function" + On Error GoTo errorHandler + + nr2 = 5 + nr1 = Abs(-5) + TestLog_ASSERT nr1 = nr2, "the return ABS is: " & nr1 + + nr2 = 5 + nr1 = Abs(5) + TestLog_ASSERT nr1 = nr2, "the return ABS is: " & nr1 + + nr2 = 21.7 + nr1 = Abs(-21.7) + TestLog_ASSERT nr1 = nr2, "the return ABS is: " & nr1 + + result = result & Chr$(10) & "Tests passed: " & passCount & Chr$(10) & "Tests failed: " & failCount & Chr$(10) + verify_testABS = 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/array.vb b/basic/qa/vba_tests/array.vb new file mode 100644 index 000000000..63f39bed7 --- /dev/null +++ b/basic/qa/vba_tests/array.vb @@ -0,0 +1,97 @@ +Rem Attribute VBA_ModuleType=VBAModule +Option VBASupport 1 +Option Explicit +Dim passCount As Integer +Dim failCount As Integer +Dim result As String +Type MyType + ax(3) As Integer + bx As Double +End Type + +Function doUnitTest() As String +result = verify_testARRAY() +If failCount <> 0 Or passCount = 0 Then + doUnitTest = result +Else + doUnitTest = "OK" +End If +End Function + + + +Function verify_testARRAY() As String + + passCount = 0 + failCount = 0 + + result = "Test Results" & Chr$(10) & "============" & Chr$(10) + + Dim testName As String + Dim a, b, C As Variant + a = Array(10, 20, 30) + testName = "Test ARRAY function" + On Error GoTo errorHandler + + b = 10 + C = a(0) + TestLog_ASSERT b = C, "the return ARRAY is: " & C + + b = 20 + C = a(1) + TestLog_ASSERT b = C, "the return ARRAY is: " & C + + b = 30 + C = a(2) + TestLog_ASSERT b = C, "the return ARRAY is: " & C + + Dim MyWeek, MyDay + MyWeek = Array("Mon", "Tue", "Wed", "Thu", "Fri", "Sat", "Sun") + + b = "Tue" + MyDay = MyWeek(1) ' MyDay contains "Tue". + TestLog_ASSERT b = MyDay, "the return ARRAY is: " & MyDay + + b = "Thu" + MyDay = MyWeek(3) ' MyDay contains "Thu". + TestLog_ASSERT b = MyDay, "the return ARRAY is: " & MyDay + +Dim mt As MyType + mt.ax(0) = 42 + mt.ax(1) = 43 + mt.bx = 3.14 + b = 43 + C = mt.ax(1) + TestLog_ASSERT b = C, "the return ARRAY is: " & C + + b = 3.14 + C = mt.bx + TestLog_ASSERT b = C, "the return ARRAY is: " & C + + result = result & Chr$(10) & "Tests passed: " & passCount & Chr$(10) & "Tests failed: " & failCount & Chr$(10) + verify_testARRAY = 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/asc.vb b/basic/qa/vba_tests/asc.vb new file mode 100644 index 000000000..813abe9f8 --- /dev/null +++ b/basic/qa/vba_tests/asc.vb @@ -0,0 +1,71 @@ +Rem Attribute VBA_ModuleType=VBAModule +Option VBASupport 1 +Option Explicit +Dim passCount As Integer +Dim failCount As Integer +Dim result As String + +Function doUnitTest() As String +result = verify_testASC() +If failCount <> 0 Or passCount = 0 Then + doUnitTest = result +Else + doUnitTest = "OK" +End If +End Function + + + +Function verify_testASC() As String + + passCount = 0 + failCount = 0 + + result = "Test Results" & Chr$(10) & "============" & Chr$(10) + + Dim testName As String + Dim nr1, nr2 As Double + + testName = "Test ASC function" + On Error GoTo errorHandler + + nr2 = 65 + nr1 = Asc("A") + TestLog_ASSERT nr1 = nr2, "the return ASC is: " & nr1 + + nr2 = 97 + nr1 = Asc("a") + TestLog_ASSERT nr1 = nr2, "the return ASC is: " & nr1 + + + nr2 = 65 + nr1 = Asc("Apple") + TestLog_ASSERT nr1 = nr2, "the return ASC is: " & nr1 + + result = result & Chr$(10) & "Tests passed: " & passCount & Chr$(10) & "Tests failed: " & failCount & Chr$(10) + verify_testASC = 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/atn.vb b/basic/qa/vba_tests/atn.vb new file mode 100644 index 000000000..145584ee6 --- /dev/null +++ b/basic/qa/vba_tests/atn.vb @@ -0,0 +1,77 @@ +Option VBASupport 1 +Option Explicit +Dim passCount As Integer +Dim failCount As Integer +Dim result As String + +Function doUnitTest() As String +result = verify_testATN() +If failCount <> 0 or passCount = 0 Then + doUnitTest = result +Else + doUnitTest = "OK" +End If +End Function + + + +Function verify_testATN() As String + + passCount = 0 + failCount = 0 + + result = "Test Results" & Chr$(10) & "============" & Chr$(10) + + Dim testName As String + Dim nr1, nr2 As Double + testName = "Test ATN function" + On Error GoTo errorHandler + + nr2 = 1.10714871779409 + nr1 = Atn(2) + TestLog_ASSERT Round(nr1, 14) = Round(nr2, 14), "the return ATN is: " & nr1 + + nr2 = 1.19166451926354 + nr1 = Atn(2.51) + TestLog_ASSERT Round(nr1, 14) = Round(nr2, 14), "the return ATN is: " & nr1 + + nr2 = -1.27229739520872 + nr1 = Atn(-3.25) + TestLog_ASSERT Round(nr1, 14) = Round(nr2, 14), "the return ATN is: " & nr1 + + nr2 = 1.56603445802574 + nr1 = Atn(210) + TestLog_ASSERT Round(nr1, 14) = Round(nr2, 14), "the return ATN is: " & nr1 + + nr2 = 0 + nr1 = Atn(0) + TestLog_ASSERT nr1 = nr2, "the return ATN is: " & nr1 + + result = result & Chr$(10) & "Tests passed: " & passCount & Chr$(10) & "Tests failed: " & failCount & Chr$(10) + verify_testATN = 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/bytearraystring.vb b/basic/qa/vba_tests/bytearraystring.vb new file mode 100644 index 000000000..c404b6e9a --- /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/cbool.vb b/basic/qa/vba_tests/cbool.vb new file mode 100644 index 000000000..cf3b8224d --- /dev/null +++ b/basic/qa/vba_tests/cbool.vb @@ -0,0 +1,104 @@ +Option VBASupport 1 +Rem Option VBASupport 1 'unREM in .vb file +Option Explicit +Dim passCount As Integer +Dim failCount As Integer +Dim result As String + +Function doUnitTest() As String +result = verify_testCBool() +If failCount <> 0 Or passCount = 0 Then + doUnitTest = result +Else + doUnitTest = "OK" +End If +End Function + + + +Function verify_testCBool() As String + + passCount = 0 + failCount = 0 + + result = "Test Results" & Chr$(10) & "============" & Chr$(10) + + Dim testName As String + Dim res2, res1 As Boolean + Dim a1, a2 As Integer + testName = "Test CBool function" + On Error GoTo errorHandler + + res2 = True + res1 = CBool(1) + TestLog_ASSERT res1 = res2, "the return CBool is: " & res1 + + res2 = False + res1 = CBool(1 = 2) + TestLog_ASSERT res1 = res2, "the return CBool is: " & res1 + + res2 = False + res1 = CBool(0) + TestLog_ASSERT res1 = res2, "the return CBool is: " & res1 + + res2 = True + res1 = CBool(21) + TestLog_ASSERT res1 = res2, "the return CBool is: " & res1 + + res2 = True + res1 = CBool("true") + TestLog_ASSERT res1 = res2, "the return CBool is: " & res1 + + res2 = False + res1 = CBool("false") + TestLog_ASSERT res1 = res2, "the return CBool is: " & res1 + + res2 = True + res1 = CBool("1") + TestLog_ASSERT res1 = res2, "the return CBool is: " & res1 + + res2 = True + res1 = CBool("-1") + TestLog_ASSERT res1 = res2, "the return CBool is: " & res1 + + res2 = False + res1 = CBool("0") + TestLog_ASSERT res1 = res2, "the return CBool is: " & res1 + + res2 = False + a1 = 1: a2 = 10 + res1 = CBool(a1 = a2) + TestLog_ASSERT res1 = res2, "the return CBool is: " & res1 + + res2 = True + a1 = 10: a2 = 10 + res1 = CBool(a1 = a2) + TestLog_ASSERT res1 = res2, "the return CBool is: " & res1 + + result = result & Chr$(10) & "Tests passed: " & passCount & Chr$(10) & "Tests failed: " & failCount & Chr$(10) + verify_testCBool = 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/cdate.vb b/basic/qa/vba_tests/cdate.vb new file mode 100644 index 000000000..d04ecc004 --- /dev/null +++ b/basic/qa/vba_tests/cdate.vb @@ -0,0 +1,68 @@ +Option VBASupport 1 +Option Explicit +Dim passCount As Integer +Dim failCount As Integer +Dim result As String + +Function doUnitTest() As String +result = verify_testCDate() +If failCount <> 0 or passCount = 0 Then + doUnitTest = result +Else + doUnitTest = "OK" +End If +End Function + + + +Function verify_testCDate() As String + + passCount = 0 + failCount = 0 + + result = "Test Results" & Chr$(10) & "============" & Chr$(10) + + Dim testName As String + Dim date1, date2 As Date 'variables for test + testName = "Test CDate function" + On Error GoTo errorHandler + + date2 = 25246 + date1 = CDate("12/02/1969") '02/12/1969 + TestLog_ASSERT date1 = date2, "the return CDate is: " & date1 + + date2 = 28313 + date1 = CDate("07/07/1977") + TestLog_ASSERT date1 = date2, "the return CDate is: " & date1 + + date2 = 28313 + date1 = CDate(#7/7/1977#) + TestLog_ASSERT date1 = date2, "the return CDate is: " & date1 + + result = result & Chr$(10) & "Tests passed: " & passCount & Chr$(10) & "Tests failed: " & failCount & Chr$(10) + verify_testCDate = 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/cdbl.vb b/basic/qa/vba_tests/cdbl.vb new file mode 100644 index 000000000..bb51c6a00 --- /dev/null +++ b/basic/qa/vba_tests/cdbl.vb @@ -0,0 +1,73 @@ +Option VBASupport 1 +Option Explicit +Dim passCount As Integer +Dim failCount As Integer +Dim result As String + +Function doUnitTest() As String +result = verify_testCdbl() +If failCount <> 0 Or passCount = 0 Then + doUnitTest = result +Else + doUnitTest = "OK" +End If +End Function + + + +Function verify_testCdbl() As String + + passCount = 0 + failCount = 0 + + result = "Test Results" & Chr$(10) & "============" & Chr$(10) + + Dim testName As String + Dim nr1, nr2 As Double 'variables for test + testName = "Test Cdbl function" + On Error GoTo errorHandler + + nr2 = 0 + nr1 = CDbl(0) + TestLog_ASSERT nr1 = nr2, "the return Cdbl is: " & nr1 + + nr2 = 10.1234567890123 + nr1 = CDbl(10.1234567890123) + TestLog_ASSERT nr1 = nr2, "the return Cdbl is: " & nr1 + + nr2 = 0.00005 + nr1 = CDbl(0.005 * 0.01) + TestLog_ASSERT nr1 = nr2, "the return Cdbl is: " & nr1 + + nr2 = 20 + nr1 = CDbl("20") + TestLog_ASSERT nr1 = nr2, "the return Cdbl is: " & nr1 + + + result = result & Chr$(10) & "Tests passed: " & passCount & Chr$(10) & "Tests failed: " & failCount & Chr$(10) + verify_testCdbl = 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/cdec.vb b/basic/qa/vba_tests/cdec.vb new file mode 100644 index 000000000..af919a7cb --- /dev/null +++ b/basic/qa/vba_tests/cdec.vb @@ -0,0 +1,86 @@ +Option VBASupport 1 +Option Explicit +Dim passCount As Integer +Dim failCount As Integer +Dim result As String + +Function doUnitTest() As String +result = verify_testCDec() +If failCount <> 0 Or passCount = 0 Then + doUnitTest = result +Else + doUnitTest = "OK" +End If +End Function + +Function verify_testCDec() as String + passCount = 0 + failCount = 0 + + result = "Test Results" & Chr$(10) & "============" & Chr$(10) + + Dim testName As String + Dim ret As Double + testName = "Test CDec function" + On Error GoTo errorHandler + + ret = CDec("") + TestLog_ASSERT ret = 0, "Empty string test:" & ret + + ret = CDec("1234") + TestLog_ASSERT ret = 1234, "Simple number:" & ret + + ret = CDec(" 1234 ") + TestLog_ASSERT ret = 1234, "Simple number with whitespaces:" & ret + + ret = CDec("-1234") + TestLog_ASSERT ret = -1234, "Simple negative number:" & ret + + ret = CDec(" - 1234 ") + TestLog_ASSERT ret = -1234, "Simple negative number with whitespaces:" & ret + + ''''''''''''''' + ' Those are erroneous, see i#64348 + ret = CDec("1234-") + TestLog_ASSERT ret = -1234, "Wrong negative number1:" & ret + + ret = CDec(" 1234 -") + TestLog_ASSERT ret = -1234, "Wrong negative number2:" & ret + + 'ret = CDec("79228162514264300000000000001") + 'TestLog_ASSERT ret = 79228162514264300000000000001, "Very long number1:" & ret + 'ret = ret+1 + 'TestLog_ASSERT ret = 79228162514264300000000000002, "Very long number2:" & ret + + ret = CDec("79228162514264400000000000000") + TestLog_ASSERT ret = 62406456049664, "Very long number3:" & ret + + ret = CDec("79228162514264340000000000000") ' gives zero + TestLog_ASSERT ret = 0, "Very long number4:" & ret + + result = result & Chr$(10) & "Tests passed: " & passCount & Chr$(10) & "Tests failed: " & failCount & Chr$(10) + verify_testCDec = 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/choose.vb b/basic/qa/vba_tests/choose.vb new file mode 100644 index 000000000..3d30cfce1 --- /dev/null +++ b/basic/qa/vba_tests/choose.vb @@ -0,0 +1,80 @@ +Option VBASupport 1 +Option Explicit +Dim passCount As Integer +Dim failCount As Integer +Dim result As String + +Function doUnitTest() As String +result = verify_testChoose() +If failCount <> 0 Or passCount = 0 Then + doUnitTest = result +Else + doUnitTest = "OK" +End If +End Function + + + +Function verify_testChoose() As String + + passCount = 0 + failCount = 0 + + result = "Test Results" & Chr$(10) & "============" & Chr$(10) + + Dim testName As String + Dim var1, var2 + testName = "Test Choose function" + + + On Error GoTo errorHandler + + var2 = "Libre" + var1 = Choose(1, "Libre", "Office", "Suite") + TestLog_ASSERT var1 = var2, "the return Choose is: " & var1 + + var2 = "Office" + var1 = Choose(2, "Libre", "Office", "Suite") + TestLog_ASSERT var1 = var2, "the return Choose is: " & var1 + + var2 = "Suite" + var1 = Choose(3, "Libre", "Office", "Suite") + TestLog_ASSERT var1 = var2, "the return Choose is: " & var1 + + + var1 = Choose(4, "Libre", "Office", "Suite") + TestLog_ASSERT IsNull(var1), "the return Choose is: Null4 " + + var1 = Choose(0, "Libre", "Office", "Suite") + TestLog_ASSERT IsNull(var1), "the return Choose is: Null0 " + + var1 = Choose(-1, "Libre", "Office", "Suite") + TestLog_ASSERT IsNull(var1), "the return Choose is: Null-1" + + result = result & Chr$(10) & "Tests passed: " & passCount & Chr$(10) & "Tests failed: " & failCount & Chr$(10) + verify_testChoose = 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/chr.vb b/basic/qa/vba_tests/chr.vb new file mode 100644 index 000000000..eb5aeb8df --- /dev/null +++ b/basic/qa/vba_tests/chr.vb @@ -0,0 +1,69 @@ +Option VBASupport 1 +Option Explicit +Dim passCount As Integer +Dim failCount As Integer +Dim result As String + +Function doUnitTest() As String +result = verify_testCHR() +If failCount <> 0 Or passCount = 0 Then + doUnitTest = result +Else + doUnitTest = "OK" +End If +End Function + + + +Function verify_testCHR() As String + + passCount = 0 + failCount = 0 + + result = "Test Results" & Chr$(10) & "============" & Chr$(10) + + Dim testName As String + Dim str1, str2 As String + testName = "Test CHR function" + On Error GoTo errorHandler + + str2 = "W" + str1 = Chr(87) + TestLog_ASSERT str1 = str2, "the return CHR is: " & str1 + + str2 = "i" + str1 = Chr(105) + TestLog_ASSERT str1 = str2, "the return CHR is: " & str1 + + str2 = "#" + str1 = Chr(35) + TestLog_ASSERT str1 = str2, "the return CHR is: " & str1 + + result = result & Chr$(10) & "Tests passed: " & passCount & Chr$(10) & "Tests failed: " & failCount & Chr$(10) + verify_testCHR = 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/cint.vb b/basic/qa/vba_tests/cint.vb new file mode 100644 index 000000000..6c1d53c93 --- /dev/null +++ b/basic/qa/vba_tests/cint.vb @@ -0,0 +1,103 @@ +Option VBASupport 1 +Option Explicit +Dim passCount As Integer +Dim failCount As Integer +Dim result As String + +Function doUnitTest() As String +result = verify_testCInt() +If failCount <> 0 Or passCount = 0 Then + doUnitTest = result +Else + doUnitTest = "OK" +End If +End Function + + + +Function verify_testCInt() As String + + passCount = 0 + failCount = 0 + + result = "Test Results" & Chr$(10) & "============" & Chr$(10) + + Dim testName As String + Dim nr1, nr2 As Integer 'variables for test + testName = "Test CInt function" + + + On Error GoTo errorHandler + + nr2 = -1 + nr1 = CInt(-1.1) + TestLog_ASSERT nr1 = nr2, "the return CInt is: " & nr1 + + nr2 = -1 + nr1 = CInt(-1.1) + TestLog_ASSERT nr1 = nr2, "the return CInt is: " & nr1 + + nr2 = -2 + nr1 = CInt(-1.9) + TestLog_ASSERT nr1 = nr2, "the return CInt is: " & nr1 + + nr2 = 0 + nr1 = CInt(0.2) + TestLog_ASSERT nr1 = nr2, "the return CInt is: " & nr1 + +REM In excel: +REM If the fraction is less than or equal to .5, the result will round down. +REM If the fraction is greater than .5, the result will round up. + +REM nr2 = 0 +REM nr1 = CInt(0.5) +REM TestLog_ASSERT nr1 = nr2, "the return CInt is: " & nr1 + +REM nr2 = 2 +REM nr1 = CInt(1.5) +REM TestLog_ASSERT nr1 = nr2, "the return CInt is: " & nr1 + +REM nr2 = 2 +REM nr1 = CInt(2.5) +REM TestLog_ASSERT nr1 = nr2, "the return CInt is: " & nr1 + + nr2 = 11 + nr1 = CInt(10.51) + TestLog_ASSERT nr1 = nr2, "the return CInt is: " & nr1 + + nr2 = 30207 + nr1 = CInt("&H75FF") + TestLog_ASSERT nr1 = nr2, "the return CInt is: " & nr1 + + nr2 = 1876 + nr1 = CInt("&H754") + TestLog_ASSERT nr1 = nr2, "the return CInt is: " & nr1 + + result = result & Chr$(10) & "Tests passed: " & passCount & Chr$(10) & "Tests failed: " & failCount & Chr$(10) + verify_testCInt = 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/clng.vb b/basic/qa/vba_tests/clng.vb new file mode 100644 index 000000000..768bafee1 --- /dev/null +++ b/basic/qa/vba_tests/clng.vb @@ -0,0 +1,95 @@ +Option VBASupport 1 +Option Explicit +Dim passCount As Integer +Dim failCount As Integer +Dim result As String + +Function doUnitTest() As String +result = verify_testCLng() +If failCount <> 0 Or passCount = 0 Then + doUnitTest = result +Else + doUnitTest = "OK" +End If +End Function + + + +Function verify_testCLng() As String + + passCount = 0 + failCount = 0 + + result = "Test Results" & Chr$(10) & "============" & Chr$(10) + + Dim testName As String + Dim nr1, nr2 As Long 'variables for test + testName = "Test CLng function" + + + On Error GoTo errorHandler + + nr2 = -1 + nr1 = CLng(-1.1) + TestLog_ASSERT nr1 = nr2, "the return CLng is: " & nr1 + + nr2 = -1 + nr1 = CLng(-1.1) + TestLog_ASSERT nr1 = nr2, "the return CLng is: " & nr1 + + nr2 = -2 + nr1 = CLng(-1.9) + TestLog_ASSERT nr1 = nr2, "the return CLng is: " & nr1 + + nr2 = 0 + nr1 = CLng(0.2) + TestLog_ASSERT nr1 = nr2, "the return CLng is: " & nr1 + +REM nr2 = 0 +REM nr1 = CLng(0.5) +REM TestLog_ASSERT nr1 = nr2, "the return CLng is: " & nr1 + +REM If the fraction is less than or equal to .5, the result will round down. +REM If the fraction is greater than .5, the result will round up. + + nr2 = 11 + nr1 = CLng(10.51) + TestLog_ASSERT nr1 = nr2, "the return CLng is: " & nr1 + + nr2 = 30207 + nr1 = CLng("&H75FF") + TestLog_ASSERT nr1 = nr2, "the return CLng is: " & nr1 + + nr2 = 1876 + nr1 = CLng("&H754") + TestLog_ASSERT nr1 = nr2, "the return CLng is: " & nr1 + + result = result & Chr$(10) & "Tests passed: " & passCount & Chr$(10) & "Tests failed: " & failCount & Chr$(10) + verify_testCLng = 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/constants.vb b/basic/qa/vba_tests/constants.vb new file mode 100644 index 000000000..e879ce5ab --- /dev/null +++ b/basic/qa/vba_tests/constants.vb @@ -0,0 +1,57 @@ +Option VBASupport 1 +Option Explicit +Dim passCount As Integer +Dim failCount As Integer +Dim result As String + +Function doUnitTest() As String +result = verify_testConstants() +If failCount <> 0 Or passCount = 0 Then + doUnitTest = result +Else + doUnitTest = "OK" +End If +End Function + +Function verify_testConstants() As String + passCount = 0 + failCount = 0 + + result = "Test Results" & Chr$(10) & "============" & Chr$(10) + + Dim testName As String + testName = "Test Constants" + On Error GoTo errorHandler + + If GetGuiType() = 1 Then + TestLog_ASSERT vbNewline = vbCrLf, "vbNewLine is the same as vbCrLf on Windows" + Else + TestLog_ASSERT vbNewLine = vbLf, "vbNewLine is the same as vbLf on others than Windows" + End If + + result = result & Chr$(10) & "Tests passed: " & passCount & Chr$(10) & "Tests failed: " & failCount & Chr$(10) + verify_testConstants = 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/cos.vb b/basic/qa/vba_tests/cos.vb new file mode 100644 index 000000000..993794b70 --- /dev/null +++ b/basic/qa/vba_tests/cos.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_testCOS() +If failCount <> 0 or passCount = 0 Then + doUnitTest = result +Else + doUnitTest = "OK" +End If +End Function + + + +Function verify_testCOS() As String + + passCount = 0 + failCount = 0 + + result = "Test Results" & Chr$(10) & "============" & Chr$(10) + + Dim testName As String + Dim nr1, nr2 As Double 'variables for test + testName = "Test COS function" + + + On Error GoTo errorHandler + + nr2 = -0.532833020333398 + nr1 = Cos(23) + TestLog_ASSERT Round(nr1, 14) = Round(nr2, 14), "the return COS is: " & nr1 + + nr2 = 0.980066577841242 + nr1 = Cos(0.2) + TestLog_ASSERT Round(nr1, 14) = Round(nr2, 14), "the return COS is: " & nr1 + + nr2 = 0.487187675007006 + nr1 = Cos(200) + TestLog_ASSERT Round(nr1, 14) = Round(nr2, 14), "the return COS is: " & nr1 + + + result = result & Chr$(10) & "Tests passed: " & passCount & Chr$(10) & "Tests failed: " & failCount & Chr$(10) + verify_testCOS = 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/csng.vb b/basic/qa/vba_tests/csng.vb new file mode 100644 index 000000000..476cc6a6f --- /dev/null +++ b/basic/qa/vba_tests/csng.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_testCSng() +If failCount <> 0 Or passCount = 0 Then + doUnitTest = result +Else + doUnitTest = "OK" +End If +End Function + + + +Function verify_testCSng() As String + + passCount = 0 + failCount = 0 + + result = "Test Results" & Chr$(10) & "============" & Chr$(10) + + Dim testName As String + Dim nr1, nr2 As Single 'variables for test + Dim nr3 As Double + + testName = "Test CSng function" + On Error GoTo errorHandler + + nr2 = 8.534535408 + nr1 = CSng(8.534535408) + TestLog_ASSERT nr1 = nr2, "the return CSng is: " & nr1 + + nr3 = 100.1234 + nr2 = 100.1234 + nr1 = CSng(nr3) + TestLog_ASSERT nr1 = nr2, "the return CSng is: " & nr1 + + nr2 = 0 + nr1 = CSng(0) + TestLog_ASSERT nr1 = nr2, "the return CSng is: " & nr1 + + result = result & Chr$(10) & "Tests passed: " & passCount & Chr$(10) & "Tests failed: " & failCount & Chr$(10) + verify_testCSng = 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/cstr.vb b/basic/qa/vba_tests/cstr.vb new file mode 100644 index 000000000..62258962a --- /dev/null +++ b/basic/qa/vba_tests/cstr.vb @@ -0,0 +1,66 @@ +Option VBASupport 1 +Option Explicit +Dim passCount As Integer +Dim failCount As Integer +Dim result As String + +Function doUnitTest() As String +result = verify_testCStr() +If failCount <> 0 Or passCount = 0 Then + doUnitTest = result +Else + doUnitTest = "OK" +End If +End Function + + + +Function verify_testCStr() As String + + passCount = 0 + failCount = 0 + + result = "Test Results" & Chr$(10) & "============" & Chr$(10) + + Dim testName As String + Dim str2, str3 + Dim str1 As String 'variables for test + testName = "Test CStr function" + On Error GoTo errorHandler + + str3 = 437.324 + str2 = "437.324" + str1 = CStr(str3) + TestLog_ASSERT str1 = str2, "the return CStr is: " & str1 + + str2 = "500" + str1 = CStr(500) + TestLog_ASSERT str1 = str2, "the return CStr is: " & str1 + + result = result & Chr$(10) & "Tests passed: " & passCount & Chr$(10) & "Tests failed: " & failCount & Chr$(10) + verify_testCStr = 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/cvdate.vb b/basic/qa/vba_tests/cvdate.vb new file mode 100644 index 000000000..58ef6ca7d --- /dev/null +++ b/basic/qa/vba_tests/cvdate.vb @@ -0,0 +1,68 @@ +Option VBASupport 1 +Option Explicit +Dim passCount As Integer +Dim failCount As Integer +Dim result As String + +Function doUnitTest() As String +result = verify_testCVDate() +If failCount <> 0 And passCount > 0 Then + doUnitTest = result +Else + doUnitTest = "OK" +End If +End Function + + + +Function verify_testCVDate() As String + + passCount = 0 + failCount = 0 + + result = "Test Results" & Chr$(10) & "============" & Chr$(10) + + Dim testName As String + Dim date1, date2 As Date 'variables for test + testName = "Test CVDate function" + On Error GoTo errorHandler + + date2 = 25246 + date1 = CVDate("12.2.1969") '2/12/1969 + TestLog_ASSERT date1 = date2, "the return CVDate is: " & date1 + + date2 = 28313 + date1 = CVDate("07/07/1977") + TestLog_ASSERT date1 = date2, "the return CVDate is: " & date1 + + date2 = 28313 + date1 = CVDate(#7/7/1977#) + TestLog_ASSERT date1 = date2, "the return CVDate is: " & date1 + + result = result & Chr$(10) & "Tests passed: " & passCount & Chr$(10) & "Tests failed: " & failCount & Chr$(10) + verify_testCVDate = 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/cverr.vb b/basic/qa/vba_tests/cverr.vb new file mode 100644 index 000000000..4aa646ae8 --- /dev/null +++ b/basic/qa/vba_tests/cverr.vb @@ -0,0 +1,99 @@ +Option VBASupport 1 +Option Explicit +Dim passCount As Integer +Dim failCount As Integer +Dim result As String + +Function doUnitTest() As String +result = verify_testCVErr() +If failCount <> 0 Or passCount = 0 Then + doUnitTest = result +Else + doUnitTest = "OK" +End If +End Function + + + +Function verify_testCVErr() As String + + passCount = 0 + failCount = 0 + + result = "Test Results" & Chr$(10) & "============" & Chr$(10) + + Dim testName As String + Dim date1, date2 + testName = "Test CVErr function" + On Error GoTo errorHandler + + date2 = "Error 3001" + date1 = CStr(CVErr(3001)) + TestLog_ASSERT date1 = date2, "the return CVErr is: " & date1 + + date2 = "Error 2007" + date1 = CStr(CVErr(xlErrDiv0)) + TestLog_ASSERT date1 = date2, "the return CVErr is: " & date1 + + date2 = "Error 2042" + date1 = CStr(CVErr(xlErrNA)) + TestLog_ASSERT date1 = date2, "the return CVErr is: " & date1 + + date2 = "Error 2029" + date1 = CStr(CVErr(xlErrName)) + TestLog_ASSERT date1 = date2, "the return CVErr is: " & date1 + + date2 = "Error 2000" + date1 = CStr(CVErr(xlErrNull)) + TestLog_ASSERT date1 = date2, "the return CVErr is: " & date1 + + date2 = "Error 2036" + date1 = CStr(CVErr(xlErrNum)) + TestLog_ASSERT date1 = date2, "the return CVErr is: " & date1 + + date2 = "Error 2023" + date1 = CStr(CVErr(xlErrRef)) + TestLog_ASSERT date1 = date2, "the return CVErr is: " & date1 + + date2 = "Error 2015" + date1 = CStr(CVErr(xlErrValue)) + TestLog_ASSERT date1 = date2, "the return CVErr is: " & date1 + + ' tdf#79426 - passing an error object to a function + TestLog_ASSERT TestCVErr( CVErr( 2 ) ) = 2 + ' tdf#79426 - test with Error-Code 448 ( ERRCODE_BASIC_NAMED_NOT_FOUND ) + TestLog_ASSERT TestCVErr( CVErr( 448 ) ) = 448 + + result = result & Chr$(10) & "Tests passed: " & passCount & Chr$(10) & "Tests failed: " & failCount & Chr$(10) + verify_testCVErr = result + + Exit Function +errorHandler: + TestLog_ASSERT (False), testName & ": hit error handler" +End Function + +Function TestCVErr(vErr As Variant) + Dim nValue As Integer + nValue = vErr + TestCVErr = nValue +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/data/ADODBdata.xls b/basic/qa/vba_tests/data/ADODBdata.xls Binary files differnew file mode 100644 index 000000000..655b38a90 --- /dev/null +++ b/basic/qa/vba_tests/data/ADODBdata.xls diff --git a/basic/qa/vba_tests/dateadd.vb b/basic/qa/vba_tests/dateadd.vb new file mode 100644 index 000000000..84135f34c --- /dev/null +++ b/basic/qa/vba_tests/dateadd.vb @@ -0,0 +1,114 @@ +Option VBASupport 1 +Option Explicit +Dim passCount As Integer +Dim failCount As Integer +Dim result As String + +Function doUnitTest() As String +result = verify_testDateAdd() +If failCount <> 0 Or passCount = 0 Then + doUnitTest = result +Else + doUnitTest = "OK" +End If +End Function + + + +Function verify_testDateAdd() As String + + passCount = 0 + failCount = 0 + + result = "Test Results" & Chr$(10) & "============" & Chr$(10) + + Dim testName As String + Dim date1, date2 As Date 'variables for test + testName = "Test DateAdd function" + On Error GoTo errorHandler + + date2 = CDate("1995-02-28") + date1 = DateAdd("m", 1, "1995-01-31") + TestLog_ASSERT date1 = date2, "the return DateAdd is: " & date1 + + date2 = CDate("1995-02-28") + date1 = DateAdd("m", 1, "1995-01-31") + TestLog_ASSERT date1 = date2, "the return DateAdd is: " & date1 + + date2 = CDate("1995-02-28") + date1 = DateAdd("m", 1, "1995-01-31") + TestLog_ASSERT date1 = date2, "the return DateAdd is: " & date1 + + date2 = CDate("1996-01-31") + date1 = DateAdd("yyyy", 1, "1995-01-31") + TestLog_ASSERT date1 = date2, "the return DateAdd is: " & date1 + + date2 = CDate("1995-04-30") + date1 = DateAdd("q", 1, "1995-01-31") + TestLog_ASSERT date1 = date2, "the return DateAdd is: " & date1 + + date2 = CDate("1995-02-01") + date1 = DateAdd("y", 1, "1995-01-31") + TestLog_ASSERT date1 = date2, "the return DateAdd is: " & date1 + + date2 = CDate("1995-02-01") + date1 = DateAdd("d", 1, "1995-01-31") + TestLog_ASSERT date1 = date2, "the return DateAdd is: " & date1 + + date2 = CDate("1995-02-01") + date1 = DateAdd("w", 1, "1995-01-31") + TestLog_ASSERT date1 = date2, "the return DateAdd is: " & date1 + + date2 = CDate("1995-02-07") + date1 = DateAdd("ww", 1, "1995-01-31") + TestLog_ASSERT date1 = date2, "the return DateAdd is: " & date1 + +Rem This fails when directly comparing date1=date2, probably due to rounding. +Rem Workaround convert to string which does the rounding. + Dim date1s, date2s As String + date2 = CDate("1995-01-01 22:48:29") + date1 = DateAdd("h", 1, "1995-01-01 21:48:29") + date1s = "" & date1 + date2s = "" & date2 + TestLog_ASSERT date1s = date2s, "the return DateAdd is: " & date1 + + date2 = CDate("1995-01-31 21:49:29") + date1 = DateAdd("n", 1, "1995-01-31 21:48:29") + TestLog_ASSERT date1 = date2, "the return DateAdd is: " & date1 + + date2 = CDate("1995-01-31 21:48:30") + date1 = DateAdd("s", 1, "1995-01-31 21:48:29") + TestLog_ASSERT date1 = date2, "the return DateAdd is: " & date1 + +exitFunc: + result = result & Chr$(10) & "Tests passed: " & passCount & Chr$(10) & "Tests failed: " & failCount & Chr$(10) + verify_testDateAdd = result + + Exit Function + +errorHandler: + On Error GoTo 0 + TestLog_ASSERT (False), testName & ": hit error handler" + GoTo exitFunc + +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/datediff.vb b/basic/qa/vba_tests/datediff.vb new file mode 100644 index 000000000..1b5e7ebf4 --- /dev/null +++ b/basic/qa/vba_tests/datediff.vb @@ -0,0 +1,137 @@ +Option VBASupport 1 +Option Explicit +Dim passCount As Integer +Dim failCount As Integer +Dim result As String + +Function doUnitTest() As String +result = verify_testDateDiff() +If failCount <> 0 Or passCount = 0 Then + doUnitTest = result +Else + doUnitTest = "OK" +End If +End Function + + + +Function verify_testDateDiff() As String + + passCount = 0 + failCount = 0 + + result = "Test Results" & Chr$(10) & "============" & Chr$(10) + + Dim testName As String + Dim date1 + Dim date2 + testName = "Test DateDiff function" + On Error GoTo errorHandler + + date2 = 10 + date1 = DateDiff("yyyy", "22/11/2003", "22/11/2013") + TestLog_ASSERT date1 = date2, "the return DateDiff is: " & date1 + + date2 = 40 + date1 = DateDiff("q", "22/11/2003", "22/11/2013") + TestLog_ASSERT date1 = date2, "the return DateDiff is: " & date1 + + date2 = 120 + date1 = DateDiff("m", "22/11/2003", "22/11/2013") + TestLog_ASSERT date1 = date2, "the return DateDiff is: " & date1 + + date2 = 3653 + date1 = DateDiff("y", "22/11/2003", "22/11/2013") + TestLog_ASSERT date1 = date2, "the return DateDiff is: " & date1 + + date2 = 3653 + date1 = DateDiff("d", "22/11/2003", "22/11/2013") + TestLog_ASSERT date1 = date2, "the return DateDiff is: " & date1 + + date2 = 521 + date1 = DateDiff("w", "22/11/2003", "22/11/2013") + TestLog_ASSERT date1 = date2, "the return DateDiff is: " & date1 + + date2 = 522 + date1 = DateDiff("ww", "22/11/2003", "22/11/2013") + TestLog_ASSERT date1 = date2, "the return DateDiff is: " & date1 + + date2 = 87672 + date1 = DateDiff("h", "22/11/2003", "22/11/2013") + TestLog_ASSERT date1 = date2, "the return DateDiff is: " & date1 + + date2 = 525600 + date1 = DateDiff("n", "22/11/2012", "22/11/2013") + TestLog_ASSERT date1 = date2, "the return DateDiff is: " & date1 + + date2 = 2678400 + date1 = DateDiff("s", "22/10/2013", "22/11/2013") + TestLog_ASSERT date1 = date2, "the return DateDiff is: " & date1 + + date2 = 3653 + date1 = DateDiff("d", "22/11/2003", "22/11/2013", vbFriday) + TestLog_ASSERT date1 = date2, "the return DateDiff is: " & date1 + + date2 = 3653 + date1 = DateDiff("d", "22/11/2003", "22/11/2013", vbMonday) + TestLog_ASSERT date1 = date2, "the return DateDiff is: " & date1 + + date2 = 3623 + date1 = DateDiff("d", "22/12/2003", "22/11/2013", vbSaturday) + TestLog_ASSERT date1 = date2, "the return DateDiff is: " & date1 + + date2 = 3684 + date1 = DateDiff("d", "22/10/2003", "22/11/2013", vbSunday) + TestLog_ASSERT date1 = date2, "the return DateDiff is: " & date1 + + date2 = 3653 + date1 = DateDiff("d", "22/11/2003", "22/11/2013", vbThursday) + TestLog_ASSERT date1 = date2, "the return DateDiff is: " & date1 + + date2 = 3653 + date1 = DateDiff("d", "22/11/2003", "22/11/2013", vbTuesday) + TestLog_ASSERT date1 = date2, "the return DateDiff is: " & date1 + + date2 = 3653 + date1 = DateDiff("d", "22/11/2003", "22/11/2013", vbFriday, vbFirstJan1) + TestLog_ASSERT date1 = date2, "the return DateDiff is: " & date1 + + date2 = 3653 + date1 = DateDiff("d", "22/11/2003", "22/11/2013", vbThursday, vbFirstFourDays) + TestLog_ASSERT date1 = date2, "the return DateDiff is: " & date1 + + date2 = 3653 + date1 = DateDiff("d", "22/11/2003", "22/11/2013", vbSunday, vbFirstFullWeek) + TestLog_ASSERT date1 = date2, "the return DateDiff is: " & date1 + + date2 = 3653 + date1 = DateDiff("d", "22/11/2003", "22/11/2013", vbSaturday, vbFirstFullWeek) + TestLog_ASSERT date1 = date2, "the return DateDiff is: " & date1 + + result = result & Chr$(10) & "Tests passed: " & passCount & Chr$(10) & "Tests failed: " & failCount & Chr$(10) + verify_testDateDiff = 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/datepart.vb b/basic/qa/vba_tests/datepart.vb new file mode 100644 index 000000000..5b9ab2b7f --- /dev/null +++ b/basic/qa/vba_tests/datepart.vb @@ -0,0 +1,94 @@ +Option VBASupport 1 +Option Explicit +Dim passCount As Integer +Dim failCount As Integer +Dim result As String + +Function doUnitTest() As String +result = verify_testDatePart() +If failCount <> 0 or passCount = 0 Then + doUnitTest = result +Else + doUnitTest = "OK" +End If +End Function + + + +Function verify_testDatePart() As String + + passCount = 0 + failCount = 0 + + result = "Test Results" & Chr$(10) & "============" & Chr$(10) + + Dim testName As String + Dim date1 'variables for test + Dim date2 + testName = "Test DatePart function" + On Error GoTo errorHandler + + date2 = 1969 + date1 = DatePart("yyyy", "1969-02-12") + TestLog_ASSERT date1 = date2, "the return DatePart is: " & date1 + + date2 = 1 + date1 = DatePart("q", "1969-02-12") + TestLog_ASSERT date1 = date2, "the return DatePart is: " & date1 + + date2 = 43 + date1 = DatePart("y", "1969-02-12") + TestLog_ASSERT date1 = date2, "the return DatePart is: " & date1 + + date2 = 12 + date1 = DatePart("d", "1969-02-12") + TestLog_ASSERT date1 = date2, "the return DatePart is: " & date1 + + date2 = 4 + date1 = DatePart("w", "1969-02-12") + TestLog_ASSERT date1 = date2, "the return DatePart is: " & date1 + + date2 = 7 + date1 = DatePart("ww", "1969-02-12") + TestLog_ASSERT date1 = date2, "the return DatePart is: " & date1 + + date2 = 16 + date1 = DatePart("h", "1969-02-12 16:32:00") + TestLog_ASSERT date1 = date2, "the return DatePart is: " & date1 + + date2 = 32 + date1 = DatePart("n", "1969-02-12 16:32:00") + TestLog_ASSERT date1 = date2, "the return DatePart is: " & date1 + + date2 = 0 + date1 = DatePart("s", "1969-02-12 16:32:00") + TestLog_ASSERT date1 = date2, "the return DatePart is: " & date1 + + + result = result & Chr$(10) & "Tests passed: " & passCount & Chr$(10) & "Tests failed: " & failCount & Chr$(10) + verify_testDatePart = 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/dateserial.vb b/basic/qa/vba_tests/dateserial.vb new file mode 100644 index 000000000..4b28f09d5 --- /dev/null +++ b/basic/qa/vba_tests/dateserial.vb @@ -0,0 +1,63 @@ +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 Or passCount = 0 Then + doUnitTest = result +Else + doUnitTest = "OK" +End If +End Function + +Function verify_testDateSerial() as String + Dim testName 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 000000000..6ece72a6d --- /dev/null +++ b/basic/qa/vba_tests/datevalue.vb @@ -0,0 +1,63 @@ +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 Or 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 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/day.vb b/basic/qa/vba_tests/day.vb new file mode 100644 index 000000000..e33a7b846 --- /dev/null +++ b/basic/qa/vba_tests/day.vb @@ -0,0 +1,60 @@ +Option VBASupport 1 +Option Explicit +Dim passCount As Integer +Dim failCount As Integer +Dim result As String + +Function doUnitTest() As String +result = verify_testday() +If failCount <> 0 or passCount = 0 Then + doUnitTest = result +Else + doUnitTest = "OK" +End If +End Function + + + +Function verify_testday() As String + + passCount = 0 + failCount = 0 + + result = "Test Results" & Chr$(10) & "============" & Chr$(10) + + Dim testName As String + Dim date1, date2 'variables for test + testName = "Test day function" + On Error GoTo errorHandler + + date2 = 12 + date1 = Day("1969-02-12") '2/12/1969 + TestLog_ASSERT date1 = date2, "the return day is: " & date1 + + result = result & Chr$(10) & "Tests passed: " & passCount & Chr$(10) & "Tests failed: " & failCount & Chr$(10) + verify_testday = 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/enum.vb b/basic/qa/vba_tests/enum.vb new file mode 100644 index 000000000..52dc95a7c --- /dev/null +++ b/basic/qa/vba_tests/enum.vb @@ -0,0 +1,87 @@ +' +' 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/. +' + +Option VBASupport 1 +Option Explicit +Dim passCount As Integer +Dim failCount As Integer +Dim result As String + +Enum CountDown ' Values get ROUNDED to Int32 + FIVE = 4.11 + FOUR = -4.25 + THREE = 5 + TWO = -.315E1 + ONE = 286.0E-2 ' equals 3 + LIFT_OFF = 7 +End Enum ' CountDown + +Function doUnitTest() + ''' test_vba.cxx main entry point ''' + Call ENUM_TestCases + If failCount <> 0 Or passCount = 0 Then + doUnitTest = result + Else + doUnitTest = "OK" + End If +End Function + + +Sub ENUM_TestCases() + + passCount = 0 + failCount = 0 + + result = "Test Results" & vbNewLine & "============" & vbNewLine + +try: + On Error Goto catch + + With CountDown + +a: TestLog_ASSERT .ONE = 3, "case a", "CountDown.ONE equals " & Str(.ONE) + +b: TestLog_ASSERT .TWO = -3, "case b", "CountDown.TWO equals " & Str(.TWO) + +c: TestLog_ASSERT TypeName(.FOUR) = "Long", "case c", "CountDown.FOUR type is: " & TypeName(.FOUR) + +d: Dim sum As Double + sum = .FIVE + .FOUR + .THREE + .TWO + .ONE + .LIFT_OFF + TestLog_Assert sum = 12, "case d", "SUM of CountDown values is: " & Str(sum) + + End With ' CountDown + +finally: + result = result & vbNewLine & "Tests passed: " & passCount & vbNewLine & "Tests failed: " & failCount & vbNewLine + Exit Sub + +catch: + TestLog_ASSERT (False), "ERROR", "#"& Str(Err.Number) &" in 'ENUM_TestCases' at line"& Str(Erl) &" - "& Error$ + Resume Next +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 & vbNewLine & "Failed: " & testMsg + failCount = failCount + 1 + End If + +End Sub + +'Sub DEV_TEST : doUnitTest : MsgBox result : End Sub diff --git a/basic/qa/vba_tests/error.vb b/basic/qa/vba_tests/error.vb new file mode 100644 index 000000000..e36661253 --- /dev/null +++ b/basic/qa/vba_tests/error.vb @@ -0,0 +1,60 @@ +Option VBASupport 1 +Option Explicit +Dim passCount As Integer +Dim failCount As Integer +Dim result As String + +Function doUnitTest() As String +result = verify_testError() +If failCount <> 0 or passCount = 0 Then + doUnitTest = result +Else + doUnitTest = "OK" +End If +End Function + + + +Function verify_testError() As String + + passCount = 0 + failCount = 0 + + result = "Test Results" & Chr$(10) & "============" & Chr$(10) + + Dim testName As String + Dim date1, date2 + testName = "Test Error function" + On Error GoTo errorHandler + + date2 = Error(11) 'https://help.libreoffice.org/Basic/Error_Function_Runtime + date1 = "Division by zero." + TestLog_ASSERT date1 = date2, "the return Error is: " & date2 + + result = result & Chr$(10) & "Tests passed: " & passCount & Chr$(10) & "Tests failed: " & failCount & Chr$(10) + verify_testError = 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/exp.vb b/basic/qa/vba_tests/exp.vb new file mode 100644 index 000000000..669f0d6b0 --- /dev/null +++ b/basic/qa/vba_tests/exp.vb @@ -0,0 +1,60 @@ +Option VBASupport 1 +Option Explicit +Dim passCount As Integer +Dim failCount As Integer +Dim result As String + +Function doUnitTest() As String +result = verify_testExp() +If failCount <> 0 or passCount = 0 Then + doUnitTest = result +Else + doUnitTest = "OK" +End If +End Function + + + +Function verify_testExp() As String + + passCount = 0 + failCount = 0 + + result = "Test Results" & Chr$(10) & "============" & Chr$(10) + + Dim testName As String + Dim date1, date2 + testName = "Test Exp function" + On Error GoTo errorHandler + + date2 = 2.7183 + date1 = Exp(1) + TestLog_ASSERT Round(date1, 4) = Round(date2, 4), "the return Exp is: " & date1 + + result = result & Chr$(10) & "Tests passed: " & passCount & Chr$(10) & "Tests failed: " & failCount & Chr$(10) + verify_testExp = 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/fix.vb b/basic/qa/vba_tests/fix.vb new file mode 100644 index 000000000..95235f335 --- /dev/null +++ b/basic/qa/vba_tests/fix.vb @@ -0,0 +1,68 @@ +Option VBASupport 1 +Option Explicit +Dim passCount As Integer +Dim failCount As Integer +Dim result As String + +Function doUnitTest() As String +result = verify_testFix() +If failCount <> 0 Or passCount = 0 Then + doUnitTest = result +Else + doUnitTest = "OK" +End If +End Function + + + +Function verify_testFix() As String + + passCount = 0 + failCount = 0 + + result = "Test Results" & Chr$(10) & "============" & Chr$(10) + + Dim testName As String + Dim date1, date2 + testName = "Test Fix function" + On Error GoTo errorHandler + + date2 = 12 + date1 = Fix(12.34) + TestLog_ASSERT date1 = date2, "the return Fix is: " & date1 + + date2 = 12 + date1 = Fix(12.99) + TestLog_ASSERT date1 = date2, "the return Fix is: " & date1 + + date2 = -8 + date1 = Fix(-8.4) + TestLog_ASSERT date1 = date2, "the return Fix is: " & date1 + + result = result & Chr$(10) & "Tests passed: " & passCount & Chr$(10) & "Tests failed: " & failCount & Chr$(10) + verify_testFix = 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/format.vb b/basic/qa/vba_tests/format.vb new file mode 100644 index 000000000..6d3fcba8e --- /dev/null +++ b/basic/qa/vba_tests/format.vb @@ -0,0 +1,450 @@ +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 Or 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+###") '1.09838E+000 + TestLog_ASSERT TestStr = "1.09838E+000", "#.#####E+###: " & TestStr + 'MsgBox TestStr + + TestStr = Format(1.09837555, "###.####E#") '1.0984E0 with engineering notation + TestLog_ASSERT TestStr = "1.0984E0", "###.####E#: " & TestStr + 'MsgBox TestStr + + TestStr = Format(1098.37555, "###.####E#") '1.0984E3 with engineering notation + TestLog_ASSERT TestStr = "1.0984E3", "###.####E#: " & TestStr + 'MsgBox TestStr + + TestStr = Format(1098375.55, "###.####E#") '1.0984E6 with engineering notation + TestLog_ASSERT TestStr = "1.0984E6", "###.####E#: " & TestStr + 'MsgBox TestStr + + TestStr = Format(1.09837555, "######E#") '1E0 with engineering notation + TestLog_ASSERT TestStr = "1E0", "######E#: " & TestStr + 'MsgBox TestStr + + TestStr = Format(123456.789, "###E0") '123E3 with engineering notation + TestLog_ASSERT TestStr = "123E3", "###E0: " & TestStr + 'MsgBox TestStr + + TestStr = Format(123567.89, "###E0") '124E3 with engineering notation + TestLog_ASSERT TestStr = "124E3", "###E0: " & TestStr + 'MsgBox TestStr + + TestStr = Format(12, "###E0") '12E0 with engineering notation + TestLog_ASSERT TestStr = "12E0", "###E0: " & TestStr + 'MsgBox TestStr + + TestStr = Format(12, "000E0") '012E0 with engineering notation + TestLog_ASSERT TestStr = "012E0", "000E0: " & TestStr + 'MsgBox TestStr + + TestStr = Format(0.12345, "###E0") '123E-3 with engineering notation + TestLog_ASSERT TestStr = "123E-3", "###E0: " & TestStr + 'MsgBox TestStr + + TestStr = Format(123456, "####E0") '12E4 with interval-4 notation + TestLog_ASSERT TestStr = "12E4", "####E0: " & 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 + + TestStr = Format(12.25, "0.???") '12.25_ + TestLog_ASSERT TestStr = "12.25 ", "0.???: " & 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/formatnumber.vb b/basic/qa/vba_tests/formatnumber.vb new file mode 100644 index 000000000..357fd1942 --- /dev/null +++ b/basic/qa/vba_tests/formatnumber.vb @@ -0,0 +1,83 @@ +Option VBASupport 1 +Option Explicit + +Dim passCount As Integer +Dim failCount As Integer +Dim result As String + +Function doUnitTest() As String +result = verify_testFormatNumber() +If failCount <> 0 Or passCount = 0 Then + doUnitTest = result +Else + doUnitTest = "OK" +End If +End Function + +Function verify_testFormatNumber() As String + + passCount = 0 + failCount = 0 + + result = "Test Results" & Chr$(10) & "============" & Chr$(10) + + Dim testName As String + Dim str1 As String, str2 As String + On Error GoTo errorHandler + + testName = "Test 1: positive, 2 decimals" + str2 = "12.20" + str1 = FormatNumber("12.2", 2, vbFalse, vbFalse, vbFalse) + TestLog_ASSERT str1 = str2, testName, "FormatNumber returned: " & str1 + + testName = "Test 2: negative, 20 decimals, use leading zero" + str2 = "-0.20000000000000000000" + str1 = FormatNumber("-.2", 20, vbTrue, vbFalse, vbFalse) + TestLog_ASSERT str1 = str2, testName, "FormatNumber returned: " & str1 + + testName = "Test 3: negative, 20 decimals, no leading zero" + str2 = "-.20000000000000000000" + str1 = FormatNumber("-0.2", 20, vbFalse, vbFalse, vbFalse) + TestLog_ASSERT str1 = str2, testName, "FormatNumber returned: " & str1 + + testName = "Test 4: negative, no leading zero, use parens" + str2 = "(.20)" + str1 = FormatNumber("-0.2", -1, vbFalse, vbTrue, vbFalse) + TestLog_ASSERT str1 = str2, testName, "FormatNumber returned: " & str1 + + testName = "Test 5: negative, default leading zero, use parens" + str2 = "(0.20)" + str1 = FormatNumber("-0.2", -1, vbUseDefault, vbTrue, vbFalse) + TestLog_ASSERT str1 = str2, testName, "FormatNumber returned: " & str1 + + testName = "Test 6: group digits" + str2 = "-12,345,678.00" + str1 = FormatNumber("-12345678", -1, vbUseDefault, vbUseDefault, vbTrue) + TestLog_ASSERT str1 = str2, testName, "FormatNumber returned: " & str1 + + result = result & Chr$(10) & "Tests passed: " & passCount & Chr$(10) & "Tests failed: " & failCount & Chr$(10) + verify_testFormatNumber = 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 = 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/hex.vb b/basic/qa/vba_tests/hex.vb new file mode 100644 index 000000000..83af4c148 --- /dev/null +++ b/basic/qa/vba_tests/hex.vb @@ -0,0 +1,85 @@ +Option VBASupport 1 +Option Explicit +Dim passCount As Integer +Dim failCount As Integer +Dim result As String + +Function doUnitTest() As String +result = verify_testHex() +If failCount <> 0 Or passCount = 0 Then + doUnitTest = result +Else + doUnitTest = "OK" +End If +End Function + + + +Function verify_testHex() As String + + passCount = 0 + failCount = 0 + + result = "Test Results" & Chr$(10) & "============" & Chr$(10) + + Dim testName As String + Dim date1, date2 + testName = "Test Hex function" + On Error GoTo errorHandler + + date2 = "9" + date1 = Hex(9) + TestLog_ASSERT date1 = date2, "the return Hex is: " & date1 + + date2 = "9" + date1 = Hex(9) + TestLog_ASSERT date1 = date2, "the return Hex is: " & date1 + + date2 = "A" + date1 = Hex(10) + TestLog_ASSERT date1 = date2, "the return Hex is: " & date1 + + date2 = "10" + date1 = Hex(16) + TestLog_ASSERT date1 = date2, "the return Hex is: " & date1 + + date2 = "FF" + date1 = Hex(255) + TestLog_ASSERT date1 = date2, "the return Hex is: " & date1 + + date2 = "100" + date1 = Hex(256) + TestLog_ASSERT date1 = date2, "the return Hex is: " & date1 + + date2 = "1CB" + date1 = Hex(459) + TestLog_ASSERT date1 = date2, "the return Hex is: " & date1 + + + result = result & Chr$(10) & "Tests passed: " & passCount & Chr$(10) & "Tests failed: " & failCount & Chr$(10) + verify_testHex = 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/hour.vb b/basic/qa/vba_tests/hour.vb new file mode 100644 index 000000000..9236463f4 --- /dev/null +++ b/basic/qa/vba_tests/hour.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_testHour() +If failCount <> 0 Or passCount = 0 Then + doUnitTest = result +Else + doUnitTest = "OK" +End If +End Function + + + +Function verify_testHour() As String + + passCount = 0 + failCount = 0 + + result = "Test Results" & Chr$(10) & "============" & Chr$(10) + + Dim testName As String + Dim date1, date2, myTime + testName = "Test Hour function" + On Error GoTo errorHandler + + myTime = "6:25:39 AM" + date2 = 6 + date1 = Hour(myTime) + TestLog_ASSERT date1 = date2, "the return Hour is: " & date1 + + myTime = "6:25:39 PM" + date2 = 18 + date1 = Hour(myTime) + TestLog_ASSERT date1 = date2, "the return Hour is: " & date1 + + myTime = "06:25:39 AM" + date2 = 6 + date1 = Hour(myTime) + TestLog_ASSERT date1 = date2, "the return Hour is: " & date1 + + result = result & Chr$(10) & "Tests passed: " & passCount & Chr$(10) & "Tests failed: " & failCount & Chr$(10) + verify_testHour = 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/iif.vb b/basic/qa/vba_tests/iif.vb new file mode 100644 index 000000000..fd77563e5 --- /dev/null +++ b/basic/qa/vba_tests/iif.vb @@ -0,0 +1,69 @@ +Option VBASupport 1 +Option Explicit +Dim passCount As Integer +Dim failCount As Integer +Dim result As String + +Function doUnitTest() As String +result = verify_testIIf() +If failCount <> 0 Or passCount = 0 Then + doUnitTest = result +Else + doUnitTest = "OK" +End If +End Function + + + +Function verify_testIIf() As String + + passCount = 0 + failCount = 0 + + result = "Test Results" & Chr$(10) & "============" & Chr$(10) + + Dim testName As String + Dim date1, date2, testnr + testName = "Test IIf function" + On Error GoTo errorHandler + + date2 = "it is true" + date1 = IIf(True, "it is true", "it is false") + TestLog_ASSERT date1 = date2, "the return IIf is: " & date1 + + date2 = "it is false" + date1 = IIf(False, "It is true", "it is false") + TestLog_ASSERT date1 = date2, "the return IIf is: " & date1 + + testnr = 1001 + date2 = "Large" + date1 = IIf(testnr > 1000, "Large", "Small") + TestLog_ASSERT date1 = date2, "the return IIf is: " & date1 + + result = result & Chr$(10) & "Tests passed: " & passCount & Chr$(10) & "Tests failed: " & failCount & Chr$(10) + verify_testIIf = 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/instr.vb b/basic/qa/vba_tests/instr.vb new file mode 100644 index 000000000..b8977088b --- /dev/null +++ b/basic/qa/vba_tests/instr.vb @@ -0,0 +1,86 @@ +Option VBASupport 1 +Option Explicit +Dim passCount As Integer +Dim failCount As Integer +Dim result As String + +Function doUnitTest() As String +result = verify_testInStr() +If failCount <> 0 Or passCount = 0 Then + doUnitTest = result +Else + doUnitTest = "OK" +End If +End Function + + + +Function verify_testInStr() As String + + passCount = 0 + failCount = 0 + + result = "Test Results" & Chr$(10) & "============" & Chr$(10) + + Dim testName As String + Dim date1, date2, SearchString, SearchChar + testName = "Test InStr function" + On Error GoTo errorHandler + + date2 = 5 + date1 = InStr(1, "somemoretext", "more") + TestLog_ASSERT date1 = date2, "the return InStr is: " & date1 + + date2 = 5 + date1 = InStr("somemoretext", "more") + TestLog_ASSERT date1 = date2, "the return InStr is: " & date1 + + date2 = 1 + date1 = InStr("somemoretext", "somemoretext") + TestLog_ASSERT date1 = date2, "the return InStr is: " & date1 + + date2 = 0 + date1 = InStr("somemoretext", "nothing") + TestLog_ASSERT date1 = date2, "the return InStr is: " & date1 + + SearchString = "XXpXXpXXPXXP" ' String to search in. + SearchChar = "P" ' Search for "P". + date2 = 6 + date1 = InStr(4, SearchString, SearchChar, 1) + TestLog_ASSERT date1 = date2, "the return InStr is: " & date1 + + date2 = 9 + date1 = InStr(1, SearchString, SearchChar, 0) + TestLog_ASSERT date1 = date2, "the return InStr is: " & date1 + + date2 = 0 + date1 = InStr(1, SearchString, "W") + TestLog_ASSERT date1 = date2, "the return InStr is: " & date1 + + result = result & Chr$(10) & "Tests passed: " & passCount & Chr$(10) & "Tests failed: " & failCount & Chr$(10) + verify_testInStr = 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/instrrev.vb b/basic/qa/vba_tests/instrrev.vb new file mode 100644 index 000000000..7fe02cd60 --- /dev/null +++ b/basic/qa/vba_tests/instrrev.vb @@ -0,0 +1,86 @@ +Option VBASupport 1 +Option Explicit +Dim passCount As Integer +Dim failCount As Integer +Dim result As String + +Function doUnitTest() As String +result = verify_testInStrRev() +If failCount <> 0 or passCount = 0 Then + doUnitTest = result +Else + doUnitTest = "OK" +End If +End Function + + + +Function verify_testInStrRev() As String + + passCount = 0 + failCount = 0 + + result = "Test Results" & Chr$(10) & "============" & Chr$(10) + + Dim testName As String + Dim date1, date2, SearchString, SearchChar + testName = "Test InStrRev function" + On Error GoTo errorHandler + + date2 = 5 + date1 = InStrRev("somemoretext", "more", -1) + TestLog_ASSERT date1 = date2, "the return InStrRev is: " & date1 + + date2 = 5 + date1 = InStrRev("somemoretext", "more") + TestLog_ASSERT date1 = date2, "the return InStrRev is: " & date1 + + date2 = 1 + date1 = InStrRev("somemoretext", "somemoretext") + TestLog_ASSERT date1 = date2, "the return InStrRev is: " & date1 + + date2 = 0 + date1 = InStrRev("somemoretext", "nothing") + TestLog_ASSERT date1 = date2, "the return InStrRev is: " & date1 + + SearchString = "XXpXXpXXPXXP" ' String to search in. + SearchChar = "P" ' Search for "P". + date2 = 3 + date1 = InStrRev(SearchString, SearchChar, 4, 1) + TestLog_ASSERT date1 = date2, "the return InStrRev is: " & date1 + + date2 = 12 + date1 = InStrRev(SearchString, SearchChar, -1, 0) + TestLog_ASSERT date1 = date2, "the return InStrRev is: " & date1 + + date2 = 0 + date1 = InStrRev(SearchString, "W", 1) + TestLog_ASSERT date1 = date2, "the return InStrRev is: " & date1 + + result = result & Chr$(10) & "Tests passed: " & passCount & Chr$(10) & "Tests failed: " & failCount & Chr$(10) + verify_testInStrRev = 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/int.vb b/basic/qa/vba_tests/int.vb new file mode 100644 index 000000000..c5495a87d --- /dev/null +++ b/basic/qa/vba_tests/int.vb @@ -0,0 +1,76 @@ +Option VBASupport 1 +Option Explicit +Dim passCount As Integer +Dim failCount As Integer +Dim result As String + +Function doUnitTest() As String +result = verify_testInt() +If failCount <> 0 Or passCount = 0 Then + doUnitTest = result +Else + doUnitTest = "OK" +End If +End Function + + + +Function verify_testInt() As String + + passCount = 0 + failCount = 0 + + result = "Test Results" & Chr$(10) & "============" & Chr$(10) + + Dim testName As String + Dim date1, date2 + testName = "Test Int function" + On Error GoTo errorHandler + + date2 = 99 + date1 = Int(99.8) + TestLog_ASSERT date1 = date2, "the return Int is: " & date1 + + date2 = -100 + date1 = Int(-99.8) + TestLog_ASSERT date1 = date2, "the return Int is: " & date1 + + date2 = -100 + date1 = Int(-99.2) + TestLog_ASSERT date1 = date2, "the return Int is: " & date1 + + date2 = 0 + date1 = Int(0.2) + TestLog_ASSERT date1 = date2, "the return Int is: " & date1 + + date2 = 0 + date1 = Int(0) + TestLog_ASSERT date1 = date2, "the return Int is: " & date1 + + result = result & Chr$(10) & "Tests passed: " & passCount & Chr$(10) & "Tests failed: " & failCount & Chr$(10) + verify_testInt = 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/isarray.vb b/basic/qa/vba_tests/isarray.vb new file mode 100644 index 000000000..3f7dc8a8c --- /dev/null +++ b/basic/qa/vba_tests/isarray.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_testIsArray() +If failCount <> 0 Or passCount = 0 Then + doUnitTest = result +Else + doUnitTest = "OK" +End If +End Function + + + +Function verify_testIsArray() As String + + passCount = 0 + failCount = 0 + + result = "Test Results" & Chr$(10) & "============" & Chr$(10) + + Dim testName As String + Dim date1, date2 + Dim MyArray(1 To 5) As Integer, YourArray ' Declare array variables. + testName = "Test IsArray function" + On Error GoTo errorHandler + YourArray = Array(1, 2, 3) ' Use Array function. + + date2 = True + date1 = IsArray(MyArray) + TestLog_ASSERT date1 = date2, "the return IsArray is: " & date1 + + date2 = True + date1 = IsArray(YourArray) + TestLog_ASSERT date1 = date2, "the return IsArray is: " & date1 + + date2 = False + date1 = IsArray(date2) + TestLog_ASSERT date1 = date2, "the return IsArray is: " & date1 + + result = result & Chr$(10) & "Tests passed: " & passCount & Chr$(10) & "Tests failed: " & failCount & Chr$(10) + verify_testIsArray = 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/isdate.vb b/basic/qa/vba_tests/isdate.vb new file mode 100644 index 000000000..355c9bb8b --- /dev/null +++ b/basic/qa/vba_tests/isdate.vb @@ -0,0 +1,68 @@ +Option VBASupport 1 +Option Explicit +Dim passCount As Integer +Dim failCount As Integer +Dim result As String + +Function doUnitTest() As String +result = verify_testIsDate() +If failCount <> 0 Or passCount = 0 Then + doUnitTest = result +Else + doUnitTest = "OK" +End If +End Function + + + +Function verify_testIsDate() As String + + passCount = 0 + failCount = 0 + + result = "Test Results" & Chr$(10) & "============" & Chr$(10) + + Dim testName As String + Dim date1, date2 + testName = "Test IsDate function" + On Error GoTo errorHandler + + date2 = True + date1 = IsDate(cdate("12/2/1969")) + TestLog_ASSERT date1 = date2, "the return IsDate is: " & date1 + + date2 = True + date1 = IsDate("12:22:12") + TestLog_ASSERT date1 = date2, "the return IsDate is: " & date1 + + date2 = False + date1 = IsDate("a12.2.1969") + TestLog_ASSERT date1 = date2, "the return IsDate is: " & date1 + + result = result & Chr$(10) & "Tests passed: " & passCount & Chr$(10) & "Tests failed: " & failCount & Chr$(10) + verify_testIsDate = 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/isempty.vb b/basic/qa/vba_tests/isempty.vb new file mode 100644 index 000000000..1080122fa --- /dev/null +++ b/basic/qa/vba_tests/isempty.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_testIsEmpty() +If failCount <> 0 Or passCount = 0 Then + doUnitTest = result +Else + doUnitTest = "OK" +End If +End Function + + + +Function verify_testIsEmpty() As String + + passCount = 0 + failCount = 0 + + result = "Test Results" & Chr$(10) & "============" & Chr$(10) + + Dim testName As String + Dim date1, date2, MyVar + testName = "Test IsEmpty function" + On Error GoTo errorHandler + + date2 = True + date1 = IsEmpty(MyVar) + TestLog_ASSERT date1 = date2, "the return IsEmpty is: " & date1 + + MyVar = Null ' Assign Null. + date2 = False + date1 = IsEmpty(MyVar) + TestLog_ASSERT date1 = date2, "the return IsEmpty is: " & date1 + + MyVar = Empty ' Assign Empty. + date2 = True + date1 = IsEmpty(MyVar) + TestLog_ASSERT date1 = date2, "the return IsEmpty is: " & date1 + + result = result & Chr$(10) & "Tests passed: " & passCount & Chr$(10) & "Tests failed: " & failCount & Chr$(10) + verify_testIsEmpty = 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/iserror.vb b/basic/qa/vba_tests/iserror.vb new file mode 100644 index 000000000..d1a9b2d85 --- /dev/null +++ b/basic/qa/vba_tests/iserror.vb @@ -0,0 +1,64 @@ +Option VBASupport 1 +Option Explicit +Dim passCount As Integer +Dim failCount As Integer +Dim result As String + +Function doUnitTest() As String +result = verify_testIsError() +If failCount <> 0 or passCount = 0 Then + doUnitTest = result +Else + doUnitTest = "OK" +End If +End Function + + + +Function verify_testIsError() As String + + passCount = 0 + failCount = 0 + + result = "Test Results" & Chr$(10) & "============" & Chr$(10) + + Dim testName As String + Dim date1, date2 + testName = "Test IsError function" + On Error GoTo errorHandler + + date2 = False + date1 = IsError("12.2.1969") + TestLog_ASSERT date1 = date2, "the return IsError is: " & date1 + + date2 = True + date1 = IsError(CVErr(64)) + TestLog_ASSERT date1 = date2, "the return IsError is: " & date1 + + result = result & Chr$(10) & "Tests passed: " & passCount & Chr$(10) & "Tests failed: " & failCount & Chr$(10) + verify_testIsError = 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/ismissing.vb b/basic/qa/vba_tests/ismissing.vb new file mode 100644 index 000000000..623c153d4 --- /dev/null +++ b/basic/qa/vba_tests/ismissing.vb @@ -0,0 +1,196 @@ +Option VBASupport 1 + +Dim passCount As Integer +Dim failCount As Integer +Dim result As String + +Const IsMissingNone = -1 +Const IsMissingA = 0 +Const IsMissingB = 1 +Const IsMissingAB = 2 + +Function doUnitTest() As String + result = verify_testIsMissingVba() + If failCount <> 0 Or passCount = 0 Then + doUnitTest = result + Else + doUnitTest = "OK" + End If +End Function + +' tdf#36737 - Test isMissing function with different datatypes. In LO Basic +' with option VBASupport, optional parameters are allowed including additional +' default values. Missing optional parameters having types other than variant, +' which don't have explicit default values, will be initialized to their +' respective default value of its datatype. +Function verify_testIsMissingVba() As String + + passCount = 0 + failCount = 0 + + result = "Test Results" & Chr$(10) & "============" & Chr$(10) + testName = "Test missing (VBA)" + On Error GoTo errorHandler + + ' optionals with variant datatypes + TestLog_ASSERT TestOptVariant(), IsMissingA, "TestOptVariant()" + TestLog_ASSERT TestOptVariant(123), IsMissingNone, "TestOptVariant(123)" + TestLog_ASSERT TestOptVariant(, 456), IsMissingA, "TestOptVariant(, 456)" + TestLog_ASSERT TestOptVariant(123, 456), IsMissingNone, "TestOptVariant(123, 456)" + + ' optionals with variant datatypes (ByRef and ByVal) + TestLog_ASSERT TestOptVariantByRefByVal(), IsMissingA, "TestOptVariantByRefByVal()" + TestLog_ASSERT TestOptVariantByRefByVal(123),IsMissingNone, "TestOptVariantByRefByVal(123)" + TestLog_ASSERT TestOptVariantByRefByVal(, 456), IsMissingA, "TestOptVariantByRefByVal(, 456)" + TestLog_ASSERT TestOptVariantByRefByVal(123, 456), IsMissingNone, "TestOptVariantByRefByVal(123, 456)" + + ' optionals with double datatypes + TestLog_ASSERT TestOptDouble(), IsMissingNone, "TestOptDouble()" + TestLog_ASSERT TestOptDouble(123.4), IsMissingNone, "TestOptDouble(123.4)" + TestLog_ASSERT TestOptDouble(, 567.8), IsMissingNone, "TestOptDouble(, 567.8)" + TestLog_ASSERT TestOptDouble(123.4, 567.8), IsMissingNone, "TestOptDouble(123.4, 567.8)" + + ' optionals with double datatypes (ByRef and ByVal) + TestLog_ASSERT TestOptDoubleByRefByVal(), IsMissingNone, "TestOptDouble()" + TestLog_ASSERT TestOptDoubleByRefByVal(123.4), IsMissingNone, "TestOptDouble(123.4)" + TestLog_ASSERT TestOptDoubleByRefByVal(, 567.8), IsMissingNone, "TestOptDoubleByRefByVal(, 567.8)" + TestLog_ASSERT TestOptDoubleByRefByVal(123.4, 567.8), IsMissingNone, "TestOptDoubleByRefByVal(123.4, 567.8)" + + ' optionals with integer datatypes + TestLog_ASSERT TestOptInteger(), IsMissingNone, "TestOptInteger()" + TestLog_ASSERT TestOptInteger(123), IsMissingNone, "TestOptInteger(123)" + TestLog_ASSERT TestOptInteger(, 456), IsMissingNone, "TestOptInteger(, 456)" + TestLog_ASSERT TestOptInteger(123, 456), IsMissingNone, "TestOptInteger(123, 456)" + + ' optionals with integer datatypes (ByRef and ByVal) + TestLog_ASSERT TestOptIntegerByRefByVal(), IsMissingNone, "TestOptIntegerByRefByVal()" + TestLog_ASSERT TestOptIntegerByRefByVal(123), IsMissingNone, "TestOptIntegerByRefByVal(123)" + TestLog_ASSERT TestOptIntegerByRefByVal(, 456), IsMissingNone, "TestOptIntegerByRefByVal(, 456)" + TestLog_ASSERT TestOptIntegerByRefByVal(123, 456), IsMissingNone, "TestOptIntegerByRefByVal(123, 456)" + + ' optionals with string datatypes + TestLog_ASSERT TestOptString(), IsMissingNone, "TestOptString()" + TestLog_ASSERT TestOptString("123"), IsMissingNone, "TestOptString(""123"")" + TestLog_ASSERT TestOptString(, "456"), IsMissingNone, "TestOptString(, ""456"")" + TestLog_ASSERT TestOptString("123", "456"), IsMissingNone, "TestOptString(""123"", ""456"")" + + ' optionals with string datatypes (ByRef and ByVal) + TestLog_ASSERT TestOptStringByRefByVal(), IsMissingNone, "TestOptStringByRefByVal()" + TestLog_ASSERT TestOptStringByRefByVal("123"), IsMissingNone, "TestOptStringByRefByVal(""123"")" + TestLog_ASSERT TestOptStringByRefByVal(, "456"), IsMissingNone, "TestOptStringByRefByVal(, ""456"")" + TestLog_ASSERT TestOptStringByRefByVal("123", "456"), IsMissingNone, "TestOptStringByRefByVal(""123"", ""456"")" + + ' optionals with object datatypes + Dim cA As New Collection + cA.Add (123) + cA.Add (456) + Dim cB As New Collection + cB.Add (123.4) + cB.Add (567.8) + TestLog_ASSERT TestOptObject(), IsMissingAB, "TestOptObject()" + TestLog_ASSERT TestOptObject(cA), IsMissingB, "TestOptObject(A)" + TestLog_ASSERT TestOptObject(, cB), IsMissingA, "TestOptObject(, B)" + TestLog_ASSERT TestOptObject(cA, cB), IsMissingNone, "TestOptObject(A, B)" + + ' optionals with object datatypes (ByRef and ByVal) + TestLog_ASSERT TestOptObjectByRefByVal(), IsMissingAB, "TestOptObjectByRefByVal()" + TestLog_ASSERT TestOptObjectByRefByVal(cA), IsMissingB, "TestOptObjectByRefByVal(A)" + TestLog_ASSERT TestOptObjectByRefByVal(, cB), IsMissingA, "TestOptObjectByRefByVal(, B)" + TestLog_ASSERT TestOptObjectByRefByVal(cA, cB), IsMissingNone, "TestOptObjectByRefByVal(A, B)" + + ' optionals with array datatypes + Dim aA(0 To 1) As Integer + aA(0) = 123 + aA(1) = 456 + Dim aB(0 To 1) As Variant + aB(0) = 123.4 + aB(1) = 567.8 + ' TODO - New bug report? Scanner initializes variable not as an array + ' TestLog_ASSERT TestOptArray(), IsMissingAB, "TestOptArray()" + ' TestLog_ASSERT TestOptArray(aA), IsMissingB, "TestOptArray(A)" + ' TestLog_ASSERT TestOptArray(, aB), IsMissingA, "TestOptArray(, B)" + TestLog_ASSERT TestOptArray(aA, aB), IsMissingNone, "TestOptArray(A, B)" + + ' optionals with array datatypes (ByRef and ByVal) + ' TODO - New bug report? Scanner initializes variable not as an array + ' TestLog_ASSERT TestOptArrayByRefByVal(), IsMissingAB, "TestOptArrayByRefByVal()" + ' TestLog_ASSERT TestOptArrayByRefByVal(aA), IsMissingB, "TestOptArrayByRefByVal(A)" + ' TestLog_ASSERT TestOptArrayByRefByVal(, aB), IsMissingA, "TestOptArrayByRefByVal(, B)" + TestLog_ASSERT TestOptArrayByRefByVal(aA, aB), IsMissingNone, "TestOptArrayByRefByVal(A, B)" + + result = result & Chr$(10) & "Tests passed: " & passCount & Chr$(10) & "Tests failed: " & failCount & Chr$(10) + verify_testIsMissingVba = result + + Exit Function +errorHandler: + TestLog_ASSERT False, True, Err.Description +End Function + +Function TestOptVariant(Optional A, Optional B As Variant = 123) + TestOptVariant = WhatIsMissing(IsMissing(A), IsMissing(B)) +End Function + +Function TestOptVariantByRefByVal(Optional ByRef A, Optional ByVal B As Variant = 123) + TestOptVariantByRefByVal = WhatIsMissing(IsMissing(A), IsMissing(B)) +End Function + +Function TestOptDouble(Optional A As Double, Optional B As Double = 123.4) + TestOptDouble = WhatIsMissing(IsMissing(A), IsMissing(B)) +End Function + +Function TestOptDoubleByRefByVal(Optional ByRef A As Double, Optional ByVal B As Double = 123.4) + TestOptDoubleByRefByVal = WhatIsMissing(IsMissing(A), IsMissing(B)) +End Function + +Function TestOptInteger(Optional A As Integer, Optional B As Integer = 123) + TestOptInteger = WhatIsMissing(IsMissing(A), IsMissing(B)) +End Function + +Function TestOptIntegerByRefByVal(Optional ByRef A As Integer, Optional ByVal B As Integer = 123) + TestOptIntegerByRefByVal = WhatIsMissing(IsMissing(A), IsMissing(B)) +End Function + +Function TestOptString(Optional A As String, Optional B As String = "123") + TestOptString = WhatIsMissing(IsMissing(A), IsMissing(B)) +End Function + +Function TestOptStringByRefByVal(Optional ByRef A As String, Optional ByVal B As String = "123") + TestOptStringByRefByVal = WhatIsMissing(IsMissing(A), IsMissing(B)) +End Function + +Function TestOptObject(Optional A As Collection, Optional B As Collection) + TestOptObject = WhatIsMissing(IsNull(A), IsNull(B)) +End Function + +Function TestOptObjectByRefByVal(Optional ByRef A As Collection, Optional ByVal B As Collection) + TestOptObjectByRefByVal = WhatIsMissing(IsNull(A), IsNull(B)) +End Function + +Function TestOptArray(Optional A() As Integer, Optional B() As Variant) + TestOptArray = WhatIsMissing(IsEmpty(A), IsEmpty(B)) +End Function + +Function TestOptArrayByRefByVal(Optional ByRef A() As Integer, Optional ByVal B() As Variant) + TestOptArrayByRefByVal = WhatIsMissing(IsEmpty(A), IsEmpty(B)) +End Function + +Function WhatIsMissing(is_missingA, is_missingB) + If is_missingA And is_missingB Then + WhatIsMissing = IsMissingAB + ElseIf is_missingA Then + WhatIsMissing = IsMissingA + ElseIf is_missingB Then + WhatIsMissing = IsMissingB + Else + WhatIsMissing = IsMissingNone + End If +End Function + +Sub TestLog_ASSERT(actual As Variant, expected As Integer, testName As String) + If expected = actual Then + passCount = passCount + 1 + Else + result = result & Chr$(10) & " Failed: " & testName & " returned " & actual & ", expected " & expected + failCount = failCount + 1 + End If +End Sub
\ No newline at end of file diff --git a/basic/qa/vba_tests/isnull.vb b/basic/qa/vba_tests/isnull.vb new file mode 100644 index 000000000..145294f6d --- /dev/null +++ b/basic/qa/vba_tests/isnull.vb @@ -0,0 +1,64 @@ +Option VBASupport 1 +Option Explicit +Dim passCount As Integer +Dim failCount As Integer +Dim result As String + +Function doUnitTest() As String +result = verify_testIsNull() +If failCount <> 0 Or passCount = 0 Then + doUnitTest = result +Else + doUnitTest = "OK" +End If +End Function + + + +Function verify_testIsNull() As String + + passCount = 0 + failCount = 0 + + result = "Test Results" & Chr$(10) & "============" & Chr$(10) + + Dim testName As String + Dim date1, date2 + testName = "Test IsNull function" + On Error GoTo errorHandler + + date2 = True + date1 = IsNull(Null) + TestLog_ASSERT date1 = date2, "the return IsNull is: " & date1 + + date2 = False + date1 = IsNull("") + TestLog_ASSERT date1 = date2, "the return IsNull is: " & date1 + + result = result & Chr$(10) & "Tests passed: " & passCount & Chr$(10) & "Tests failed: " & failCount & Chr$(10) + verify_testIsNull = 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/isnumeric.vb b/basic/qa/vba_tests/isnumeric.vb new file mode 100644 index 000000000..2383f4bfe --- /dev/null +++ b/basic/qa/vba_tests/isnumeric.vb @@ -0,0 +1,80 @@ +Option VBASupport 1 +Option Explicit +Dim passCount As Integer +Dim failCount As Integer +Dim result As String + +Function doUnitTest() As String +result = verify_testIsNumeric() +If failCount <> 0 Or passCount = 0 Then + doUnitTest = result +Else + doUnitTest = "OK" +End If +End Function + + + +Function verify_testIsNumeric() As String + + passCount = 0 + failCount = 0 + + result = "Test Results" & Chr$(10) & "============" & Chr$(10) + + Dim testName As String + Dim date1, date2 + testName = "Test IsNumeric function" + On Error GoTo errorHandler + + date2 = True + date1 = IsNumeric(123) + TestLog_ASSERT date1 = date2, "the return IsNumeric is: " & date1 + + date2 = True + date1 = IsNumeric(-123) + TestLog_ASSERT date1 = date2, "the return IsNumeric is: " & date1 + + date2 = True + date1 = IsNumeric(123.8) + TestLog_ASSERT date1 = date2, "the return IsNumeric is: " & date1 + + date2 = False + date1 = IsNumeric("a") + TestLog_ASSERT date1 = date2, "the return IsNumeric is: " & date1 + +rem date2 = True +rem date1 = IsNumeric(True) +rem TestLog_ASSERT date1 = date2, "the return IsNumeric is: " & date1 + + date2 = True + date1 = IsNumeric("123") + TestLog_ASSERT date1 = date2, "the return IsNumeric is: " & date1 + + result = result & Chr$(10) & "Tests passed: " & passCount & Chr$(10) & "Tests failed: " & failCount & Chr$(10) + verify_testIsNumeric = 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/isobject.vb b/basic/qa/vba_tests/isobject.vb new file mode 100644 index 000000000..82a1a0aa3 --- /dev/null +++ b/basic/qa/vba_tests/isobject.vb @@ -0,0 +1,67 @@ +Option VBASupport 1 +Option Explicit +Dim passCount As Integer +Dim failCount As Integer +Dim result As String + +Function doUnitTest() As String +result = verify_testIsObject() +If failCount <> 0 Or passCount = 0 Then + doUnitTest = result +Else + doUnitTest = "OK" +End If +End Function + + + +Function verify_testIsObject() As String + + passCount = 0 + failCount = 0 + + result = "Test Results" & Chr$(10) & "============" & Chr$(10) + + Dim testName As String + Dim TestStr As String + Dim MyObject As Object + Dim date1, date2, YourObject + testName = "Test IsObject function" + On Error GoTo errorHandler + + Set YourObject = MyObject ' Assign an object reference. + date2 = True + date1 = IsObject(YourObject) + TestLog_ASSERT date1 = date2, "the return IsObject is: " & date1 + + date2 = False + date1 = IsObject(TestStr) + TestLog_ASSERT date1 = date2, "the return IsObject is: " & date1 + + result = result & Chr$(10) & "Tests passed: " & passCount & Chr$(10) & "Tests failed: " & failCount & Chr$(10) + verify_testIsObject = 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/join.vb b/basic/qa/vba_tests/join.vb new file mode 100644 index 000000000..e09cf8ac8 --- /dev/null +++ b/basic/qa/vba_tests/join.vb @@ -0,0 +1,76 @@ +Option VBASupport 1 +Option Explicit +Dim passCount As Integer +Dim failCount As Integer +Dim result As String + +Function doUnitTest() As String +result = verify_testJoin() +If failCount <> 0 Or passCount = 0 Then + doUnitTest = result +Else + doUnitTest = "OK" +End If +End Function + + + +Function verify_testJoin() As String + + passCount = 0 + failCount = 0 + + result = "Test Results" & Chr$(10) & "============" & Chr$(10) + + Dim testName As String + Dim str1, str2 As String + Dim vaArray(2) As String + testName = "Test Join function" + On Error GoTo errorHandler + vaArray(0) = "string1" + vaArray(1) = "string2" + vaArray(2) = "string3" + + str2 = "string1 string2 string3" + str1 = Join(vaArray) + TestLog_ASSERT str1 = str2, "the return Join is: " & str1 + + str2 = "string1 string2 string3" + str1 = Join(vaArray, " ") + TestLog_ASSERT str1 = str2, "the return Join is: " & str1 + + str2 = "string1<>string2<>string3" + str1 = Join(vaArray, "<>") + TestLog_ASSERT str1 = str2, "the return Join is: " & str1 + + str2 = "string1string2string3" + str1 = Join(vaArray, "") + TestLog_ASSERT str1 = str2, "the return Join is: " & str1 + + result = result & Chr$(10) & "Tests passed: " & passCount & Chr$(10) & "Tests failed: " & failCount & Chr$(10) + verify_testJoin = 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/lbound.vb b/basic/qa/vba_tests/lbound.vb new file mode 100644 index 000000000..34999c534 --- /dev/null +++ b/basic/qa/vba_tests/lbound.vb @@ -0,0 +1,66 @@ +Option VBASupport 1 +Option Explicit +Dim passCount As Integer +Dim failCount As Integer +Dim result As String + +Function doUnitTest() As String +result = verify_testLBound() +If failCount <> 0 Or passCount = 0 Then + doUnitTest = result +Else + doUnitTest = "OK" +End If +End Function + + + +Function verify_testLBound() As String + + passCount = 0 + failCount = 0 + + result = "Test Results" & Chr$(10) & "============" & Chr$(10) + + Dim testName As String + Dim date1, date2 + Dim MyArray(1 To 10, 5 To 15, 10 To 20) ' Declare array variables. + testName = "Test LBound function" + On Error GoTo errorHandler + + date2 = 1 + date1 = LBound(MyArray, 1) + TestLog_ASSERT date1 = date2, "the return LBound is: " & date1 + + date2 = 10 + date1 = LBound(MyArray, 3) + TestLog_ASSERT date1 = date2, "the return LBound is: " & date1 + + + result = result & Chr$(10) & "Tests passed: " & passCount & Chr$(10) & "Tests failed: " & failCount & Chr$(10) + verify_testLBound = 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/lcase.vb b/basic/qa/vba_tests/lcase.vb new file mode 100644 index 000000000..d0916341d --- /dev/null +++ b/basic/qa/vba_tests/lcase.vb @@ -0,0 +1,73 @@ +Option VBASupport 1 +Option Explicit +Dim passCount As Integer +Dim failCount As Integer +Dim result As String + +Function doUnitTest() As String +result = verify_testLCase() +If failCount <> 0 Or passCount = 0 Then + doUnitTest = result +Else + doUnitTest = "OK" +End If +End Function + + + +Function verify_testLCase() As String + + passCount = 0 + failCount = 0 + + result = "Test Results" & Chr$(10) & "============" & Chr$(10) + + Dim testName As String + Dim str1, str2 As String 'variables for test + testName = "Test LCase function" + On Error GoTo errorHandler + + str2 = "lowercase" + str1 = LCase("LOWERCASE") + TestLog_ASSERT str1 = str2, "the return LCase is: " & str1 + + str2 = "lowercase" + str1 = LCase("LowerCase") + TestLog_ASSERT str1 = str2, "the return LCase is: " & str1 + + str2 = "lowercase" + str1 = LCase("lowercase") + TestLog_ASSERT str1 = str2, "the return LCase is: " & str1 + + str2 = "lower case" + str1 = LCase("LOWER CASE") + TestLog_ASSERT str1 = str2, "the return LCase is: " & str1 + + + result = result & Chr$(10) & "Tests passed: " & passCount & Chr$(10) & "Tests failed: " & failCount & Chr$(10) + verify_testLCase = 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/left.vb b/basic/qa/vba_tests/left.vb new file mode 100644 index 000000000..8a6576fd2 --- /dev/null +++ b/basic/qa/vba_tests/left.vb @@ -0,0 +1,68 @@ +Option VBASupport 1 +Option Explicit +Dim passCount As Integer +Dim failCount As Integer +Dim result As String + +Function doUnitTest() As String +result = verify_testLeft() +If failCount <> 0 Or passCount = 0 Then + doUnitTest = result +Else + doUnitTest = "OK" +End If +End Function + + + +Function verify_testLeft() As String + + passCount = 0 + failCount = 0 + + result = "Test Results" & Chr$(10) & "============" & Chr$(10) + + Dim testName As String + Dim date1, date2 + testName = "Test Left function" + On Error GoTo errorHandler + + date2 = "some" + date1 = Left("sometext", 4) + TestLog_ASSERT date1 = date2, "the return Left is: " & date1 + + date2 = "sometext" + date1 = Left("sometext", 48) + TestLog_ASSERT date1 = date2, "the return Left is: " & date1 + + date2 = "" + date1 = Left("", 4) + TestLog_ASSERT date1 = date2, "the return Left is: " & date1 + + result = result & Chr$(10) & "Tests passed: " & passCount & Chr$(10) & "Tests failed: " & failCount & Chr$(10) + verify_testLeft = 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/len.vb b/basic/qa/vba_tests/len.vb new file mode 100644 index 000000000..d524d96b8 --- /dev/null +++ b/basic/qa/vba_tests/len.vb @@ -0,0 +1,69 @@ +Option VBASupport 1 +Option Explicit +Dim passCount As Integer +Dim failCount As Integer +Dim result As String + +Function doUnitTest() As String +result = verify_testLen() +If failCount <> 0 Or passCount = 0 Then + doUnitTest = result +Else + doUnitTest = "OK" +End If +End Function + + + +Function verify_testLen() As String + + passCount = 0 + failCount = 0 + + result = "Test Results" & Chr$(10) & "============" & Chr$(10) + + Dim testName As String + Dim date1, date2 + testName = "Test Len function" + On Error GoTo errorHandler + + date2 = 8 + date1 = Len("sometext") + TestLog_ASSERT date1 = date2, "the return Len is: " & date1 + + date2 = 9 + date1 = Len("some text") + TestLog_ASSERT date1 = date2, "the return Len is: " & date1 + + date2 = 0 + date1 = Len("") + TestLog_ASSERT date1 = date2, "the return Len is: " & date1 + + + result = result & Chr$(10) & "Tests passed: " & passCount & Chr$(10) & "Tests failed: " & failCount & Chr$(10) + verify_testLen = 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/log.vb b/basic/qa/vba_tests/log.vb new file mode 100644 index 000000000..08656bdf5 --- /dev/null +++ b/basic/qa/vba_tests/log.vb @@ -0,0 +1,68 @@ +Option VBASupport 1 +Option Explicit +Dim passCount As Integer +Dim failCount As Integer +Dim result As String + +Function doUnitTest() As String +result = verify_testLog() +If failCount <> 0 or passCount = 0 Then + doUnitTest = result +Else + doUnitTest = "OK" +End If +End Function + + + +Function verify_testLog() As String + + passCount = 0 + failCount = 0 + + result = "Test Results" & Chr$(10) & "============" & Chr$(10) + + Dim testName As String + Dim date1, date2 + testName = "Test Log function" + On Error GoTo errorHandler + + date2 = 4.454 + date1 = Log(86) + TestLog_ASSERT Round(date1, 3) = Round(date2, 3), "the return Log is: " & date1 + + date2 = 4 + date1 = Exp(Log(4)) + TestLog_ASSERT date1 = date2, "the return Log is: " & date1 + + date2 = 1 + date1 = Log(2.7182818) + TestLog_ASSERT Round(date1, 3) = Round(date2, 3), "the return Log is: " & date1 + + result = result & Chr$(10) & "Tests passed: " & passCount & Chr$(10) & "Tests failed: " & failCount & Chr$(10) + verify_testLog = 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/ltrim.vb b/basic/qa/vba_tests/ltrim.vb new file mode 100644 index 000000000..d85d02a76 --- /dev/null +++ b/basic/qa/vba_tests/ltrim.vb @@ -0,0 +1,60 @@ +Option VBASupport 1 +Option Explicit +Dim passCount As Integer +Dim failCount As Integer +Dim result As String + +Function doUnitTest() As String +result = verify_testLTrim() +If failCount <> 0 Or passCount = 0 Then + doUnitTest = result +Else + doUnitTest = "OK" +End If +End Function + + + +Function verify_testLTrim() As String + + passCount = 0 + failCount = 0 + + result = "Test Results" & Chr$(10) & "============" & Chr$(10) + + Dim testName As String + Dim date1, date2 + testName = "Test LTrim function" + On Error GoTo errorHandler + + date2 = "some text " + date1 = LTrim(" some text ") + TestLog_ASSERT date1 = date2, "the return LTrim is: " & date1 + + result = result & Chr$(10) & "Tests passed: " & passCount & Chr$(10) & "Tests failed: " & failCount & Chr$(10) + verify_testLTrim = 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/mid.vb b/basic/qa/vba_tests/mid.vb new file mode 100644 index 000000000..b7070b33b --- /dev/null +++ b/basic/qa/vba_tests/mid.vb @@ -0,0 +1,69 @@ +Option VBASupport 1 +Option Explicit +Dim passCount As Integer +Dim failCount As Integer +Dim result As String + +Function doUnitTest() As String +result = verify_testMid() +If failCount <> 0 Or passCount = 0 Then + doUnitTest = result +Else + doUnitTest = "OK" +End If +End Function + + + +Function verify_testMid() As String + + passCount = 0 + failCount = 0 + + result = "Test Results" & Chr$(10) & "============" & Chr$(10) + + Dim testName As String + Dim date1, date2 + testName = "Test Mid function" + On Error GoTo errorHandler + + date2 = "Mid" + date1 = Mid("Mid Function Demo", 1, 3) + TestLog_ASSERT date1 = date2, "the return Mid is: " & date1 + + date2 = "Demo" + date1 = Mid("Mid Function Demo", 14, 4) + TestLog_ASSERT date1 = date2, "the return Mid is: " & date1 + + date2 = "Function Demo" + date1 = Mid("Mid Function Demo", 5) + TestLog_ASSERT date1 = date2, "the return Mid is: " & date1 + + + result = result & Chr$(10) & "Tests passed: " & passCount & Chr$(10) & "Tests failed: " & failCount & Chr$(10) + verify_testMid = 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/minute.vb b/basic/qa/vba_tests/minute.vb new file mode 100644 index 000000000..20761b1e7 --- /dev/null +++ b/basic/qa/vba_tests/minute.vb @@ -0,0 +1,60 @@ +Option VBASupport 1 +Option Explicit +Dim passCount As Integer +Dim failCount As Integer +Dim result As String + +Function doUnitTest() As String +result = verify_testMinute() +If failCount <> 0 Or passCount = 0 Then + doUnitTest = result +Else + doUnitTest = "OK" +End If +End Function + + + +Function verify_testMinute() As String + + passCount = 0 + failCount = 0 + + result = "Test Results" & Chr$(10) & "============" & Chr$(10) + + Dim testName As String + Dim date1, date2 + testName = "Test Minute function" + On Error GoTo errorHandler + + date2 = 34 + date1 = Minute("09:34:20") + TestLog_ASSERT date1 = date2, "the return Minute is: " & date1 + + result = result & Chr$(10) & "Tests passed: " & passCount & Chr$(10) & "Tests failed: " & failCount & Chr$(10) + verify_testMinute = 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/month.vb b/basic/qa/vba_tests/month.vb new file mode 100644 index 000000000..98d614a57 --- /dev/null +++ b/basic/qa/vba_tests/month.vb @@ -0,0 +1,79 @@ +Option VBASupport 1 +Option Explicit +Dim passCount As Integer +Dim failCount As Integer +Dim result As String + +Function doUnitTest() As String +result = verify_testMonth() +If failCount <> 0 Or passCount = 0 Then + doUnitTest = result +Else + doUnitTest = "OK" +End If +End Function + + + +Function verify_testMonth() As String + + passCount = 0 + failCount = 0 + + result = "Test Results" & Chr$(10) & "============" & Chr$(10) + + Dim testName As String + Dim date1, date2 + Dim ldate As Date + testName = "Test Month function" + On Error GoTo errorHandler + ldate = 32616 + + date2 = 4 + date1 = Month(ldate) + TestLog_ASSERT date1 = date2, "the return Month is: " & date1 + + date2 = 2 + date1 = Month("01/02/2007") + TestLog_ASSERT date1 = date2, "the return Month is: " & date1 + + date2 = 12 + date1 = Month(1) + TestLog_ASSERT date1 = date2, "the return Month is: " & date1 + + date2 = 2 + date1 = Month(60) + TestLog_ASSERT date1 = date2, "the return Month is: " & date1 + + date2 = 6 + date1 = Month(2000) + TestLog_ASSERT date1 = date2, "the return Month is: " & date1 + + + result = result & Chr$(10) & "Tests passed: " & passCount & Chr$(10) & "Tests failed: " & failCount & Chr$(10) + verify_testMonth = 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/monthname.vb b/basic/qa/vba_tests/monthname.vb new file mode 100644 index 000000000..627f9095b --- /dev/null +++ b/basic/qa/vba_tests/monthname.vb @@ -0,0 +1,68 @@ +Option VBASupport 1 +Option Explicit +Dim passCount As Integer +Dim failCount As Integer +Dim result As String + +Function doUnitTest() As String +result = verify_testMonthName() +If failCount <> 0 or passCount = 0 Then + doUnitTest = result +Else + doUnitTest = "OK" +End If +End Function + + + +Function verify_testMonthName() As String + + passCount = 0 + failCount = 0 + + result = "Test Results" & Chr$(10) & "============" & Chr$(10) + + Dim testName As String + Dim date1, date2 + testName = "Test MonthName function" + On Error GoTo errorHandler + + date2 = "February" + date1 = MonthName(2) + TestLog_ASSERT date1 = date2, "the return MonthName is: " & date1 + + date2 = "Feb" + date1 = MonthName(2, True) + TestLog_ASSERT date1 = date2, "the return MonthName is: " & date1 + + date2 = "February" + date1 = MonthName(2, False) + TestLog_ASSERT date1 = date2, "the return MonthName is: " & date1 + + result = result & Chr$(10) & "Tests passed: " & passCount & Chr$(10) & "Tests failed: " & failCount & Chr$(10) + verify_testMonthName = 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/oct.vb b/basic/qa/vba_tests/oct.vb new file mode 100644 index 000000000..52feef2c8 --- /dev/null +++ b/basic/qa/vba_tests/oct.vb @@ -0,0 +1,68 @@ +Option VBASupport 1 +Option Explicit +Dim passCount As Integer +Dim failCount As Integer +Dim result As String + +Function doUnitTest() As String +result = verify_testOct() +If failCount <> 0 Or passCount = 0 Then + doUnitTest = result +Else + doUnitTest = "OK" +End If +End Function + + + +Function verify_testOct() As String + + passCount = 0 + failCount = 0 + + result = "Test Results" & Chr$(10) & "============" & Chr$(10) + + Dim testName As String + Dim date1, date2 + testName = "Test Oct function" + On Error GoTo errorHandler + + date2 = 4 + date1 = Oct(4) + TestLog_ASSERT date1 = date2, "the return Oct is: " & date1 + + date2 = 10 + date1 = Oct(8) + TestLog_ASSERT date1 = date2, "the return Oct is: " & date1 + + date2 = 713 + date1 = Oct(459) + TestLog_ASSERT date1 = date2, "the return Oct is: " & date1 + + result = result & Chr$(10) & "Tests passed: " & passCount & Chr$(10) & "Tests failed: " & failCount & Chr$(10) + verify_testOct = 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/ole_ObjAssignNoDflt.vb b/basic/qa/vba_tests/ole_ObjAssignNoDflt.vb new file mode 100644 index 000000000..b1a591b0c --- /dev/null +++ b/basic/qa/vba_tests/ole_ObjAssignNoDflt.vb @@ -0,0 +1,30 @@ +Option VBASupport 1 +Function doUnitTest(TestData as String, Driver as String) as String +Rem Ensure object assignment is by reference +Rem when object member is used ( as lhs ) +Dim origTimeout As Long +Dim modifiedTimeout As Long +Set cn = New ADODB.Connection +origTimeout = cn.CommandTimeout +modifiedTimeout = origTimeout * 2 +cn.CommandTimeout = modifiedTimeout +Dim conStr As String +conStr = "Provider=MSDASQL;Driver={" & Driver & "};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 original 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 000000000..d68664b41 --- /dev/null +++ b/basic/qa/vba_tests/ole_ObjAssignToNothing.vb @@ -0,0 +1,19 @@ +Option VBASupport 1 +Function doUnitTest(TestData as String, Driver 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={" & Driver & "};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/optional_paramters.vb b/basic/qa/vba_tests/optional_paramters.vb new file mode 100644 index 000000000..2f527e5d7 --- /dev/null +++ b/basic/qa/vba_tests/optional_paramters.vb @@ -0,0 +1,215 @@ +Option VBASupport 1 + +Dim passCount As Integer +Dim failCount As Integer +Dim result As String + +Function doUnitTest() As String + result = verify_testOptionalsVba() + If failCount <> 0 Or passCount = 0 Then + doUnitTest = result + Else + doUnitTest = "OK" + End If +End Function + +' tdf#36737 - Test optionals with different datatypes. In LO Basic +' with option VBASupport, optional parameters are allowed including additional +' default values. Missing optional parameters having types other than variant, +' which don't have explicit default values, will be initialized to their +' respective default value of its datatype +Function verify_testOptionalsVba() As String + + passCount = 0 + failCount = 0 + + result = "Test Results" & Chr$(10) & "============" & Chr$(10) + testName = "Test optionals (VBA)" + On Error GoTo errorHandler + + ' optionals with variant datatypes + TestLog_ASSERT TestOptVariant(), 123, "TestOptVariant()" + TestLog_ASSERT TestOptVariant(123), 246, "TestOptVariant(123)" + TestLog_ASSERT TestOptVariant(, 456), 456, "TestOptVariant(, 456)" + TestLog_ASSERT TestOptVariant(123, 456), 579, "TestOptVariant(123, 456)" + + ' optionals with variant datatypes (ByRef and ByVal) + TestLog_ASSERT TestOptVariantByRefByVal(), 123, "TestOptVariantByRefByVal()" + TestLog_ASSERT TestOptVariantByRefByVal(123), 246, "TestOptVariantByRefByVal(123)" + TestLog_ASSERT TestOptVariantByRefByVal(, 456), 456, "TestOptVariantByRefByVal(, 456)" + TestLog_ASSERT TestOptVariantByRefByVal(123, 456), 579, "TestOptVariantByRefByVal(123, 456)" + + ' optionals with double datatypes + TestLog_ASSERT TestOptDouble(), 123.4, "TestOptDouble()" + TestLog_ASSERT TestOptDouble(123.4), 246.8, "TestOptDouble(123.4)" + TestLog_ASSERT TestOptDouble(, 567.8), 567.8, "TestOptDouble(, 567.8)" + TestLog_ASSERT Format(TestOptDouble(123.4, 567.8), "0.0"), 691.2, "TestOptDouble(123.4, 567.8)" + + ' optionals with double datatypes (ByRef and ByVal) + TestLog_ASSERT TestOptDoubleByRefByVal(), 123.4, "TestOptDouble()" + TestLog_ASSERT TestOptDoubleByRefByVal(123.4), 246.8, "TestOptDouble(123.4)" + TestLog_ASSERT TestOptDoubleByRefByVal(, 567.8), 567.8, "TestOptDoubleByRefByVal(, 567.8)" + TestLog_ASSERT Format(TestOptDoubleByRefByVal(123.4, 567.8), "0.0"), 691.2, "TestOptDoubleByRefByVal(123.4, 567.8)" + + ' optionals with integer datatypes + TestLog_ASSERT TestOptInteger(), 123, "TestOptInteger()" + TestLog_ASSERT TestOptInteger(123), 246, "TestOptInteger(123)" + TestLog_ASSERT TestOptInteger(, 456), 456, "TestOptInteger(, 456)" + TestLog_ASSERT TestOptInteger(123, 456), 579, "TestOptInteger(123, 456)" + + ' optionals with integer datatypes (ByRef and ByVal) + TestLog_ASSERT TestOptIntegerByRefByVal(), 123, "TestOptIntegerByRefByVal()" + TestLog_ASSERT TestOptIntegerByRefByVal(123), 246, "TestOptIntegerByRefByVal(123)" + TestLog_ASSERT TestOptIntegerByRefByVal(, 456), 456, "TestOptIntegerByRefByVal(, 456)" + TestLog_ASSERT TestOptIntegerByRefByVal(123, 456), 579, "TestOptIntegerByRefByVal(123, 456)" + + ' optionals with string datatypes + TestLog_ASSERT TestOptString(), "123", "TestOptString()" + TestLog_ASSERT TestOptString("123"), "123123", "TestOptString(""123"")" + TestLog_ASSERT TestOptString(, "456"), "456", "TestOptString(, ""456"")" + TestLog_ASSERT TestOptString("123", "456"), "123456", "TestOptString(""123"", ""456"")" + + ' optionals with string datatypes (ByRef and ByVal) + TestLog_ASSERT TestOptStringByRefByVal(), "123", "TestOptStringByRefByVal()" + TestLog_ASSERT TestOptStringByRefByVal("123"), "123123", "TestOptStringByRefByVal(""123"")" + TestLog_ASSERT TestOptStringByRefByVal(, "456"), "456", "TestOptStringByRefByVal(, ""456"")" + TestLog_ASSERT TestOptStringByRefByVal("123", "456"), "123456", "TestOptStringByRefByVal(""123"", ""456"")" + + ' optionals with object datatypes + Dim cA As New Collection + cA.Add (123) + cA.Add (456) + Dim cB As New Collection + cB.Add (123.4) + cB.Add (567.8) + TestLog_ASSERT TestOptObject(), 0, "TestOptObject()" + TestLog_ASSERT TestOptObject(cA), 579, "TestOptObject(A)" + TestLog_ASSERT Format(TestOptObject(, cB), "0.0"), 691.2, "TestOptObject(, B)" + TestLog_ASSERT Format(TestOptObject(cA, cB), "0.0"), 1270.2, "TestOptObject(A, B)" + + ' optionals with object datatypes (ByRef and ByVal) + TestLog_ASSERT TestOptObjectByRefByVal(), 0, "TestOptObjectByRefByVal()" + TestLog_ASSERT TestOptObjectByRefByVal(cA), 579, "TestOptObjectByRefByVal(A)" + TestLog_ASSERT Format(TestOptObjectByRefByVal(, cB), "0.0"), 691.2, "TestOptObjectByRefByVal(, B)" + TestLog_ASSERT Format(TestOptObjectByRefByVal(cA, cB), "0.0"), 1270.2, "TestOptObjectByRefByVal(A, B)" + + ' optionals with array datatypes + Dim aA(0 To 1) As Integer + aA(0) = 123 + aA(1) = 456 + Dim aB(0 To 1) As Variant + aB(0) = 123.4 + aB(1) = 567.8 + ' TODO - New bug report? Scanner initializes variable not as an array + ' TestLog_ASSERT TestOptArray(), 0, "TestOptArray()" + ' TestLog_ASSERT TestOptArray(aA), 579, "TestOptArray(A)" + ' TestLog_ASSERT Format(TestOptArray(, aB), "0.0"), 691.2, "TestOptArray(, B)" + TestLog_ASSERT Format(TestOptArray(aA, aB), "0.0"), 1270.2, "TestOptArray(A, B)" + + ' optionals with array datatypes (ByRef and ByVal) + ' TODO - New bug report? Scanner initializes variable not as an array + ' TestLog_ASSERT TestOptArrayByRefByVal(), 0, "TestOptArrayByRefByVal()" + ' TestLog_ASSERT TestOptArrayByRefByVal(aA), 579, "TestOptArrayByRefByVal(A)" + ' TestLog_ASSERT Format(TestOptArrayByRefByVal(, aB), "0.0"), 691.2, "TestOptArrayByRefByVal(, B)" + TestLog_ASSERT Format(TestOptArrayByRefByVal(aA, aB), "0.0"), 1270.2, "TestOptArrayByRefByVal(A, B)" + + result = result & Chr$(10) & "Tests passed: " & passCount & Chr$(10) & "Tests failed: " & failCount & Chr$(10) + verify_testOptionalsVba = result + + Exit Function +errorHandler: + TestLog_ASSERT False, True, Err.Description +End Function + +Function TestOptVariant(Optional A, Optional B As Variant = 123) + TestOptVariant = OptNumberSum(IsMissing(A), A, IsMissing(B), B) +End Function + +Function TestOptVariantByRefByVal(Optional ByRef A, Optional ByVal B As Variant = 123) + TestOptVariantByRefByVal = OptNumberSum(IsMissing(A), A, IsMissing(B), B) +End Function + +Function TestOptDouble(Optional A As Double, Optional B As Double = 123.4) + TestOptDouble = OptNumberSum(IsMissing(A), A, IsMissing(B), B) +End Function + +Function TestOptDoubleByRefByVal(Optional ByRef A As Double, Optional ByVal B As Double = 123.4) + TestOptDoubleByRefByVal = OptNumberSum(IsMissing(A), A, IsMissing(B), B) +End Function + +Function TestOptInteger(Optional A As Integer, Optional B As Integer = 123) + TestOptInteger = OptNumberSum(IsMissing(A), A, IsMissing(B), B) +End Function + +Function TestOptIntegerByRefByVal(Optional ByRef A As Integer, Optional ByVal B As Integer = 123) + TestOptIntegerByRefByVal = OptNumberSum(IsMissing(A), A, IsMissing(B), B) +End Function + +Function TestOptString(Optional A As String, Optional B As String = "123") + TestOptString = OptStringConcat(IsMissing(A), A, IsMissing(B), B) +End Function + +Function TestOptStringByRefByVal(Optional ByRef A As String, Optional ByVal B As String = "123") + TestOptStringByRefByVal = OptStringConcat(IsMissing(A), A, IsMissing(B), B) +End Function + +Function TestOptObject(Optional A As Collection, Optional B As Collection) + ' TODO - isMissing returns false even though the collection is null and is missing? + TestOptObject = 0 + If Not IsNull(A) Then TestOptObject = CollectionSum(A) + If Not IsNull(B) Then TestOptObject = TestOptObject + CollectionSum(B) +End Function + +Function TestOptObjectByRefByVal(Optional ByRef A As Collection, Optional ByVal B As Collection) + ' TODO - isMissing returns false even though the collection is null and is missing? + TestOptObjectByRefByVal = 0 + If Not IsNull(A) Then TestOptObjectByRefByVal = CollectionSum(A) + If Not IsNull(B) Then TestOptObjectByRefByVal = TestOptObjectByRefByVal + CollectionSum(B) +End Function + +Function TestOptArray(Optional A() As Integer, Optional B() As Variant) + TestOptArray = ArraySum(IsMissing(A), A) + ArraySum(IsMissing(B), B) +End Function + +Function TestOptArrayByRefByVal(Optional ByRef A() As Integer, Optional ByVal B() As Variant) + TestOptArrayByRefByVal = ArraySum(IsMissing(A), A) + ArraySum(IsMissing(B), B) +End Function + +Function OptNumberSum(is_missingA As Boolean, A, is_missingB As Boolean, B) + OptNumberSum = 0 + If Not is_missingA Then OptNumberSum = A + If Not is_missingB Then OptNumberSum = OptNumberSum + B +End Function + +Function OptStringConcat(is_missingA As Boolean, A, is_missingB As Boolean, B) + OptStringConcat = "" + If Not is_missingA Then OptStringConcat = A + If Not is_missingB Then OptStringConcat = OptStringConcat & B +End Function + +Function CollectionSum(C) + Dim idx As Integer + CollectionSum = 0 + For idx = 1 To C.Count + CollectionSum = CollectionSum + C.Item(idx) + Next idx +End Function + +Function ArraySum(is_missingC As Boolean, C) + Dim idx As Integer + ArraySum = 0 + If Not is_missingC Then + For idx = LBound(C) To UBound(C) + ArraySum = ArraySum + C(idx) + Next idx + End If +End Function + +Sub TestLog_ASSERT(actual As Variant, expected As Variant, testName As String) + If expected = actual Then + passCount = passCount + 1 + Else + result = result & Chr$(10) & " Failed: " & testName & " returned " & actual & ", expected " & expected + failCount = failCount + 1 + End If +End Sub
\ No newline at end of file diff --git a/basic/qa/vba_tests/partition.vb b/basic/qa/vba_tests/partition.vb new file mode 100644 index 000000000..d134a4227 --- /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 Or 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), "verify_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/qbcolor.vb b/basic/qa/vba_tests/qbcolor.vb new file mode 100644 index 000000000..d9f617219 --- /dev/null +++ b/basic/qa/vba_tests/qbcolor.vb @@ -0,0 +1,92 @@ +Option VBASupport 1 +Option Explicit +Dim passCount As Integer +Dim failCount As Integer +Dim result As String + +Function doUnitTest() As String +result = verify_testQBcolor() +If failCount <> 0 or passCount = 0 Then + doUnitTest = result +Else + doUnitTest = "OK" +End If +End Function + + + +Function verify_testQBcolor() As String + + passCount = 0 + failCount = 0 + + result = "Test Results" & Chr$(10) & "============" & Chr$(10) + + Dim testName As String + Dim date1, date2 As Long + testName = "Test QBcolor function" + On Error GoTo errorHandler + + date2 = 0 + date1 = QBColor(0) + TestLog_ASSERT date1 = date2, "the return QBcolor is: " & date1 + + date2 = 8388608 + date1 = QBColor(1) + TestLog_ASSERT date1 = date2, "the return QBcolor is: " & date1 + + date2 = 32768 + date1 = QBColor(2) + TestLog_ASSERT date1 = date2, "the return QBcolor is: " & date1 + + date2 = 8421376 + date1 = QBColor(3) + TestLog_ASSERT date1 = date2, "the return QBcolor is: " & date1 + + date2 = 128 + date1 = QBColor(4) + TestLog_ASSERT date1 = date2, "the return QBcolor is: " & date1 + + date2 = 8388736 + date1 = QBColor(5) + TestLog_ASSERT date1 = date2, "the return QBcolor is: " & date1 + + date2 = 32896 + date1 = QBColor(6) + TestLog_ASSERT date1 = date2, "the return QBcolor is: " & date1 + + date2 = 12632256 + date1 = QBColor(7) + TestLog_ASSERT date1 = date2, "the return QBcolor is: " & date1 + + date2 = 8421504 + date1 = QBColor(8) + TestLog_ASSERT date1 = date2, "the return QBcolor is: " & date1 + + result = result & Chr$(10) & "Tests passed: " & passCount & Chr$(10) & "Tests failed: " & failCount & Chr$(10) + verify_testQBcolor = 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/rate.vb b/basic/qa/vba_tests/rate.vb new file mode 100644 index 000000000..898705911 --- /dev/null +++ b/basic/qa/vba_tests/rate.vb @@ -0,0 +1,84 @@ +Option VBASupport 1 +Rem Option VBASupport 1 +Option Explicit +Dim passCount As Integer +Dim failCount As Integer +Dim result As String + +Function doUnitTest() As String +result = verify_testRATE() +If failCount <> 0 or passCount = 0 Then + doUnitTest = result +Else + doUnitTest = "OK" +End If +End Function + + + +Function verify_testRATE() 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 + testName = "Test RATE function" + On Error GoTo errorHandler + + date2 = 0.07 + date1 = Rate(3, -5, 0, 16) + TestLog_ASSERT Round(date1, 2) = Round(date2, 2), "the return RATE is: " & date1 + + date2 = 0 + date1 = Rate(3, -5, 0, 15) + TestLog_ASSERT Round(date1, 2) = Round(date2, 2), "the return RATE is: " & date1 + + date2 = 0.79 + date1 = Rate(3, -5, 0, 30) + TestLog_ASSERT Round(date1, 2) = Round(date2, 2), "the return RATE is: " & date1 + + date2 = 1 + date1 = Rate(3, -5, 0, 35) + TestLog_ASSERT Round(date1, 2) = Round(date2, 2), "the return RATE is: " & date1 + + date2 = 0.077 + date1 = Rate(4, -300, 1000, 0, 0) + TestLog_ASSERT Round(date1, 2) = Round(date2, 2), "the return RATE is: " & date1 + + date2 = 0.14 + date1 = Rate(4, -300, 1000, 0, 1) + TestLog_ASSERT Round(date1, 2) = Round(date2, 2), "the return RATE is: " & date1 + + + result = result & Chr$(10) & "Tests passed: " & passCount & Chr$(10) & "Tests failed: " & failCount & Chr$(10) + verify_testRATE = 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/replace.vb b/basic/qa/vba_tests/replace.vb new file mode 100644 index 000000000..1349c10fa --- /dev/null +++ b/basic/qa/vba_tests/replace.vb @@ -0,0 +1,77 @@ +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 Or 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", "binary 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 + + ' tdf#132389 - case-insensitive operation for non-ASCII characters + retStr = Replace("ABCabc", "b", "*", 1, 2, vbTextCompare) + TestLog_ASSERT retStr = "A*Ca*c", "case-insensitive ASCII: " & retStr + retStr = Replace("АБВабв", "б", "*", 1, 2, vbTextCompare) + TestLog_ASSERT retStr = "А*Ва*в", "case-insensitive non-ASCII: " & 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/rgb.vb b/basic/qa/vba_tests/rgb.vb new file mode 100644 index 000000000..b36f3e099 --- /dev/null +++ b/basic/qa/vba_tests/rgb.vb @@ -0,0 +1,72 @@ +Option VBASupport 1 +Rem Option VBASupport 1 +Option Explicit +Dim passCount As Integer +Dim failCount As Integer +Dim result As String + +Function doUnitTest() As String +result = verify_testRGB() +If failCount <> 0 or passCount = 0 Then + doUnitTest = result +Else + doUnitTest = "OK" +End If +End Function + + + +Function verify_testRGB() 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 + testName = "Test RGB function" + On Error GoTo errorHandler + + date2 = 255 + date1 = RGB(255, 0, 0) + TestLog_ASSERT date1 = date2, "the return RGB is: " & date1 + + date2 = 13339467 + date1 = RGB(75, 139, 203) + TestLog_ASSERT date1 = date2, "the return RGB is: " & date1 + + date2 = 16777215 + date1 = RGB(255, 255, 255) + TestLog_ASSERT date1 = date2, "the return RGB is: " & date1 + + + result = result & Chr$(10) & "Tests passed: " & passCount & Chr$(10) & "Tests failed: " & failCount & Chr$(10) + verify_testRGB = 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/right.vb b/basic/qa/vba_tests/right.vb new file mode 100644 index 000000000..0e09bc11c --- /dev/null +++ b/basic/qa/vba_tests/right.vb @@ -0,0 +1,68 @@ +Option VBASupport 1 +Option Explicit +Dim passCount As Integer +Dim failCount As Integer +Dim result As String + +Function doUnitTest() As String +result = verify_testRight() +If failCount <> 0 or passCount = 0 Then + doUnitTest = result +Else + doUnitTest = "OK" +End If +End Function + + + +Function verify_testRight() As String + + passCount = 0 + failCount = 0 + + result = "Test Results" & Chr$(10) & "============" & Chr$(10) + + Dim testName As String + Dim date1, date2 + testName = "Test Right function" + On Error GoTo errorHandler + + date2 = "text" + date1 = Right("sometext", 4) + TestLog_ASSERT date1 = date2, "the return Right is: " & date1 + + date2 = "sometext" + date1 = Right("sometext", 48) + TestLog_ASSERT date1 = date2, "the return Right is: " & date1 + + date2 = "" + date1 = Right("", 4) + TestLog_ASSERT date1 = date2, "the return Right is: " & date1 + + result = result & Chr$(10) & "Tests passed: " & passCount & Chr$(10) & "Tests failed: " & failCount & Chr$(10) + verify_testRight = 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/rtrim.vb b/basic/qa/vba_tests/rtrim.vb new file mode 100644 index 000000000..d99cfd85f --- /dev/null +++ b/basic/qa/vba_tests/rtrim.vb @@ -0,0 +1,60 @@ +Option VBASupport 1 +Option Explicit +Dim passCount As Integer +Dim failCount As Integer +Dim result As String + +Function doUnitTest() As String +result = verify_testRTrim() +If failCount <> 0 or passCount = 0 Then + doUnitTest = result +Else + doUnitTest = "OK" +End If +End Function + + + +Function verify_testRTrim() As String + + passCount = 0 + failCount = 0 + + result = "Test Results" & Chr$(10) & "============" & Chr$(10) + + Dim testName As String + Dim date1, date2 + testName = "Test RTrim function" + On Error GoTo errorHandler + + date2 = " some text" + date1 = RTrim(" some text ") + TestLog_ASSERT date1 = date2, "the return RTrim is: " & date1 + + result = result & Chr$(10) & "Tests passed: " & passCount & Chr$(10) & "Tests failed: " & failCount & Chr$(10) + verify_testRTrim = 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/second.vb b/basic/qa/vba_tests/second.vb new file mode 100644 index 000000000..4d84b4f73 --- /dev/null +++ b/basic/qa/vba_tests/second.vb @@ -0,0 +1,64 @@ +Option VBASupport 1 +Option Explicit +Dim passCount As Integer +Dim failCount As Integer +Dim result As String + +Function doUnitTest() As String +result = verify_testSecond() +If failCount <> 0 or passCount = 0 Then + doUnitTest = result +Else + doUnitTest = "OK" +End If +End Function + + + +Function verify_testSecond() As String + + passCount = 0 + failCount = 0 + + result = "Test Results" & Chr$(10) & "============" & Chr$(10) + + Dim testName As String + Dim date1, date2 + testName = "Test Second function" + On Error GoTo errorHandler + + date2 = 0 + date1 = Second(37566.3) + TestLog_ASSERT date1 = date2, "the return Second is: " & date1 + + date2 = 17 + date1 = Second("4:35:17") + TestLog_ASSERT date1 = date2, "the return Second is: " & date1 + + result = result & Chr$(10) & "Tests passed: " & passCount & Chr$(10) & "Tests failed: " & failCount & Chr$(10) + verify_testSecond = 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/sgn.vb b/basic/qa/vba_tests/sgn.vb new file mode 100644 index 000000000..e72215679 --- /dev/null +++ b/basic/qa/vba_tests/sgn.vb @@ -0,0 +1,76 @@ +Option VBASupport 1 +Option Explicit +Dim passCount As Integer +Dim failCount As Integer +Dim result As String + +Function doUnitTest() As String +result = verify_SGN() +If failCount <> 0 or passCount = 0 Then + doUnitTest = result +Else + doUnitTest = "OK" +End If +End Function + + + +Function verify_SGN() As String + + passCount = 0 + failCount = 0 + + result = "Test Results" & Chr$(10) & "============" & Chr$(10) + + Dim testName As String + Dim date1, date2 + testName = "Test SGN function" + On Error GoTo errorHandler + + date2 = 0 + date1 = sgn(0) + TestLog_ASSERT date1 = date2, "the return SGN is: " & date1 + + date2 = -1 + date1 = sgn(-1) + TestLog_ASSERT date1 = date2, "the return SGN is: " & date1 + + date2 = 1 + date1 = sgn(1) + TestLog_ASSERT date1 = date2, "the return SGN is: " & date1 + + date2 = 1 + date1 = sgn(50) + TestLog_ASSERT date1 = date2, "the return SGN is: " & date1 + + date2 = -1 + date1 = sgn(-50) + TestLog_ASSERT date1 = date2, "the return SGN is: " & date1 + + result = result & Chr$(10) & "Tests passed: " & passCount & Chr$(10) & "Tests failed: " & failCount & Chr$(10) + verify_SGN = 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/sin.vb b/basic/qa/vba_tests/sin.vb new file mode 100644 index 000000000..af2e73bd9 --- /dev/null +++ b/basic/qa/vba_tests/sin.vb @@ -0,0 +1,60 @@ +Option VBASupport 1 +Option Explicit +Dim passCount As Integer +Dim failCount As Integer +Dim result As String + +Function doUnitTest() As String +result = verify_testSIN() +If failCount <> 0 or passCount = 0 Then + doUnitTest = result +Else + doUnitTest = "OK" +End If +End Function + + + +Function verify_testSIN() As String + + passCount = 0 + failCount = 0 + + result = "Test Results" & Chr$(10) & "============" & Chr$(10) + + Dim testName As String + Dim date1, date2 + testName = "Test SIN function" + On Error GoTo errorHandler + + date2 = 0.43 + date1 = Sin(0.45) + TestLog_ASSERT Round(date1, 2) = Round(date2, 2), "the return SIN is: " & date1 + + result = result & Chr$(10) & "Tests passed: " & passCount & Chr$(10) & "Tests failed: " & failCount & Chr$(10) + verify_testSIN = 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/space.vb b/basic/qa/vba_tests/space.vb new file mode 100644 index 000000000..efcc9c992 --- /dev/null +++ b/basic/qa/vba_tests/space.vb @@ -0,0 +1,60 @@ +Option VBASupport 1 +Option Explicit +Dim passCount As Integer +Dim failCount As Integer +Dim result As String + +Function doUnitTest() As String +result = verify_testSpace() +If failCount <> 0 or passCount = 0 Then + doUnitTest = result +Else + doUnitTest = "OK" +End If +End Function + + + +Function verify_testSpace() As String + + passCount = 0 + failCount = 0 + + result = "Test Results" & Chr$(10) & "============" & Chr$(10) + + Dim testName As String + Dim date1, date2 + testName = "Test Space function" + On Error GoTo errorHandler + + date2 = " " + date1 = Space(2) + TestLog_ASSERT date1 = date2, "the return Space is: " & date1 + + result = result & Chr$(10) & "Tests passed: " & passCount & Chr$(10) & "Tests failed: " & failCount & Chr$(10) + verify_testSpace = 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/sqr.vb b/basic/qa/vba_tests/sqr.vb new file mode 100644 index 000000000..75a4ae7c1 --- /dev/null +++ b/basic/qa/vba_tests/sqr.vb @@ -0,0 +1,60 @@ +Option VBASupport 1 +Option Explicit +Dim passCount As Integer +Dim failCount As Integer +Dim result As String + +Function doUnitTest() As String +result = verify_testSQR() +If failCount <> 0 or passCount = 0 Then + doUnitTest = result +Else + doUnitTest = "OK" +End If +End Function + + + +Function verify_testSQR() As String + + passCount = 0 + failCount = 0 + + result = "Test Results" & Chr$(10) & "============" & Chr$(10) + + Dim testName As String + Dim date1, date2 + testName = "Test SQR function" + On Error GoTo errorHandler + + date2 = 3 + date1 = Sqr(9) + TestLog_ASSERT date1 = date2, "the return SQR is: " & date1 + + result = result & Chr$(10) & "Tests passed: " & passCount & Chr$(10) & "Tests failed: " & failCount & Chr$(10) + verify_testSQR = 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/str.vb b/basic/qa/vba_tests/str.vb new file mode 100644 index 000000000..e46371ed5 --- /dev/null +++ b/basic/qa/vba_tests/str.vb @@ -0,0 +1,73 @@ +Option VBASupport 1 +Option Explicit +Dim passCount As Integer +Dim failCount As Integer +Dim result As String + +Function doUnitTest() As String +result = verify_testSTR() +If failCount <> 0 or passCount = 0 Then + doUnitTest = result +Else + doUnitTest = "OK" +End If +End Function + + + +Function verify_testSTR() As String + + passCount = 0 + failCount = 0 + + result = "Test Results" & Chr$(10) & "============" & Chr$(10) + + Dim testName As String + Dim date1, date2 + testName = "Test STR function" + On Error GoTo errorHandler + + date2 = " 459" + date1 = Str(459) + TestLog_ASSERT date1 = date2, "the return STR is: " & date1 + + date2 = "-459.65" + date1 = Str(-459.65) + TestLog_ASSERT date1 = date2, "the return STR is: " & date1 + + date2 = " 459.001" + date1 = Str(459.001) + TestLog_ASSERT date1 = date2, "the return STR is: " & date1 + + date2 = " .24" + date1 = Str(0.24) + TestLog_ASSERT date1 = date2, "the return STR is: " & date1 + + result = result & Chr$(10) & "Tests passed: " & passCount & Chr$(10) & "Tests failed: " & failCount & Chr$(10) + verify_testSTR = 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/strcomp.vb b/basic/qa/vba_tests/strcomp.vb new file mode 100644 index 000000000..487358358 --- /dev/null +++ b/basic/qa/vba_tests/strcomp.vb @@ -0,0 +1,95 @@ +Option VBASupport 1 +Option Explicit +Dim passCount As Integer +Dim failCount As Integer +Dim result As String + +Function doUnitTest() As String +result = verify_testSTRcomp() +If failCount <> 0 or passCount = 0 Then + doUnitTest = result +Else + doUnitTest = "OK" +End If +End Function + + + +Function verify_testSTRcomp() As String + + passCount = 0 + failCount = 0 + + result = "Test Results" & Chr$(10) & "============" & Chr$(10) + + Dim testName As String + Dim TestStr, TestStr1, TestStr2 As String + Dim date1, date2 + testName = "Test STRcomp function" + On Error GoTo errorHandler + TestStr1 = "ABCD" + TestStr2 = "abcd" + + date2 = 0 + date1 = StrComp(TestStr1, TestStr2, vbTextCompare) + TestLog_ASSERT date1 = date2, "the return STRcomp is: " & date1 + + date2 = -1 + date1 = StrComp(TestStr1, TestStr2, vbBinaryCompare) + TestLog_ASSERT date1 = date2, "the return STRcomp is: " & date1 + + date2 = -1 + date1 = StrComp(TestStr1, TestStr2) + TestLog_ASSERT date1 = date2, "the return STRcomp is: " & date1 + + date2 = 0 + date1 = StrComp("text", "text", vbBinaryCompare) + TestLog_ASSERT date1 = date2, "the return STRcomp is: " & date1 + + date2 = 1 + date1 = StrComp("text ", "text", vbBinaryCompare) + TestLog_ASSERT date1 = date2, "the return STRcomp is: " & date1 + + date2 = -1 + date1 = StrComp("Text", "text", vbBinaryCompare) + TestLog_ASSERT date1 = date2, "the return STRcomp is: " & date1 + + date2 = 0 + date1 = StrComp("text", "text", vbTextCompare) + TestLog_ASSERT date1 = date2, "the return STRcomp is: " & date1 + + date2 = 1 + date1 = StrComp("text ", "text", vbTextCompare) + TestLog_ASSERT date1 = date2, "the return STRcomp is: " & date1 + + date2 = 0 + date1 = StrComp("Text", "text", vbTextCompare) + TestLog_ASSERT date1 = date2, "the return STRcomp is: " & date1 + + result = result & Chr$(10) & "Tests passed: " & passCount & Chr$(10) & "Tests failed: " & failCount & Chr$(10) + verify_testSTRcomp = 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 000000000..35a73af17 --- /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 Or 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 length 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/string.vb b/basic/qa/vba_tests/string.vb new file mode 100644 index 000000000..79496738c --- /dev/null +++ b/basic/qa/vba_tests/string.vb @@ -0,0 +1,69 @@ +Option VBASupport 1 +Option Explicit +Dim passCount As Integer +Dim failCount As Integer +Dim result As String + +Function doUnitTest() As String +result = verify_testString() +If failCount <> 0 or passCount = 0 Then + doUnitTest = result +Else + doUnitTest = "OK" +End If +End Function + + + +Function verify_testString() As String + + passCount = 0 + failCount = 0 + + result = "Test Results" & Chr$(10) & "============" & Chr$(10) + + Dim testName As String + Dim TestStr As String + Dim date1, date2 + testName = "Test String function" + On Error GoTo errorHandler + + date2 = "PPPPP" + date1 = String(5, "P") + TestLog_ASSERT date1 = date2, "the return String is: " & date1 + + date2 = "aaaaa" + date1 = String(5, "a") + TestLog_ASSERT date1 = date2, "the return String is: " & date1 + + date2 = "" + date1 = String(0, "P") + TestLog_ASSERT date1 = date2, "the return String is: " & date1 + + result = result & Chr$(10) & "Tests passed: " & passCount & Chr$(10) & "Tests failed: " & failCount & Chr$(10) + verify_testString = 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 000000000..cfe4a5bc6 --- /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 Or 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/qa/vba_tests/strreverse.vb b/basic/qa/vba_tests/strreverse.vb new file mode 100644 index 000000000..e0866a008 --- /dev/null +++ b/basic/qa/vba_tests/strreverse.vb @@ -0,0 +1,72 @@ +Option VBASupport 1 +Option Explicit +Dim passCount As Integer +Dim failCount As Integer +Dim result As String + +Function doUnitTest() As String +result = verify_testStrReverse() +If failCount <> 0 or passCount = 0 Then + doUnitTest = result +Else + doUnitTest = "OK" +End If +End Function + + + +Function verify_testStrReverse() As String + + passCount = 0 + failCount = 0 + + result = "Test Results" & Chr$(10) & "============" & Chr$(10) + + Dim testName As String + Dim date1, date2 + testName = "Test StrReverse function" + On Error GoTo errorHandler + + date2 = "dcba" + date1 = StrReverse("abcd") + TestLog_ASSERT date1 = date2, "the return StrReverse is: " & date1 + + date2 = "BABABA" + date1 = StrReverse("ABABAB") + TestLog_ASSERT date1 = date2, "the return StrReverse is: " & date1 + + date2 = "654321" + date1 = StrReverse("123456") + TestLog_ASSERT date1 = date2, "the return StrReverse is: " & date1 + + date2 = "6" + date1 = StrReverse(6) + TestLog_ASSERT date1 = date2, "the return StrReverse is: " & date1 + + result = result & Chr$(10) & "Tests passed: " & passCount & Chr$(10) & "Tests failed: " & failCount & Chr$(10) + verify_testStrReverse = 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/switch.vb b/basic/qa/vba_tests/switch.vb new file mode 100644 index 000000000..a6acea77d --- /dev/null +++ b/basic/qa/vba_tests/switch.vb @@ -0,0 +1,67 @@ +Option VBASupport 1 +Option Explicit +Dim passCount As Integer +Dim failCount As Integer +Dim result As String + +Function doUnitTest() As String +result = verify_testSwitch() +If failCount <> 0 or passCount = 0 Then + doUnitTest = result +Else + doUnitTest = "OK" +End If +End Function + + + +Function verify_testSwitch() As String + + passCount = 0 + failCount = 0 + + result = "Test Results" & Chr$(10) & "============" & Chr$(10) + + Dim testName As String + Dim date1, date2 + testName = "Test Switch function" + On Error GoTo errorHandler + + date2 = "French" + date1 = MatchUp("Paris") + TestLog_ASSERT date1 = date2, "the return Switch is: " & date1 + + result = result & Chr$(10) & "Tests passed: " & passCount & Chr$(10) & "Tests failed: " & failCount & Chr$(10) + verify_testSwitch = result + + Exit Function +errorHandler: + TestLog_ASSERT (False), testName & ": hit error handler" +End Function + +Function MatchUp(CityName As String) + MatchUp = Switch(CityName = "London", "English", CityName _ + = "Rome", "Italian", CityName = "Paris", "French") +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/timeserial.vb b/basic/qa/vba_tests/timeserial.vb new file mode 100644 index 000000000..a663d516c --- /dev/null +++ b/basic/qa/vba_tests/timeserial.vb @@ -0,0 +1,69 @@ +Option VBASupport 1 +Option Explicit +Dim passCount As Integer +Dim failCount As Integer +Dim result As String + +Function doUnitTest() As String +result = verify_testTimeSerial() +If failCount <> 0 or passCount = 0 Then + doUnitTest = result +Else + doUnitTest = "OK" +End If +End Function + + + +Function verify_testTimeSerial() As String + + passCount = 0 + failCount = 0 + + result = "Test Results" & Chr$(10) & "============" & Chr$(10) + + Dim testName As String + Dim date1, date2 As Date + testName = "Test TimeSerial function" + On Error GoTo errorHandler + +rem bug 114229 +rem date2 = "5:45:00" +rem date1 = (TimeSerial(12 - 6, -15, 0)) +rem TestLog_ASSERT date1 = date2, "the return TimeSerial is: " & date1 + + date2 = "12:30:00" + date1 = TimeSerial(12, 30, 0) + TestLog_ASSERT date1 = date2, "the return TimeSerial is: " & date1 + +rem date2 = "11:30:00" +rem date1 = TimeSerial(10, 90, 0) +rem TestLog_ASSERT date1 = date2, "the return TimeSerial is: " & date1 + + result = result & Chr$(10) & "Tests passed: " & passCount & Chr$(10) & "Tests failed: " & failCount & Chr$(10) + verify_testTimeSerial = 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/timevalue.vb b/basic/qa/vba_tests/timevalue.vb new file mode 100644 index 000000000..a27feb35a --- /dev/null +++ b/basic/qa/vba_tests/timevalue.vb @@ -0,0 +1,59 @@ +Option VBASupport 1 +Option Explicit +Dim passCount As Integer +Dim failCount As Integer +Dim result As String + +Function doUnitTest() As String +result = verify_testTimeValue() +If failCount <> 0 or passCount = 0 Then + doUnitTest = result +Else + doUnitTest = "OK" +End If +End Function + +Function verify_testTimeValue() As String + + passCount = 0 + failCount = 0 + + result = "Test Results" & Chr$(10) & "============" & Chr$(10) + + Dim testName As String + + Dim date1, date2 As Date 'variables for test + testName = "Test TimeValue function" + On Error GoTo errorHandler + + date2 = "16:35:17" + date1 = TimeValue("4:35:17 PM") + TestLog_ASSERT date1 = date2, "the return TimeValue is: " & date1 + + result = result & Chr$(10) & "Tests passed: " & passCount & Chr$(10) & "Tests failed: " & failCount & Chr$(10) + verify_testTimeValue = 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/trim.vb b/basic/qa/vba_tests/trim.vb new file mode 100644 index 000000000..c61845d5d --- /dev/null +++ b/basic/qa/vba_tests/trim.vb @@ -0,0 +1,60 @@ +Option VBASupport 1 +Option Explicit +Dim passCount As Integer +Dim failCount As Integer +Dim result As String + +Function doUnitTest() As String +result = verify_testTrim() +If failCount <> 0 or passCount = 0 Then + doUnitTest = result +Else + doUnitTest = "OK" +End If +End Function + + + +Function verify_testTrim() As String + + passCount = 0 + failCount = 0 + + result = "Test Results" & Chr$(10) & "============" & Chr$(10) + + Dim testName As String + Dim date1, date2 + testName = "Test Trim function" + On Error GoTo errorHandler + + date2 = "some text" + date1 = Trim(" some text ") + TestLog_ASSERT date1 = date2, "the return Trim is: " & date1 + + result = result & Chr$(10) & "Tests passed: " & passCount & Chr$(10) & "Tests failed: " & failCount & Chr$(10) + verify_testTrim = 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/typename.vb b/basic/qa/vba_tests/typename.vb new file mode 100644 index 000000000..7e49a4d61 --- /dev/null +++ b/basic/qa/vba_tests/typename.vb @@ -0,0 +1,96 @@ +Option VBASupport 1 +Option Explicit +Dim passCount As Integer +Dim failCount As Integer +Dim result As String + +Function doUnitTest() As String +result = verify_testTypeName() +If failCount <> 0 or passCount = 0 Then + doUnitTest = result +Else + doUnitTest = "OK" +End If +End Function + + + +Function verify_testTypeName() As String + + passCount = 0 + failCount = 0 + + result = "Test Results" & Chr$(10) & "============" & Chr$(10) + + Dim testName As String + Dim date1, date2 + testName = "Test TypeName function" + On Error GoTo errorHandler + Dim b1 As Boolean + Dim c1 As Byte + Dim d1 As Date + Dim d2 As Double + Dim i1 As Integer + Dim l1 As Long + + date2 = "String" + date1 = TypeName(testName) + TestLog_ASSERT date1 = date2, "the return TypeName is: " & date1 + + date2 = "Boolean" + date1 = TypeName(b1) + TestLog_ASSERT date1 = date2, "the return TypeName is: " & date1 + + date2 = "Byte" + date1 = TypeName(c1) + TestLog_ASSERT date1 = date2, "the return TypeName is: " & date1 + + date2 = "Date" + date1 = TypeName(d1) + TestLog_ASSERT date1 = date2, "the return TypeName is: " & date1 + + date2 = "Double" + date1 = TypeName(d2) + TestLog_ASSERT date1 = date2, "the return TypeName is: " & date1 + + date2 = "Integer" + date1 = TypeName(i1) + TestLog_ASSERT date1 = date2, "the return TypeName is: " & date1 + + date2 = "Long" + date1 = TypeName(l1) + TestLog_ASSERT date1 = date2, "the return TypeName is: " & date1 + + ' tdf#129596 - Types of constant values + TestLog_ASSERT TypeName(32767) = "Integer", "the return TypeName(32767) is: " & TypeName(32767) + TestLog_ASSERT TypeName(-32767) = "Integer", "the return TypeName(-32767) is: " & TypeName(-32767) + TestLog_ASSERT TypeName(1048575) = "Long", "the return TypeName(1048575) is: " & TypeName(1048575) + TestLog_ASSERT TypeName(-1048575) = "Long", "the return TypeName(-1048575) is: " & TypeName(-1048575)
+ + result = result & Chr$(10) & "Tests passed: " & passCount & Chr$(10) & "Tests failed: " & failCount & Chr$(10) + verify_testTypeName = 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/ubound.vb b/basic/qa/vba_tests/ubound.vb new file mode 100644 index 000000000..e52299fb4 --- /dev/null +++ b/basic/qa/vba_tests/ubound.vb @@ -0,0 +1,69 @@ +Option VBASupport 1 +Option Explicit +Dim passCount As Integer +Dim failCount As Integer +Dim result As String + +Function doUnitTest() As String +result = verify_testUBound() +If failCount <> 0 or passCount = 0 Then + doUnitTest = result +Else + doUnitTest = "OK" +End If +End Function + + + +Function verify_testUBound() As String + + passCount = 0 + failCount = 0 + + result = "Test Results" & Chr$(10) & "============" & Chr$(10) + + Dim testName As String + Dim date1, date2 + testName = "Test UBound function" + On Error GoTo errorHandler + Dim A(1 To 100, 0 To 3, -3 To 4) + + date2 = 100 + date1 = UBound(A, 1) + TestLog_ASSERT date1 = date2, "the return UBound is: " & date1 + + date2 = 3 + date1 = UBound(A, 2) + TestLog_ASSERT date1 = date2, "the return UBound is: " & date1 + + date2 = 4 + date1 = UBound(A, 3) + TestLog_ASSERT date1 = date2, "the return UBound is: " & date1 + + result = result & Chr$(10) & "Tests passed: " & passCount & Chr$(10) & "Tests failed: " & failCount & Chr$(10) + verify_testUBound = 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/ucase.vb b/basic/qa/vba_tests/ucase.vb new file mode 100644 index 000000000..369be4f8e --- /dev/null +++ b/basic/qa/vba_tests/ucase.vb @@ -0,0 +1,60 @@ +Option VBASupport 1 +Option Explicit +Dim passCount As Integer +Dim failCount As Integer +Dim result As String + +Function doUnitTest() As String +result = verify_testUCase() +If failCount <> 0 or passCount = 0 Then + doUnitTest = result +Else + doUnitTest = "OK" +End If +End Function + + + +Function verify_testUCase() As String + + passCount = 0 + failCount = 0 + + result = "Test Results" & Chr$(10) & "============" & Chr$(10) + + Dim testName As String + Dim date1, date2 + testName = "Test UCase function" + On Error GoTo errorHandler + + date2 = "HELLO 12" + date1 = UCase("hello 12") '2/12/1969 + TestLog_ASSERT date1 = date2, "the return UCase is: " & date1 + + result = result & Chr$(10) & "Tests passed: " & passCount & Chr$(10) & "Tests failed: " & failCount & Chr$(10) + verify_testUCase = 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/val.vb b/basic/qa/vba_tests/val.vb new file mode 100644 index 000000000..39796d7b4 --- /dev/null +++ b/basic/qa/vba_tests/val.vb @@ -0,0 +1,92 @@ +Option VBASupport 1 +Option Explicit +Dim passCount As Integer +Dim failCount As Integer +Dim result As String + +Function doUnitTest() As String +result = verify_testVal() +If failCount <> 0 or passCount = 0 Then + doUnitTest = result +Else + doUnitTest = "OK" +End If +End Function + + + +Function verify_testVal() As String + + passCount = 0 + failCount = 0 + + result = "Test Results" & Chr$(10) & "============" & Chr$(10) + + Dim testName As String + Dim date1, date2 + testName = "Test Val function" + On Error GoTo errorHandler + + date2 = 2 + date1 = Val("02/04/2010") + TestLog_ASSERT date1 = date2, "the return Val is: " & date1 + + date2 = 1050 + date1 = Val("1050") + TestLog_ASSERT date1 = date2, "the return Val is: " & date1 + + date2 = 130.75 + date1 = Val("130.75") + TestLog_ASSERT date1 = date2, "the return Val is: " & date1 + + date2 = 50 + date1 = Val("50 Park Lane") + TestLog_ASSERT date1 = date2, "the return Val is: " & date1 + + date2 = 1320 + date1 = Val("1320 then some text") + TestLog_ASSERT date1 = date2, "the return Val is: " & date1 + + date2 = 0 + date1 = Val("L13.5") + TestLog_ASSERT date1 = date2, "the return Val is: " & date1 + + date2 = 0 + date1 = Val("sometext") + TestLog_ASSERT date1 = date2, "the return Val is: " & date1 + +REM date2 = 1 +REM date1 = Val("1, 2") +REM TestLog_ASSERT date1 = date2, "the return Val is: " & date1 +REM tdf#111999 + + date2 = -1 + date1 = Val("&HFFFF") + TestLog_ASSERT date1 = date2, "the return Val is: " & date1 + result = result & Chr$(10) & "Tests passed: " & passCount & Chr$(10) & "Tests failed: " & failCount & Chr$(10) + verify_testVal = 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/vartype.vb b/basic/qa/vba_tests/vartype.vb new file mode 100644 index 000000000..f500268ae --- /dev/null +++ b/basic/qa/vba_tests/vartype.vb @@ -0,0 +1,86 @@ +Option VBASupport 1 +Option Explicit +Dim passCount As Integer +Dim failCount As Integer +Dim result As String + +Function doUnitTest() As String +result = verify_testVarType() +If failCount <> 0 or passCount = 0 Then + doUnitTest = result +Else + doUnitTest = "OK" +End If +End Function + + + +Function verify_testVarType() 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 TestInt As Integer + Dim TestLong As Long + Dim TestDouble As Double + Dim TestBoo As Boolean + Dim date1, date2 + testName = "Test VarType function" + On Error GoTo errorHandler + + date2 = 8 + date1 = VarType(testName) + TestLog_ASSERT date1 = date2, "the return VarType is: " & date1 + + date2 = 11 + date1 = VarType(TestBoo) + TestLog_ASSERT date1 = date2, "the return VarType is: " & date1 + + date2 = 5 + date1 = VarType(TestDouble) + TestLog_ASSERT date1 = date2, "the return VarType is: " & date1 + + date2 = 3 + date1 = VarType(TestLong) + TestLog_ASSERT date1 = date2, "the return VarType is: " & date1 + + date2 = 2 + date1 = VarType(TestInt) + TestLog_ASSERT date1 = date2, "the return VarType is: " & date1 + + date2 = 7 + date1 = VarType(TestDateTime) + TestLog_ASSERT date1 = date2, "the return VarType is: " & date1 + + result = result & Chr$(10) & "Tests passed: " & passCount & Chr$(10) & "Tests failed: " & failCount & Chr$(10) + verify_testVarType = 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/weekday.vb b/basic/qa/vba_tests/weekday.vb new file mode 100644 index 000000000..a37f07d1f --- /dev/null +++ b/basic/qa/vba_tests/weekday.vb @@ -0,0 +1,81 @@ +Option VBASupport 1 +Option Explicit +Dim passCount As Integer +Dim failCount As Integer +Dim result As String + +Function doUnitTest() As String +result = verify_testWeekDay() +If failCount <> 0 or passCount = 0 Then + doUnitTest = result +Else + doUnitTest = "OK" +End If +End Function + + + +Function verify_testWeekDay() As String + + passCount = 0 + failCount = 0 + + result = "Test Results" & Chr$(10) & "============" & Chr$(10) + + Dim testName As String + Dim date1, date2 + testName = "Test WeekDay function" + On Error GoTo errorHandler + + date2 = 7 + date1 = Weekday(#6/7/2009#, vbMonday) + TestLog_ASSERT date1 = date2, "the return WeekDay is: " & date1 + + date2 = 2 + date1 = Weekday(#7/7/2009#, vbMonday) + TestLog_ASSERT date1 = date2, "the return WeekDay is: " & date1 + + date2 = 5 + date1 = Weekday(#8/7/2009#, vbMonday) + TestLog_ASSERT date1 = date2, "the return WeekDay is: " & date1 + + date2 = 1 + date1 = Weekday(#12/7/2009#, vbMonday) + TestLog_ASSERT date1 = date2, "the return WeekDay is: " & date1 + + date2 = 1 + date1 = Weekday(#6/7/2009#, vbSunday) + TestLog_ASSERT date1 = date2, "the return WeekDay is: " & date1 + + date2 = 5 + date1 = Weekday(#6/7/2009#, 4) + TestLog_ASSERT date1 = date2, "the return WeekDay is: " & date1 + + + result = result & Chr$(10) & "Tests passed: " & passCount & Chr$(10) & "Tests failed: " & failCount & Chr$(10) + verify_testWeekDay = 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/weekdayname.vb b/basic/qa/vba_tests/weekdayname.vb new file mode 100644 index 000000000..6c8f0b575 --- /dev/null +++ b/basic/qa/vba_tests/weekdayname.vb @@ -0,0 +1,84 @@ +Option VBASupport 1 +Option Explicit +Dim passCount As Integer +Dim failCount As Integer +Dim result As String + +Function doUnitTest() As String +result = verify_testWeekDayName() +If failCount <> 0 or passCount = 0 Then + doUnitTest = result +Else + doUnitTest = "OK" +End If +End Function + + + +Function verify_testWeekDayName() As String + + passCount = 0 + failCount = 0 + + result = "Test Results" & Chr$(10) & "============" & Chr$(10) + + Dim testName As String + Dim date1, date2 + testName = "Test WeekDayName function" + On Error GoTo errorHandler + + date2 = "Sunday" + date1 = WeekdayName(1) + TestLog_ASSERT date1 = date2, "the return WeekDayName is: " & date1 + + date2 = "Sunday" + date1 = WeekdayName(1, , vbSunday) + TestLog_ASSERT date1 = date2, "the return WeekDayName is: " & date1 + + date2 = "Monday" + date1 = WeekdayName(1, , vbMonday) + TestLog_ASSERT date1 = date2, "the return WeekDayName is: " & date1 + + date2 = "Monday" + date1 = WeekdayName(2) + TestLog_ASSERT date1 = date2, "the return WeekDayName is: " & date1 + + date2 = "Tue" + date1 = WeekdayName(2, True, vbMonday) + TestLog_ASSERT date1 = date2, "the return WeekDayName is: " & date1 + + date2 = "Wed" + date1 = WeekdayName(2, True, vbTuesday) + TestLog_ASSERT date1 = date2, "the return WeekDayName is: " & date1 + + date2 = "Thu" + date1 = WeekdayName(2, True, vbWednesday) + TestLog_ASSERT date1 = date2, "the return WeekDayName is: " & date1 + + result = result & Chr$(10) & "Tests passed: " & passCount & Chr$(10) & "Tests failed: " & failCount & Chr$(10) + verify_testWeekDayName = 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/win32compat.vb b/basic/qa/vba_tests/win32compat.vb new file mode 100644 index 000000000..58a8e4e51 --- /dev/null +++ b/basic/qa/vba_tests/win32compat.vb @@ -0,0 +1,86 @@ +Option VBASupport 1 +Option Explicit + +' +' 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/. +' +' +' Test built-in compatibility versions of methods whose absence +' is really felt in VBA, and large numbers of macros import from +' the system. +' + +Dim passCount As Integer +Dim failCount As Integer +Dim result As String + +Private Declare Function QueryPerformanceCounter Lib "kernel32" (ByRef lpPerformanceCount As Currency) As Long +Private Declare Function QueryPerformanceFrequency Lib "kernel32" (ByRef lpFrequency As Currency) As Long + +' FIXME: all this cut/paste should be factored out ! + +Function doUnitTest() As String + result = verify_win32compat() + If failCount <> 0 Or passCount = 0 Then + doUnitTest = result + Else + doUnitTest = "OK" + End If +End Function + + +Function verify_win32compat() as String + passCount = 0 + failCount = 0 + + result = "Test Results" & Chr$(10) & "================" & Chr$(10) + + Dim freq As Currency + Dim count_a As Currency + Dim count_b As Currency + Dim success As Long + + On Error GoTo errorHandler + + success = QueryPerformanceFrequency(freq) + TestLog_ASSERT success <> 0, "fetching perf. frequency" + TestLog_ASSERT freq > 0, "perf. frequency is incorrect " & freq + + success = QueryPerformanceCounter(count_a) + TestLog_ASSERT success <> 0, "fetching performance count" + + success = QueryPerformanceCounter(count_b) + TestLog_ASSERT success <> 0, "fetching performance count" + TestLog_ASSERT count_a < count_b, "count mismatch " & count_a & " is > " & count_b + + verify_win32compat = "OK" + Exit Function + +errorHandler: + TestLog_ASSERT (False), "hit error handler - " & Err & ": " & Error$ & " (line : " & Erl & ")" + verify_win32compat = result + +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/win32compatb.vb b/basic/qa/vba_tests/win32compatb.vb new file mode 100644 index 000000000..56335c62f --- /dev/null +++ b/basic/qa/vba_tests/win32compatb.vb @@ -0,0 +1,104 @@ +Option VBASupport 1 +Option Explicit + +' +' 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/. +' +' +' Test built-in compatibility versions of methods whose absence +' is really felt in VBA, and large numbers of macros import from +' the system. +' +' This module tests different signatures for the same methods. +' + +Dim passCount As Integer +Dim failCount As Integer +Dim result As String + +Private Type LARGE_INTEGER + lowpart As Long + highpart As Long +End Type + +Private Declare Function QueryPerformanceCounter Lib "kernel32" (lpPerformanceCount As LARGE_INTEGER) As Long +Private Declare Function QueryPerformanceFrequency Lib "kernel32" (lpFrequency As LARGE_INTEGER) As Long + +' FIXME: all this cut/paste should be factored out ! + +Function doUnitTest() As String + result = verify_win32compat() + If failCount <> 0 Or passCount = 0 Then + doUnitTest = result + Else + doUnitTest = "OK" + End If +End Function + +Function convertLarge(scratch As LARGE_INTEGER) As Double + Dim ret As Double + ret = scratch.highpart + ret = ret * 65536 * 65536 + ret = ret + scratch.lowpart + convertLarge = ret +End Function + +Function verify_win32compat() as String + passCount = 0 + failCount = 0 + + result = "Test Results" & Chr$(10) & "================" & Chr$(10) + + Dim scratch as LARGE_INTEGER + Dim freq As Double + Dim count_a As Double + Dim count_b As Double + Dim success As Long + + On Error GoTo errorHandler + + success = QueryPerformanceFrequency(scratch) + TestLog_ASSERT success <> 0, "fetching perf. frequency" + freq = convertLarge(scratch) + TestLog_ASSERT freq > 0, "perf. frequency is incorrect " & freq + + success = QueryPerformanceCounter(scratch) + TestLog_ASSERT success <> 0, "fetching performance count" + count_a = convertLarge(scratch) + +' success = QueryPerformanceCounter(scratch) +' TestLog_ASSERT success <> 0, "fetching performance count" +' count_b = convertLarge(scratch) +' TestLog_ASSERT count_a < count_b, "count mismatch " & count_a & " is > " & count_b + + verify_win32compat = "OK" + Exit Function + +errorHandler: + TestLog_ASSERT (False), "hit error handler - " & Err & ": " & Error$ & " (line : " & Erl & ")" + verify_win32compat = result + +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/year.vb b/basic/qa/vba_tests/year.vb new file mode 100644 index 000000000..62d08234d --- /dev/null +++ b/basic/qa/vba_tests/year.vb @@ -0,0 +1,64 @@ +Option VBASupport 1 +Option Explicit +Dim passCount As Integer +Dim failCount As Integer +Dim result As String + +Function doUnitTest() As String +result = verify_testYear() +If failCount <> 0 or passCount = 0 Then + doUnitTest = result +Else + doUnitTest = "OK" +End If +End Function + + + +Function verify_testYear() As String + + passCount = 0 + failCount = 0 + + result = "Test Results" & Chr$(10) & "============" & Chr$(10) + + Dim testName As String + Dim date1, date2 + testName = "Test Year function" + On Error GoTo errorHandler + + date2 = 1969 + date1 = Year("12/2/1969") + TestLog_ASSERT date1 = date2, "the return Year is: " & date1 + + date2 = 1900 + date1 = Year(256) + TestLog_ASSERT date1 = date2, "the return Year is: " & date1 + + result = result & Chr$(10) & "Tests passed: " & passCount & Chr$(10) & "Tests failed: " & failCount & Chr$(10) + verify_testYear = 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 + |