basic/qa/vba_tests/qbcolor.vb

   1 Option VBASupport 1
   2 Option Explicit
   3 Dim passCount As Integer
   4 Dim failCount As Integer
   5 Dim result As String
   6
   7 Function doUnitTest() As String
   8 result = verify_testQBcolor()
   9 If failCount <> 0 or passCount = 0 Then
  10     doUnitTest = result
  11 Else
  12     doUnitTest = "OK"
  13 End If
  14 End Function
  15
  16
  17
  18 Function verify_testQBcolor() As String
  19
  20     passCount = 0
  21     failCount = 0
  22
  23     result = "Test Results" & Chr$(10) & "============" & Chr$(10)
  24
  25     Dim testName As String
  26     Dim date1, date2 As Long
  27     testName = "Test QBcolor function"
  28     On Error GoTo errorHandler
  29
  30     date2 = 0
  31     date1 = QBColor(0)
  32     TestLog_ASSERT date1 = date2, "the return QBcolor is: " & date1
  33
  34     date2 = 8388608
  35     date1 = QBColor(1)
  36     TestLog_ASSERT date1 = date2, "the return QBcolor is: " & date1
  37
  38     date2 = 32768
  39     date1 = QBColor(2)
  40     TestLog_ASSERT date1 = date2, "the return QBcolor is: " & date1
  41
  42     date2 = 8421376
  43     date1 = QBColor(3)
  44     TestLog_ASSERT date1 = date2, "the return QBcolor is: " & date1
  45
  46     date2 = 128
  47     date1 = QBColor(4)
  48     TestLog_ASSERT date1 = date2, "the return QBcolor is: " & date1
  49
  50     date2 = 8388736
  51     date1 = QBColor(5)
  52     TestLog_ASSERT date1 = date2, "the return QBcolor is: " & date1
  53
  54     date2 = 32896
  55     date1 = QBColor(6)
  56     TestLog_ASSERT date1 = date2, "the return QBcolor is: " & date1
  57
  58     date2 = 12632256
  59     date1 = QBColor(7)
  60     TestLog_ASSERT date1 = date2, "the return QBcolor is: " & date1
  61
  62     date2 = 8421504
  63     date1 = QBColor(8)
  64     TestLog_ASSERT date1 = date2, "the return QBcolor is: " & date1
  65
  66     result = result & Chr$(10) & "Tests passed: " & passCount & Chr$(10) & "Tests failed: " & failCount & Chr$(10)
  67     verify_testQBcolor = result
  68
  69     Exit Function
  70 errorHandler:
  71         TestLog_ASSERT (False), testName & ": hit error handler"
  72 End Function
  73
  74 Sub TestLog_ASSERT(assertion As Boolean, Optional testId As String, Optional testComment As String)
  75
  76     If assertion = True Then
  77         passCount = passCount + 1
  78     Else
  79         Dim testMsg As String
  80         If Not IsMissing(testId) Then
  81             testMsg = testMsg + " : " + testId
  82         End If
  83         If Not IsMissing(testComment) And Not (testComment = "") Then
  84             testMsg = testMsg + " (" + testComment + ")"
  85         End If
  86
  87         result = result & Chr$(10) & " Failed: " & testMsg
  88         failCount = failCount + 1
  89     End If
  90
  91 End Sub
  92