Option Explicit Dim g_TestsRun Dim g_TestsPassed Dim g_Failures g_TestsRun = 0 g_TestsPassed = 0 Set g_Failures = CreateObject("Scripting.Dictionary") Dim ASSERTION_FAILED ASSERTION_FAILED = vbObjectError + 1999 ' Runs the named zero-argument Sub/Function, treating any unhandled error ' (including one raised by a failed Assert*) as a failed test. This mirrors ' exactly the On Error Resume Next / Err.Number pattern already used in ' Public/Default.asp - an error raised in a called procedure with no error ' handling of its own is caught by the caller's active On Error Resume Next. Sub RunTest(ByVal testName, ByVal procName) g_TestsRun = g_TestsRun + 1 On Error Resume Next Err.Clear Execute procName & "()" If Err.Number <> 0 Then RecordFailure testName, Err.Description Else g_TestsPassed = g_TestsPassed + 1 End If On Error Goto 0 End Sub Sub RecordFailure(ByVal testName, ByVal message) g_Failures.Add g_Failures.Count, testName & " -- " & message End Sub Sub PrintSummary() Dim failureKey WScript.Echo "" WScript.Echo "----------------------------------------" WScript.Echo g_TestsPassed & " / " & g_TestsRun & " tests passed" If g_Failures.Count > 0 Then WScript.Echo "" WScript.Echo "Failures:" For Each failureKey In g_Failures.Keys WScript.Echo " - " & g_Failures.Item(failureKey) Next End If WScript.Echo "----------------------------------------" End Sub Function HasFailures() HasFailures = (g_Failures.Count > 0) End Function ' --- Assertions --- Sub AssertEquals(ByVal expected, ByVal actual, ByVal message) If Not (expected = actual) Then Fail message & " (expected [" & CStr(expected) & "] but got [" & CStr(actual) & "])" End If End Sub Sub AssertTrue(ByVal condition, ByVal message) If Not condition Then Fail message & " (expected True)" End If End Sub Sub AssertFalse(ByVal condition, ByVal message) If condition Then Fail message & " (expected False)" End If End Sub Sub AssertIsNothing(ByVal value, ByVal message) If Not (value Is Nothing) Then Fail message & " (expected Nothing)" End If End Sub Sub AssertNotNothing(ByVal value, ByVal message) If value Is Nothing Then Fail message & " (expected an object, got Nothing)" End If End Sub Sub Fail(ByVal message) Err.Raise ASSERTION_FAILED, "Assert", message End Sub ' --- Loading Core/*.asp class files outside IIS --- ' These files are plain "<% Class ... End Class %>" blocks with no mixed HTML ' and (deliberately - see CLAUDE.md) no Option Explicit of their own, so ' stripping the ASP delimiters and running the remainder through ExecuteGlobal ' loads the same class definitions IIS would compile, without needing IIS. Sub IncludeAspClass(ByVal path) Dim raw Dim code Dim openPos Dim closePos raw = ReadFileText(path) openPos = InStr(raw, "<%") closePos = InStrRev(raw, "%>") If openPos = 0 Or closePos = 0 Or closePos <= openPos Then Err.Raise vbObjectError + 1998, "IncludeAspClass", "No <% %> block found in: " & path End If code = Mid(raw, openPos + 2, closePos - (openPos + 2)) ExecuteGlobal code End Sub Sub IncludeVbsFile(ByVal path) ExecuteGlobal ReadFileText(path) End Sub Function ReadFileText(ByVal path) Dim fso Dim stream Set fso = CreateObject("Scripting.FileSystemObject") Set stream = fso.OpenTextFile(path, 1) ReadFileText = stream.ReadAll stream.Close End Function ' --- ASP intrinsic stand-ins --- ' Global variables literally named Server/Response so Core/*.asp's ' "Server.CreateObject(...)" / "Server.HTMLEncode(...)" / "Response.Status = ..." ' resolve to these instead of the real (IIS-only) intrinsics. Function RealCreateObject(ByVal progId) Set RealCreateObject = CreateObject(progId) End Function Function SimpleHtmlEncode(ByVal text) Dim result result = CStr(text) result = Replace(result, "&", "&") result = Replace(result, "<", "<") result = Replace(result, ">", ">") result = Replace(result, """", """) SimpleHtmlEncode = result End Function Class FakeServer Public Function CreateObject(ByVal progId) Set CreateObject = RealCreateObject(progId) End Function Public Function HTMLEncode(ByVal text) HTMLEncode = SimpleHtmlEncode(text) End Function Public Function MapPath(ByVal relativePath) MapPath = "C:\fake-physical-root" & relativePath End Function End Class Class FakeResponse Public Status Public Buffer Public ContentType Private m_Output Private Sub Class_Initialize() Status = "200 OK" Buffer = False ContentType = "" m_Output = "" End Sub Public Sub Write(ByVal text) m_Output = m_Output & text End Sub Public Property Get Output() Output = m_Output End Property End Class ' A neutral dummy object for tests that just need "some object" to register ' as a service - not a stand-in for any real ASP intrinsic. Class FakeService Public Marker End Class ' A stand-in for the real ASP Request object that Core/HttpRequest.asp's ' Bind() expects - only implements what the current code paths touch. Class FakeAspRequest Private m_ServerVariables Private m_QueryString Private m_Form Private m_Cookies Private Sub Class_Initialize() Set m_ServerVariables = CreateObject("Scripting.Dictionary") Set m_QueryString = CreateObject("Scripting.Dictionary") Set m_Form = CreateObject("Scripting.Dictionary") Set m_Cookies = CreateObject("Scripting.Dictionary") End Sub Public Sub SetServerVariable(ByVal key, ByVal value) m_ServerVariables.Item(CStr(key)) = value End Sub Public Sub SetQueryString(ByVal key, ByVal value) m_QueryString.Item(CStr(key)) = value End Sub Public Sub SetForm(ByVal key, ByVal value) m_Form.Item(CStr(key)) = value End Sub Public Sub SetCookie(ByVal key, ByVal value) m_Cookies.Item(CStr(key)) = value End Sub Public Function ServerVariables(ByVal key) If m_ServerVariables.Exists(CStr(key)) Then ServerVariables = m_ServerVariables.Item(CStr(key)) Else ServerVariables = "" End If End Function Public Function QueryString(ByVal key) If m_QueryString.Exists(CStr(key)) Then QueryString = m_QueryString.Item(CStr(key)) Else QueryString = "" End If End Function Public Function Form(ByVal key) If m_Form.Exists(CStr(key)) Then Form = m_Form.Item(CStr(key)) Else Form = "" End If End Function Public Function Cookies(ByVal key) If m_Cookies.Exists(CStr(key)) Then Cookies = m_Cookies.Item(CStr(key)) Else Cookies = "" End If End Function Public Default Function Item(ByVal key) If m_QueryString.Exists(CStr(key)) Then Item = m_QueryString.Item(CStr(key)) ElseIf m_Form.Exists(CStr(key)) Then Item = m_Form.Item(CStr(key)) ElseIf m_Cookies.Exists(CStr(key)) Then Item = m_Cookies.Item(CStr(key)) ElseIf m_ServerVariables.Exists(CStr(key)) Then Item = m_ServerVariables.Item(CStr(key)) Else Item = "" End If End Function End Class Dim Server Dim Response Set Server = New FakeServer Set Response = New FakeResponse