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/vba_tests | |
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/vba_tests')
94 files changed, 7806 insertions, 0 deletions
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 + |