<%
'********************************************************************
' Name: ASPUnit.asp
'
' Purpose: Contains the main ASPUnit classes
'********************************************************************
Class TestSuite
Private m_oTestCases
Private Sub Class_Initialize()
Set m_oTestCases = Server.CreateObject("Scripting.Dictionary")
End Sub
Private Sub Class_Terminate()
Set m_oTestCases = Nothing
End Sub
Public Sub AddTestCase(oTestContainer, sTestMethod)
Dim oTestCase
Set oTestCase = New TestCase
Set oTestCase.TestContainer = oTestContainer
oTestCase.TestMethod = sTestMethod
m_oTestCases.Add oTestCase, oTestCase
End Sub
Public Sub AddAllTestCases(oTestContainer)
Dim oTestCase, sTestMethod
For Each sTestMethod In oTestContainer.TestCaseNames()
AddTestCase oTestContainer, sTestMethod
Next
End Sub
Public Function Count()
Count = m_oTestCases.Count
End Function
Public Sub Run(oTestResult)
Dim oTestCase
For Each oTestCase In m_oTestCases.Items
oTestCase.Run oTestResult
Next
End Sub
End Class
Class TestCase
Private m_oTestContainer
Private m_sTestMethod
Public Property Get TestContainer()
Set TestContainer = m_oTestContainer
End Property
Public Property Set TestContainer(oTestContainer)
Set m_oTestContainer = oTestContainer
End Property
Public Property Get TestMethod()
TestMethod = m_sTestMethod
End Property
Public Property Let TestMethod(sTestMethod)
m_sTestMethod = sTestMethod
End Property
Public Sub Run(oTestResult)
Dim iOldFailureCount
Dim iOldErrorCount
iOldFailureCount = oTestResult.Failures.Count
iOldErrorCount = oTestResult.Errors.Count
On Error Resume Next
oTestResult.StartTest Me
m_oTestContainer.SetUp()
If (Err.Number <> 0) Then
oTestResult.AddError Err
Else
' Response.Write("m_oTestContainer." & m_sTestMethod & "(oTestResult) ")
Execute("m_oTestContainer." & m_sTestMethod & "(oTestResult)")
If (Err.Number <> 0) Then
' Response.Write(Err.Description & " ")
oTestResult.AddError Err
End If
End If
Err.Clear()
m_oTestContainer.TearDown()
If (Err.Number <> 0) Then
oTestResult.AddError Err
End If
'Log success if no failures or errors occurred
If oTestResult.Failures.Count = iOldFailureCount And oTestResult.Errors.Count = iOldErrorCount Then
oTestResult.AddSuccess
End If
oTestResult.EndTest
On Error Goto 0
End Sub
End Class
Class TestResult
Private m_dicErrors
Private m_dicFailures
Private m_dicSuccesses
Private m_dicObservers
Private m_iRunTests
Private m_oCurrentTestCase
Private Sub Class_Initialize
Set m_dicErrors = Server.CreateObject("Scripting.Dictionary")
Set m_dicFailures = Server.CreateObject("Scripting.Dictionary")
Set m_dicSuccesses = Server.CreateObject("Scripting.Dictionary")
Set m_dicObservers = Server.CreateObject("Scripting.Dictionary")
m_iRunTests = 0
End Sub
Private Sub Class_Terminate
Set m_dicErrors = Nothing
Set m_dicFailures = Nothing
Set m_dicSuccesses = Nothing
Set m_dicObservers = Nothing
Set m_oCurrentTestCase = Nothing
End Sub
Public Property Get Errors()
Set Errors = m_dicErrors
End Property
Public Property Get Failures()
Set Failures = m_dicFailures
End Property
Public Property Get Successes()
Set Successes = m_dicSuccesses
End Property
Public Property Get RunTests()
RunTests = m_iRunTests
End Property
Public Sub StartTest(oTestCase)
Set m_oCurrentTestCase = oTestCase
Dim oObserver
For Each oObserver In m_dicObservers.Items
oObserver.OnStartTest
Next
End Sub
Public Sub EndTest()
m_iRunTests = m_iRunTests + 1
Dim oObserver
For Each oObserver In m_dicObservers.Items
oObserver.OnEndTest
Next
End Sub
Public Sub AddObserver(oObserver)
m_dicObservers.Add oOserver, oObserver
End Sub
Public Function AddError(oError)
Dim oTestError
Set oTestError = New TestError
oTestError.Initialize m_oCurrentTestCase, oError.Number, oError.Source, oError.Description
m_dicErrors.Add oTestError, oTestError
Dim oObserver
For Each oObserver In m_dicObservers.Items
oObserver.OnError
Next
Set AddError = oTestError
End Function
Public Function AddFailure(sMessage)
Dim oTestError
Set oTestError = New TestError
oTestError.Initialize m_oCurrentTestCase, 0, " ", sMessage
m_dicFailures.Add oTestError, oTestError
Dim oObserver
For Each oObserver In m_dicObservers.Items
oObserver.OnFailure
Next
Set AddFailure = oTestError
End Function
Public Function AddSuccess
Dim oTestError
Set oTestError = New TestError
oTestError.Initialize m_oCurrentTestCase, 0, " ", "Test completed without failures"
m_dicSuccesses.Add oTestError, oTestError
Dim oObserver
For Each oObserver In m_dicObservers.Items
oObserver.OnSuccess
Next
End Function
Public Sub Assert(bCondition, sMessage)
If Not bCondition Then
AddFailure sMessage
End If
End Sub
Public Sub AssertEquals(vExpected, vActual, sMessage)
If vExpected <> vActual Then
AddFailure NotEqualsMessage(sMessage, vExpected, vActual)
End If
End Sub
'Build a message about a failed equality check
Function NotEqualsMessage(sMessage, vExpected, vActual)
'NotEqualsMessage = sMessage & " expected: " & CStr(vExpected) & " but was: " & CStr(vActual)
NotEqualsMessage = sMessage & " " &_
"
"
End Function
Public Sub AssertNotEquals(vExpected, vActual, sMessage)
If vExpected = vActual Then
AddFailure sMessage & " expected: " & CStr(vExpected) & " and actual: " & CStr(vActual) & " should not be equal."
End If
End Sub
Public Sub AssertExists(vVariable, sMessage)
If IsObject(vVariable) Then
If (vVariable Is Nothing) Then
AddFailure sMessage & " - Variable of type " & TypeName(vVariable) & " is Nothing."
End If
ElseIf IsEmpty(vVariable) Then
AddFailure sMessage & " - Variable " & TypeName(vVariable) & " is Empty (Uninitialized)."
End If
End Sub
'---------------------------------------------------------------------------------------------------------------------
' CUSTOM ASSERTIONS
'---------------------------------------------------------------------------------------------------------------------
Public Sub AssertFalse(bCondition, sMessage)
If bCondition then
AddFailure sMessage
End If
End Sub
Public Sub AssertEqual(vExpected, vActual, sMessage)
AssertEquals vExpected, vActual, sMessage
End Sub
Public Sub AssertNotEqual(vExpected, vActual, sMessage)
AssertNotEqual vExpected, vActual, sMessage
End Sub
Public Sub AssertNotExists(vVariable, sMessage)
If IsObject(vVariable) then
If (vVariable Is Not Nothing) then
AddFailure sMessage & " - Variable of type " & TypeName(vVariable) & " should be Nothing."
End If
ElseIf Not IsEmpty(vVariable) then
AddFailure sMessage & " - Variable " & TypeName(vVariable) & " should be Empty (Uninitialized)."
End If
End Sub
'Ensures (obj1 Is obj2) = true
Public Sub AssertSame(obj1, obj2, sMessage)
Assert (obj1 Is obj2), sMessage
End Sub
'Ensures (obj1 Is obj2) = false
Public Sub AssertDifferent(obj1, obj2, sMessage)
Assert (not (obj1 Is obj2)), sMessage
End Sub
'Forces a test failure
Public Sub Fail(sMessage)
AddFailure "Forced Failure: " & sMessage
End Sub
'Flags a test as needing implementation, otherwise an empty test will silently pass
Public Sub NotImplemented
AddFailure "Test not implemented."
End Sub
Public Sub AssertType(sTypeName, vVariable, sMessage)
AssertEqual sTypeName, typename(vVariable), sMessage
End Sub
End Class
Class TestError
Private m_oTestCase
Private m_lErrNumber
Private m_sSource
Private m_sDescription
Public Sub Initialize(oTestCase, lErrNumber, sSource, sDescription)
Set m_oTestCase = oTestCase
m_lErrNumber = lErrNumber
m_sSource = sSource
m_sDescription = sDescription
End Sub
Public Property Get TestCase
Set TestCase = m_oTestCase
End Property
Public Property Get ErrNumber
ErrNumber = m_lErrNumber
End Property
Public Property Get Source
Source = m_sSource
End Property
Public Property Get Description
Description = m_sDescription
End Property
End Class
%>