basic/qa/vba_tests/dateserial.vb

   1 Option VBASupport 1
   2 Option Explicit
   3
   4 Dim passCount As Integer
   5 Dim failCount As Integer
   6 Dim result As String
   7
   8 Function doUnitTest() As String
   9 result = verify_testDateSerial()
  10 If failCount <> 0 And passCount > 0 Then
  11     doUnitTest = result
  12 Else
  13     doUnitTest = "OK"
  14 End If
  15 End Function
  16
  17 Function verify_testDateSerial() as String
  18     Dim testName As String
  19     Dim TestDateTime As Date
  20     Dim TestStr As String
  21     Dim date1, date2 As Date
  22     passCount = 0
  23     failCount = 0
  24
  25     result = "Test Results" & Chr$(10) & "============" & Chr$(10)
  26
  27     testName = "Test DateSerial function"
  28     date2 = 36326
  29
  30     On Error GoTo errorHandler
  31
  32     date1 = DateSerial(1999, 6, 15)   '6/15/1999
  33     TestLog_ASSERT date1 = date2, "the return date is: " & date1
  34     date1 = DateSerial(2000, 1 - 7, 15) '6/15/1999
  35     TestLog_ASSERT date1 = date2, "the return date is: " & date1
  36     date1 = DateSerial(1999, 1, 166)  '6/15/1999
  37     TestLog_ASSERT date1 = date2, "the return date is: " & date1
  38     result = result & Chr$(10) & "Tests passed: " & passCount & Chr$(10) & "Tests failed: " & failCount & Chr$(10)
  39
  40     verify_testDateSerial = result
  41
  42     Exit Function
  43 errorHandler:
  44     TestLog_ASSERT (False), testName & ": hit error handler"
  45 End Function
  46
  47 Sub TestLog_ASSERT(assertion As Boolean, Optional testId As String, Optional testComment As String)
  48
  49     If assertion = True Then
  50         passCount = passCount + 1
  51     Else
  52         Dim testMsg As String
  53         If Not IsMissing(testId) Then
  54             testMsg = testMsg + " : " + testId
  55         End If
  56         If Not IsMissing(testComment) And Not (testComment = "") Then
  57             testMsg = testMsg + " (" + testComment + ")"
  58         End If
  59
  60         result = result & Chr$(10) & " Failed: " & testMsg
  61         failCount = failCount + 1
  62     End If
  63
  64 End Sub
  65