basic/qa/vba_tests/datevalue.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_testDateValue()
   9 If failCount <> 0 And passCount > 0 Then
  10     doUnitTest = result
  11 Else
  12     doUnitTest = "OK"
  13 End If
  14 End Function
  15
  16
  17
  18 Function verify_testDateValue() 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 TestDateTime As Date
  27     Dim TestStr As String
  28     Dim date1, date2 As Date
  29     testName = "Test DateValue function"
  30     date2 = 25246
  31
  32     On Error GoTo errorHandler
  33
  34     date1 = DateValue("February 12, 1969") '2/12/1969
  35     TestLog_ASSERT date1 = date2, "the return date is: " & date1
  36
  37     date2 = 39468
  38     date1 = DateValue("21/01/2008") '1/21/2008
  39     TestLog_ASSERT date1 = date2, "the return date is: " & date1
  40     result = result & Chr$(10) & "Tests passed: " & passCount & Chr$(10) & "Tests failed: " & failCount & Chr$(10)
  41     verify_testDateValue = result
  42
  43     Exit Function
  44 errorHandler:
  45         TestLog_ASSERT (False),  testName & ": hit error handler"
  46 End Sub
  47
  48 Sub TestLog_ASSERT(assertion As Boolean, Optional testId As String, Optional testComment As String)
  49
  50     If assertion = True Then
  51         passCount = passCount + 1
  52     Else
  53         Dim testMsg As String
  54         If Not IsMissing(testId) Then
  55             testMsg = testMsg + " : " + testId
  56         End If
  57         If Not IsMissing(testComment) And Not (testComment = "") Then
  58             testMsg = testMsg + " (" + testComment + ")"
  59         End If
  60
  61         result = result & Chr$(10) & " Failed: " & testMsg
  62         failCount = failCount + 1
  63     End If
  64
  65 End Sub