Quelle  SF_UnitTest.xba   Sprache: unbekannt

<?xml version="1.0" encoding="UTF-8"?>
<!DOCTYPE script:module PUBLIC "-//OpenOffice.org//DTD OfficeDocument 1.0//EN" "module.dtd">
<script:module xmlns:script="http://openoffice.org/2000/script" script:name="SF_UnitTest" script:language="StarBasic" script:moduleType="normal">REM =======================================================================================================================
REM ===   The ScriptForge library and its associated libraries are part of the LibreOffice project.    ===
REM ===     Full documentation is available on https://help.libreoffice.org/        ===
REM =======================================================================================================================

Option Compatible
Option ClassModule

Option Explicit

'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''
''' SF_UnitTest
''' ===========
'''  Class providing a framework to execute and check sets of unit tests.
'''
'''  The UnitTest unit testing framework was originally inspired by unittest.py in Python
'''  and has a similar flavor as major unit testing frameworks in other languages.
'''
'''  It supports test automation, sharing of setup and shutdown code for tests,
'''  aggregation of tests into collections.
'''
'''  Both the
'''   - code describing the unit tests
'''   - code to be tested
'''  must be written exclusively in Basic (the code might call functions written in other languages).
'''  Even if either code may be contained in the same module, a much better practice is to
'''  store them in separate libraries.
'''  Typically:
'''   - in a same document when the code to be tested is contained in that document
'''   - either in a "test" document or in a "My Macros" library when the code
'''     to be tested is a shared library (My Macros or LibreOffice Macros).
'''  The code to be tested may be released as an extension. It does not need to make
'''  use of ScriptForge services in any way.
'''
'''  The test reporting device is the Console. Read about the console in the ScriptForge.Exception service.
'''
'''  Definitions:
'''   - Test Case
'''    A test case is the individual unit of testing.
'''    It checks for a specific response to a particular set of inputs.
'''    A test case in the UnitTest service is represented by a Basic Sub.
'''    The name of the Sub starts conventionally with "Test_".
'''    The test fails if one of the included AssertXXX methods returns False
'''   - Test Suite
'''    A test suite is a collection of test cases that should be executed together.
'''    A test suite is represented by a Basic module.
'''    A suite may include the tasks needed to prepare one or more tests, and any associated cleanup actions.
'''    This may involve, for example, creating temporary files or directories, opening a document, loading libraries.
'''    Conventionally those tasks are part pf the SetUp') and TearDown() methods.
'''   - Unit test
'''    A full unit test is a set of test suites (each suite in a separate Basic module),
'''    each of them being a set of test cases (each case is located in a separate Basic Sub).
'''
'''  Two modes:
'''   Beside the normal mode ("full mode"), using test suites and test cases, a second mode exists, called "simple mode"
'''   limited to the use exclusively of the Assert...() methods.
'''   Their boolean returned value may support the execution of limited unit tests.    
'''
'''  Service invocation examples:
'''   In full mode, the service creation is external to test cases
'''    Dim myUnitTest As Variant
'''    myUnitTest = CreateScriptService("UnitTest", ThisComponent, "Tests")
'''        ' Test code is in the library "Tests" located in the current document
'''   In simple mode, the service creation is internal to every test case
'''    Dim myUnitTest As Variant
'''    myUnitTest = CreateScriptService("UnitTest")
'''    With myUnitTest
'''     If Not .AssertTrue(...) Then ...   ' Only calls to the Assert...() methods are allowed
'''     ' ...
'''     .Dispose()
'''    End With
'''
'''  Minimalist full mode example
'''   Code to be tested (stored in library "Standard" of document "MyDoc.ods") :
'''    Function ArraySize(arr As Variant) As Long
'''     If IsArray(arr) Then ArraySize = UBound(arr) - LBound(arr) + 1 Else ArraySize = -1
'''    End Function
'''   Test code (stored in module "AllTests" of library "Tests" of document "MyDoc.ods") :
'''    Sub Main()  ' Sub to trigger manually, f.i. from the Tools + Run Macro tabbed bar
'''     GlobalScope.BasicLibraries.loadLibrary("ScriptForge")
'''     Dim test : test = CreateScriptService("UnitTest", ThisComponent, "Tests")
'''     test.RunTest("AllTests") ' AllTests is a module name ; test cases are named "Test_*" (default)
'''     test.Dispose()
'''    End Sub
'''    REM ------------------------------------------------------------------------------
'''    Sub Setup(test)     ' The unittest service is passed as argument
'''     ' Optional Sub to initialize processing of the actual test suite
'''     Dim exc  : exc = CreateScriptService("Exception")
'''     exc.Console(Modal := False) ' Watch test progress in the console
'''    End Sub
'''    REM ------------------------------------------------------------------------------
'''    Sub Test_ArraySize(test)
'''     On Local Error GoTo CatchErr
'''     test.AssertEqual(ArraySize(10), -1, "When not array")
'''     test.AssertEqual(ArraySize(Array(1, 2, 3)), 3, "When simple array")
'''     test.AssertEqual(ArraySize(DimArray(3)), 4, "When array with empty items")
'''     Exit Sub
'''    CatchErr:
'''     test.ReportError("ArraySize() is corrupt")
'''    End Sub
'''    REM ------------------------------------------------------------------------------
'''    Sub TearDown(test)
'''     ' Optional Sub to finalize processing of the actual test suite
'''    End Sub
'''
'''  Error handling
'''   To support the debugging of the tested code, the UnitTest service, in cases of
'''    - assertion failure
'''    - Basic run-time error in the tested code
'''    - Basic run-time error in the testing code (the unit tests)
'''   will comment the error location and description in a message box and in the console log,
'''   providing every test case (in either mode) implements an error handler containing at least:
'''    Sub Test_Case1(test As Variant)
'''     On Local Error GoTo Catch
'''     ' ... (AssertXXX(), Fail(), ...)
'''     Exit Sub
'''    Catch:
'''     test.ReportError()
'''    End Sub
'''
'''  Detailed user documentation:
'''   https://help.libreoffice.org/latest/en-US/text/sbasic/shared/03/sf_unittest.html?DbPAR=BASIC
'''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''

REM ================================================================== EXCEPTIONS

Private Const UNITTESTMETHODERROR  = "UNITTESTMETHODERROR"

REM ============================================================= PRIVATE MEMBERS

Private [Me]    As Object
Private [_Parent]   As Object
Private ObjectType   As String  ' Must be "UNITTEST"
Private ServiceName   As String

' Testing code
Private LibrariesContainer As String  ' Document or user Basic library containing the test library
Private Scope    As String  ' Scope when running a Basic script with Session.ExecuteBasicScript()
Private Libraries   As Variant  ' Set of libraries
Private LibraryName   As String  ' Name of the library containing the test code
Private LibraryIndex  As Integer  ' Index in Libraries
Private Modules    As Variant  ' Set of modules
Private ModuleNames   As Variant  ' Set of module names
Private MethodNames   As Variant  ' Set of methods in a given module

' Internals
Private _Verbose   As Boolean  ' When True, every assertion is reported,failing or not
Private _LongMessage  As Boolean  ' When False, only the message provided by the tester is considered
           ' When True (default), that message is appended to the standard message
Private _WhenAssertionFails As Integer  ' Determines what to do when a test fails

' Test status
Private _Status    As Integer  ' 0 = standby
           ' 1 = test suite started
           ' 2 = setup started
           ' 3 = test case started
           ' 4 = teardown started
Private _ExecutionMode  As Integer  ' 1 = Test started with RunTest()
           ' 2 = Test started with CreateScriptService() Only Assert() methods allowed
Private _Module    As String  ' Exact name of module currently running
Private _TestCase   As String  ' Exact name of test case currently running
Private _ReturnCode   As Integer  ' 0 = Normal end
           ' 1 = Assertion failed
           ' 2 = Skip request (in Setup() only)
           ' 3 = abnormal end
Private _FailedAssert  As String  ' Assert function that returned a failure

' Timers
Private TestTimer   As Object  ' Started by CreateScriptService()
Private SuiteTimer   As Object  ' Started by RunTest()
Private CaseTimer   As Object  ' Started by new case

' Services
Private Exception   As Object  ' SF_Exception
Private Session    As Object  ' SF_Session

REM ============================================================ MODULE CONSTANTS

' When assertion fails constants: error is reported + ...
Global Const FAILIGNORE   = 0   ' Ignore the failure
Global Const FAILSTOPSUITE  = 1   ' Module TearDown is executed, then next suite may be started (default in full mode)
Global Const FAILIMMEDIATESTOP = 2   ' Stop immediately (default in simple mode)

' Unit tests status (internal use only => not Global)
Const STATUSSTANDBY    = 0   ' No test active
Const STATUSSUITESTARTED  = 1   ' RunTest() started
Const STATUSSETUP    = 2   ' A Setup() method is running
Const STATUSTESTCASE   = 3   ' A test case is running
Const STATUSTEARDOWN   = 4   ' A TearDown() method is running

' Return codes
Global Const RCNORMALEND  = 0   ' Normal end of test or test not started
Global Const RCASSERTIONFAILED = 1   ' An assertion within a test case returned False
Global Const RCSKIPTEST   = 2   ' A SkipTest() was issued by a Setup() method
Global Const RCABORTTEST  = 3   ' Abnormal end of test

' Execution modes
Global Const FULLMODE   = 1   ' 1 = Test started with RunTest()
Global Const SIMPLEMODE   = 2   ' 2 = Test started with CreateScriptService() Only Assert() methods allowed

Const INVALIDPROCEDURECALL  = "5"  ' Artificial error raised when an assertion fails

REM ===================================================== CONSTRUCTOR/DESTRUCTOR

REM -----------------------------------------------------------------------------
Private Sub Class_Initialize()
 Set [Me] = Nothing
 Set [_Parent] = Nothing
 ObjectType = "UNITTEST"
 ServiceName = "SFUnitTests.UnitTest"
 LibrariesContainer = ""
 Scope = ""
 Libraries = Array()
 LibraryName = ""
 LibraryIndex = -1
 _Verbose = False
 _LongMessage = True
 _WhenAssertionFails = -1
 _Status = STATUSSTANDBY
 _ExecutionMode = SIMPLEMODE
 _Module = ""
 _TestCase = ""
 _ReturnCode = RCNORMALEND
 _FailedAssert = ""
 Set TestTimer = Nothing
 Set SuiteTimer = Nothing
 Set CaseTimer = Nothing
 Set Exception = ScriptForge.SF_Exception ' Do not use CreateScriptService to allow New SF_UnitTest from other libraries
 Set Session = ScriptForge.SF_Session
End Sub  ' SFUnitTests.SF_UnitTest Constructor

REM -----------------------------------------------------------------------------
Private Sub Class_Terminate()
 If Not IsNull(CaseTimer) Then CaseTimer = CaseTimer.Dispose()
 If Not IsNull(SuiteTimer) Then SuiteTimer = SuiteTimer.Dispose()
 If Not IsNull(TestTimer) Then TestTimer = TestTimer.Dispose()
 Call Class_Initialize()
End Sub  ' SFUnitTests.SF_UnitTest Destructor

REM -----------------------------------------------------------------------------
Public Function Dispose() As Variant
 Call Class_Terminate()
 Set Dispose = Nothing
End Function ' SFUnitTests.SF_UnitTest Explicit destructor

REM ================================================================== PROPERTIES

REM -----------------------------------------------------------------------------
Property Get LongMessage() As Variant
''' When False, only the message provided by the tester is considered
''' When True (default), that message is appended to the standard message
 LongMessage = _PropertyGet("LongMessage")
End Property ' SFUnitTests.SF_UnitTest.LongMessage (get)

REM -----------------------------------------------------------------------------
Property Let LongMessage(Optional ByVal pvLongMessage As Variant)
''' Set the updatable property LongMessage
 _PropertySet("LongMessage", pvLongMessage)
End Property ' SFUnitTests.SF_UnitTest.LongMessage (let)

REM -----------------------------------------------------------------------------
Property Get ReturnCode() As Integer
''' RCNORMALEND   = 0    ' Normal end of test or test not started
''' RCASSERTIONFAILED = 1    ' An assertion within a test case returned False
''' RCSKIPTEST   = 2    ' A SkipTest() was issued by a Setup() method
''' RCABORTTEST   = 3    ' Abnormal end of test
 ReturnCode = _PropertyGet("ReturnCode")
End Property ' SFUnitTests.SF_UnitTest.ReturnCode (get)

REM -----------------------------------------------------------------------------
Property Get Verbose() As Variant
''' The Verbose property indicates if all assertions (True AND False) are reported
 Verbose = _PropertyGet("Verbose")
End Property ' SFUnitTests.SF_UnitTest.Verbose (get)

REM -----------------------------------------------------------------------------
Property Let Verbose(Optional ByVal pvVerbose As Variant)
''' Set the updatable property Verbose
 _PropertySet("Verbose", pvVerbose)
End Property ' SFUnitTests.SF_UnitTest.Verbose (let)

REM -----------------------------------------------------------------------------
Property Get WhenAssertionFails() As Variant
''' What when an AssertXXX() method returns False
'''  FAILIGNORE   = 0    ' Ignore the failure
'''  FAILSTOPSUITE  = 1    ' Module TearDown is executed, then next suite may be started (default in FULL mode)
'''  FAILIMMEDIATESTOP = 2    ' Stop immediately (default in SIMPLE mode)
''' In simple mode, only FAILIGNORE and FAILIMMEDIATESTOP are allowed.
''' In both modes, when WhenAssertionFails has not the value FAILIGNORE,
''' each test case MUST have a run-time error handler calling the ReportError() method.
''' Example:
'''  Sub Test_sometest(Optional test)
'''   On Local Error GoTo CatchError
'''   ' ... one or more assert verbs
'''   Exit Sub
'''  CatchError:
'''   test.ReportError()
'''  End Sub
 WhenAssertionFails = _PropertyGet("WhenAssertionFails")
End Property ' SFUnitTests.SF_UnitTest.WhenAssertionFails (get)

REM -----------------------------------------------------------------------------
Property Let WhenAssertionFails(Optional ByVal pvWhenAssertionFails As Variant)
''' Set the updatable property WhenAssertionFails
 _PropertySet("WhenAssertionFails", pvWhenAssertionFails)
End Property ' SFUnitTests.SF_UnitTest.WhenAssertionFails (let)

REM ===================================================================== METHODS

REM -----------------------------------------------------------------------------
Public Function AssertAlmostEqual(Optional ByRef A As Variant _
        , Optional ByRef B As Variant _
        , Optional ByVal Tolerance As Variant _
        , Optional ByVal Message As Variant _
        ) As Boolean
''' Returns True when A and B are numerical values and are found close to each other.
''' It is typically used to compare very large or very small numbers.
''' Equality is confirmed when
'''  - A and B can be converted to doubles
'''  - The absolute difference between a and b, relative to the larger absolute value of a or b,
'''    is lower or equal to the tolerance. The default tolerance is 1E-09,
'''   Examples: 1E+12 and 1E+12 + 100 are almost equal
'''      1E-20 and 2E-20 are not almost equal
'''      100 and 95 are almost equal when Tolerance = 0.05

Dim bAssert As Boolean   ' Return value
Const cstTolerance = 1E-09
Const cstThisSub = "UnitTest.AssertAlmostEqual"
Const cstSubArgs = "A, B, [Tolerance=1E-09], [Message=""""]"

Check:
 If IsMissing(A) Then A = Empty
 If IsMissing(B) Then B = Empty
 If IsMissing(Tolerance) Then Tolerance = cstTolerance
 If IsMissing(Message) Then Message = ""
 ScriptForge.SF_Utils._EnterFunction(cstThisSub, cstSubArgs) ' Unconditional !
 If Not ScriptForge.SF_Utils._Validate(Tolerance, "Tolerance", ScriptForge.V_NUMERIC) Then GoTo Catch

Try:
 bAssert = _Assert("AssertAlmostEqual", True, A, B, Message, Tolerance)

Finally:
 AssertAlmostEqual = bAssert
 ScriptForge.SF_Utils._ExitFunction(cstThisSub)
 Exit Function
Catch:
 bAssert = False
 GoTo Finally
End Function ' SFUnitTests.SF_UnitTest.AssertAlmostEqual

REM -----------------------------------------------------------------------------
Public Function AssertEqual(Optional ByRef A As Variant _
        , Optional ByRef B As Variant _
        , Optional ByVal Message As Variant _
        ) As Boolean
''' Returns True when A and B are found equal.
''' Equality is confirmed when
'''  If A and B are scalars:
'''   They should have the same VarType or both be numeric
'''   Booleans and numeric values are compared with the = operator
'''   Strings are compared with the StrComp() builtin function. The comparison is case-sensitive
'''   Dates and times are compared up to the second
'''   Null, Empty and Nothing are not equal, but AssertEqual(Nothing, Nothing) returns True
'''   UNO objects are compared with the EqualUnoObjects() method
'''   Basic objects are NEVER equal
'''  If A and B are arrays:
'''   They should have the same number of dimensions (maximum 2)
'''   The lower and upper bounds must be identical for each dimension
'''   Two empty arrays are equal
'''   Their items must be equal one by one

Dim bAssert As Boolean   ' Return value
Const cstThisSub = "UnitTest.AssertEqual"
Const cstSubArgs = "A, B, [Message=""""]"

Check:
 If IsMissing(A) Then A = Empty
 If IsMissing(B) Then B = Empty
 If IsMissing(Message) Then Message = ""
 ScriptForge.SF_Utils._EnterFunction(cstThisSub, cstSubArgs) ' Unconditional !

Try:
 bAssert = _Assert("AssertEqual", True, A, B, Message)

Finally:
 AssertEqual = bAssert
 ScriptForge.SF_Utils._ExitFunction(cstThisSub)
 Exit Function
End Function ' SFUnitTests.SF_UnitTest.AssertEqual

REM -----------------------------------------------------------------------------
Public Function AssertFalse(Optional ByRef A As Variant _
        , Optional ByVal Message As Variant _
        ) As Boolean
''' Returns True when A is a Boolean and its value is False

Dim bAssert As Boolean   ' Return value
Const cstThisSub = "UnitTest.AssertFalse"
Const cstSubArgs = "A, [Message=""""]"

Check:
 If IsMissing(A) Then A = Empty
 If IsMissing(Message) Then Message = ""
 ScriptForge.SF_Utils._EnterFunction(cstThisSub, cstSubArgs) ' Unconditional !

Try:
 bAssert = _Assert("AssertFalse", True, A, Empty, Message)

Finally:
 AssertFalse = bAssert
 ScriptForge.SF_Utils._ExitFunction(cstThisSub)
 Exit Function
End Function ' SFUnitTests.SF_UnitTest.AssertFalse

REM -----------------------------------------------------------------------------
Public Function AssertGreater(Optional ByRef A As Variant _
        , Optional ByRef B As Variant _
        , Optional ByVal Message As Variant _
        ) As Boolean
''' Returns True when A is greater than B.
''' To compare A and B:
'''  They should have the same VarType or both be numeric
'''  Eligible datatypes are String, Date or numeric.
'''  String comparisons are case-sensitive.

Dim bAssert As Boolean   ' Return value
Const cstThisSub = "UnitTest.AssertGreater"
Const cstSubArgs = "A, B, [Message=""""]"

Check:
 If IsMissing(A) Then A = Empty
 If IsMissing(B) Then B = Empty
 If IsMissing(Message) Then Message = ""
 ScriptForge.SF_Utils._EnterFunction(cstThisSub, cstSubArgs) ' Unconditional !

Try:
 bAssert = _Assert("AssertGreater", True, A, B, Message)

Finally:
 AssertGreater = bAssert
 ScriptForge.SF_Utils._ExitFunction(cstThisSub)
 Exit Function
End Function ' SFUnitTests.SF_UnitTest.AssertGreater

REM -----------------------------------------------------------------------------
Public Function AssertGreaterEqual(Optional ByRef A As Variant _
        , Optional ByRef B As Variant _
        , Optional ByVal Message As Variant _
        ) As Boolean
''' Returns True when A is greater than or equal to B.
''' To compare A and B:
'''  They should have the same VarType or both be numeric
'''  Eligible datatypes are String, Date or numeric.
'''  String comparisons are case-sensitive.

Dim bAssert As Boolean   ' Return value
Const cstThisSub = "UnitTest.AssertGreaterEqual"
Const cstSubArgs = "A, B, [Message=""""]"

Check:
 If IsMissing(A) Then A = Empty
 If IsMissing(B) Then B = Empty
 If IsMissing(Message) Then Message = ""
 ScriptForge.SF_Utils._EnterFunction(cstThisSub, cstSubArgs) ' Unconditional !

Try:
 bAssert = _Assert("AssertGreaterEqual", True, A, B, Message)

Finally:
 AssertGreaterEqual = bAssert
 ScriptForge.SF_Utils._ExitFunction(cstThisSub)
 Exit Function
End Function ' SFUnitTests.SF_UnitTest.AssertGreaterEqual

REM -----------------------------------------------------------------------------
Public Function AssertIn(Optional ByRef A As Variant _
        , Optional ByRef B As Variant _
        , Optional ByVal Message As Variant _
        ) As Boolean
''' Returns True when A, a string, is found within B
''' B may be a 1D array, a ScriptForge dictionary or a string.
''' When B is an array, A may be a date or a numeric value.
''' String comparisons are case-sensitive.

Dim bAssert As Boolean   ' Return value
Const cstThisSub = "UnitTest.AssertIn"
Const cstSubArgs = "A, B, [Message=""""]"

Check:
 If IsMissing(A) Then A = Empty
 If IsMissing(B) Then B = Empty
 If IsMissing(Message) Then Message = ""
 ScriptForge.SF_Utils._EnterFunction(cstThisSub, cstSubArgs) ' Unconditional !

Try:
 bAssert = _Assert("AssertIn", True, A, B, Message)

Finally:
 AssertIn = bAssert
 ScriptForge.SF_Utils._ExitFunction(cstThisSub)
 Exit Function
End Function ' SFUnitTests.SF_UnitTest.AssertIn

REM -----------------------------------------------------------------------------
Public Function AssertIsInstance(Optional ByRef A As Variant _
        , Optional ByRef ObjectType As Variant _
        , Optional ByVal Message As Variant _
        ) As Boolean
''' Returns True when A is an object instance of the class ObjectType or a variable of type ObjectType.
''' A may be:
'''  - a ScriptForge object
'''   ObjectType is a string like "DICTIONARY", "calc", "Dialog", "exception", etc.
'''  - a UNO object
'''   ObjectType is a string identical with values returned by the SF_Session.UnoObjectType()
'''  - any variable, providing it is neither an object nor an array
'''   ObjectType is a string identifying a value returned by the TypeName() builtin function
'''  - an array
'''   ObjectType is expected to be "array"

Dim bAssert As Boolean   ' Return value
Const cstThisSub = "UnitTest.AssertIsInstance"
Const cstSubArgs = "A, ObjectType, [Message=""""]"

Check:
 If IsMissing(A) Then A = Empty
 If IsMissing(ObjectType) Then ObjectType = Empty
 If IsMissing(Message) Then Message = ""
 ScriptForge.SF_Utils._EnterFunction(cstThisSub, cstSubArgs) ' Unconditional !
 If Not ScriptForge.SF_Utils._Validate(ObjectType, "ObjectType", V_STRING) Then GoTo Catch


Try:
 bAssert = _Assert("AssertIsInstance", True, A, Empty, Message, ObjectType)

Finally:
 AssertIsInstance = bAssert
 ScriptForge.SF_Utils._ExitFunction(cstThisSub)
 Exit Function
Catch:
 bAssert = False
 GoTo Finally
End Function ' SFUnitTests.SF_UnitTest.AssertIsInstance

REM -----------------------------------------------------------------------------
Public Function AssertIsNothing(Optional ByRef A As Variant _
        , Optional ByVal Message As Variant _
        ) As Boolean
''' Returns True when A is an object that has the Nothing value

Dim bAssert As Boolean   ' Return value
Const cstThisSub = "UnitTest.AssertIsNothing"
Const cstSubArgs = "A, [Message=""""]"

Check:
 If IsMissing(A) Then A = Empty
 If IsMissing(Message) Then Message = ""
 ScriptForge.SF_Utils._EnterFunction(cstThisSub, cstSubArgs) ' Unconditional !

Try:
 bAssert = _Assert("AssertIsNothing", True, A, Empty, Message)

Finally:
 AssertIsNothing = bAssert
 ScriptForge.SF_Utils._ExitFunction(cstThisSub)
 Exit Function
End Function ' SFUnitTests.SF_UnitTest.AssertIsNothing

REM -----------------------------------------------------------------------------
Public Function AssertIsNull(Optional ByRef A As Variant _
        , Optional ByVal Message As Variant _
        ) As Boolean
''' Returns True when A has the Null value

Dim bAssert As Boolean   ' Return value
Const cstThisSub = "UnitTest.AssertIsNull"
Const cstSubArgs = "A, [Message=""""]"

Check:
 If IsMissing(A) Then A = Empty
 If IsMissing(Message) Then Message = ""
 ScriptForge.SF_Utils._EnterFunction(cstThisSub, cstSubArgs) ' Unconditional !

Try:
 bAssert = _Assert("AssertIsNull", True, A, Empty, Message)

Finally:
 AssertIsNull = bAssert
 ScriptForge.SF_Utils._ExitFunction(cstThisSub)
 Exit Function
End Function ' SFUnitTests.SF_UnitTest.AssertIsNull

REM -----------------------------------------------------------------------------
Public Function AssertLess(Optional ByRef A As Variant _
        , Optional ByRef B As Variant _
        , Optional ByVal Message As Variant _
        ) As Boolean
''' Returns True when A is less than B.
''' To compare A and B:
'''  They should have the same VarType or both be numeric
'''  Eligible datatypes are String, Date or numeric.
'''  String comparisons are case-sensitive.

Dim bAssert As Boolean   ' Return value
Const cstThisSub = "UnitTest.AssertLess"
Const cstSubArgs = "A, B, [Message=""""]"

Check:
 If IsMissing(A) Then A = Empty
 If IsMissing(B) Then B = Empty
 If IsMissing(Message) Then Message = ""
 ScriptForge.SF_Utils._EnterFunction(cstThisSub, cstSubArgs) ' Unconditional !

Try:
 bAssert = _Assert("AssertLess", False, A, B, Message)

Finally:
 AssertLess = bAssert
 ScriptForge.SF_Utils._ExitFunction(cstThisSub)
 Exit Function
End Function ' SFUnitTests.SF_UnitTest.AssertLess

REM -----------------------------------------------------------------------------
Public Function AssertLessEqual(Optional ByRef A As Variant _
        , Optional ByRef B As Variant _
        , Optional ByVal Message As Variant _
        ) As Boolean
''' Returns True when A is less than or equal to B.
''' To compare A and B:
'''  They should have the same VarType or both be numeric
'''  Eligible datatypes are String, Date or numeric.
'''  String comparisons are case-sensitive.

Dim bAssert As Boolean   ' Return value
Const cstThisSub = "UnitTest.AssertLessEqual"
Const cstSubArgs = "A, B, [Message=""""]"

Check:
 If IsMissing(A) Then A = Empty
 If IsMissing(B) Then B = Empty
 If IsMissing(Message) Then Message = ""
 ScriptForge.SF_Utils._EnterFunction(cstThisSub, cstSubArgs) ' Unconditional !

Try:
 bAssert = _Assert("AssertLessEqual", False, A, B, Message)

Finally:
 AssertLessEqual = bAssert
 ScriptForge.SF_Utils._ExitFunction(cstThisSub)
 Exit Function
End Function ' SFUnitTests.SF_UnitTest.AssertLessEqual

REM -----------------------------------------------------------------------------
Public Function AssertLike(Optional ByRef A As Variant _
        , Optional ByRef Pattern As Variant _
        , Optional ByVal Message As Variant _
        ) As Boolean
''' Returns True if string A matches a given pattern containing wildcards
''' Admitted wildcard are: the "?" represents any single character
'''       the "*" represents zero, one, or multiple characters
''' The comparison is case-sensitive.

Dim bAssert As Boolean   ' Return value
Const cstThisSub = "UnitTest.AssertLike"
Const cstSubArgs = "A, Pattern, [Message=""""]"

Check:
 If IsMissing(A) Then A = Empty
 If IsMissing(Pattern) Then Pattern = ""
 If IsMissing(Message) Then Message = ""
 ScriptForge.SF_Utils._EnterFunction(cstThisSub, cstSubArgs) ' Unconditional !
 If Not ScriptForge.SF_Utils._Validate(Pattern, "Pattern", V_STRING) Then GoTo Catch

Try:
 bAssert = _Assert("AssertLike", True, A, Empty, Message, Pattern)

Finally:
 AssertLike = bAssert
 ScriptForge.SF_Utils._ExitFunction(cstThisSub)
 Exit Function
Catch:
 bAssert = False
 GoTo Finally
End Function ' SFUnitTests.SF_UnitTest.AssertLike

REM -----------------------------------------------------------------------------
Public Function AssertNotAlmostEqual(Optional ByRef A As Variant _
        , Optional ByRef B As Variant _
        , Optional ByVal Tolerance As Variant _
        , Optional ByVal Message As Variant _
        ) As Boolean
''' Returns True when A and B are numerical values and are not found close to each other.
''' Read about almost equality in the comments linked to the AssertEqual() method.

Dim bAssert As Boolean   ' Return value
Const cstTolerance = 1E-09
Const cstThisSub = "UnitTest.AssertNotAlmostEqual"
Const cstSubArgs = "A, B, [Tolerance=1E-09], [Message=""""]"

Check:
 If IsMissing(A) Then A = Empty
 If IsMissing(B) Then B = Empty
 If IsMissing(Tolerance) Then Tolerance = cstTolerance
 If IsMissing(Message) Then Message = ""
 ScriptForge.SF_Utils._EnterFunction(cstThisSub, cstSubArgs) ' Unconditional !
 If Not ScriptForge.SF_Utils._Validate(Tolerance, "Tolerance", ScriptForge.V_NUMERIC) Then GoTo Catch

Try:
 bAssert = _Assert("AssertNotAlmostEqual", False, A, B, Message, Tolerance)

Finally:
 AssertNotAlmostEqual = bAssert
 ScriptForge.SF_Utils._ExitFunction(cstThisSub)
 Exit Function
Catch:
 bAssert = False
 GoTo Finally
End Function ' SFUnitTests.SF_UnitTest.AssertNotAlmostEqual

REM -----------------------------------------------------------------------------
Public Function AssertNotEqual(Optional ByRef A As Variant _
        , Optional ByRef B As Variant _
        , Optional ByVal Message As Variant _
        ) As Boolean
''' Returns True when A and B are found unequal.
''' Read about equality in the comments linked to the AssertEqual() method.

Dim bAssert As Boolean   ' Return value
Const cstThisSub = "UnitTest.AssertNotEqual"
Const cstSubArgs = "A, B, [Message=""""]"

Check:
 If IsMissing(A) Then A = Empty
 If IsMissing(B) Then B = Empty
 If IsMissing(Message) Then Message = ""
 ScriptForge.SF_Utils._EnterFunction(cstThisSub, cstSubArgs) ' Unconditional !

Try:
 bAssert = _Assert("AssertNotEqual", False, A, B, Message)

Finally:
 AssertNotEqual = bAssert
 ScriptForge.SF_Utils._ExitFunction(cstThisSub)
 Exit Function
End Function ' SFUnitTests.SF_UnitTest.AssertNotEqual

REM -----------------------------------------------------------------------------
Public Function AssertNotIn(Optional ByRef A As Variant _
        , Optional ByRef B As Variant _
        , Optional ByVal Message As Variant _
        ) As Boolean
''' Returns True when A, a string, is not found within B
''' B may be a 1D array, a ScriptForge dictionary or a string.
''' When B is an array, A may be a date or a numeric value.
''' String comparisons are case-sensitive.

Dim bAssert As Boolean   ' Return value
Const cstThisSub = "UnitTest.AssertNotIn"
Const cstSubArgs = "A, B, [Message=""""]"

Check:
 If IsMissing(A) Then A = Empty
 If IsMissing(B) Then B = Empty
 If IsMissing(Message) Then Message = ""
 ScriptForge.SF_Utils._EnterFunction(cstThisSub, cstSubArgs) ' Unconditional !

Try:
 bAssert = _Assert("AssertNotIn", False, A, B, Message)

Finally:
 AssertNotIn = bAssert
 ScriptForge.SF_Utils._ExitFunction(cstThisSub)
 Exit Function
End Function ' SFUnitTests.SF_UnitTest.AssertNotIn

REM -----------------------------------------------------------------------------
Public Function AssertNotInstance(Optional ByRef A As Variant _
        , Optional ByRef ObjectType As Variant _
        , Optional ByVal Message As Variant _
        ) As Boolean
''' Returns True when A is an object instance of the class ObjectType or a variable of type ObjectType.
''' More details to be read under the AssertInstance() function.

Dim bAssert As Boolean   ' Return value
Const cstThisSub = "UnitTest.AssertNotInstance"
Const cstSubArgs = "A, ObjectType, [Message=""""]"

Check:
 If IsMissing(A) Then A = Empty
 If IsMissing(ObjectType) Then ObjectType = Empty
 If IsMissing(Message) Then Message = ""
 ScriptForge.SF_Utils._EnterFunction(cstThisSub, cstSubArgs) ' Unconditional !
 If Not ScriptForge.SF_Utils._Validate(ObjectType, "ObjectType", V_STRING) Then GoTo Catch

Try:
 bAssert = _Assert("AssertNotInstance", False, A, Empty, Message, ObjectType)

Finally:
 AssertNotInstance = bAssert
 ScriptForge.SF_Utils._ExitFunction(cstThisSub)
 Exit Function
Catch:
 bAssert = False
 GoTo Finally
End Function ' SFUnitTests.SF_UnitTest.AssertNotInstance

REM -----------------------------------------------------------------------------
Public Function AssertNotLike(Optional ByRef A As Variant _
        , Optional ByRef Pattern As Variant _
        , Optional ByVal Message As Variant _
        ) As Boolean
''' Returns True if A is not a string or does not match a given pattern containing wildcards
''' Admitted wildcard are: the "?" represents any single character
'''       the "*" represents zero, one, or multiple characters
''' The comparison is case-sensitive.

Dim bAssert As Boolean   ' Return value
Const cstThisSub = "UnitTest.AssertNotLike"
Const cstSubArgs = "A, Pattern, [Message=""""]"

Check:
 If IsMissing(A) Then A = Empty
 If IsMissing(Pattern) Then Pattern = ""
 If IsMissing(Message) Then Message = ""
 ScriptForge.SF_Utils._EnterFunction(cstThisSub, cstSubArgs) ' Unconditional !
 If Not ScriptForge.SF_Utils._Validate(Pattern, "Pattern", V_STRING) Then GoTo Catch

Try:
 bAssert = _Assert("AssertNotLike", False, A, Empty, Message, Pattern)

Finally:
 AssertNotLike = bAssert
 ScriptForge.SF_Utils._ExitFunction(cstThisSub)
 Exit Function
Catch:
 bAssert = False
 GoTo Finally
End Function ' SFUnitTests.SF_UnitTest.AssertNotLike

REM -----------------------------------------------------------------------------
Public Function AssertNotNothing(Optional ByRef A As Variant _
        , Optional ByVal Message As Variant _
        ) As Boolean
''' Returns True except when A is an object that has the Nothing value

Dim bAssert As Boolean   ' Return value
Const cstThisSub = "UnitTest.AssertNotNothing"
Const cstSubArgs = "A, [Message=""""]"

Check:
 If IsMissing(A) Then A = Empty
 If IsMissing(Message) Then Message = ""
 ScriptForge.SF_Utils._EnterFunction(cstThisSub, cstSubArgs) ' Unconditional !

Try:
 bAssert = _Assert("AssertNotNothing", False, A, Empty, Message)

Finally:
 AssertNotNothing = bAssert
 ScriptForge.SF_Utils._ExitFunction(cstThisSub)
 Exit Function
End Function ' SFUnitTests.SF_UnitTest.AssertNotNothing

REM -----------------------------------------------------------------------------
Public Function AssertNotNull(Optional ByRef A As Variant _
        , Optional ByVal Message As Variant _
        ) As Boolean
''' Returns True except when A has the Null value

Dim bAssert As Boolean   ' Return value
Const cstThisSub = "UnitTest.AssertNotNull"
Const cstSubArgs = "A, [Message=""""]"

Check:
 If IsMissing(A) Then A = Empty
 If IsMissing(Message) Then Message = ""
 ScriptForge.SF_Utils._EnterFunction(cstThisSub, cstSubArgs) ' Unconditional !

Try:
 bAssert = _Assert("AssertNotNull", False, A, Empty, Message)

Finally:
 AssertNotNull = bAssert
 ScriptForge.SF_Utils._ExitFunction(cstThisSub)
 Exit Function
End Function ' SFUnitTests.SF_UnitTest.AssertNotNull

REM -----------------------------------------------------------------------------
Public Function AssertNotRegex(Optional ByRef A As Variant _
        , Optional ByRef Regex As Variant _
        , Optional ByVal Message As Variant _
        ) As Boolean
''' Returns True when A is not a string or does not match the given regular expression.
''' The comparison is case-sensitive.

Dim bAssert As Boolean   ' Return value
Const cstThisSub = "UnitTest.AssertNotRegex"
Const cstSubArgs = "A, Regex, [Message=""""]"

Check:
 If IsMissing(A) Then A = Empty
 If IsMissing(Regex) Then Regex = ""
 If IsMissing(Message) Then Message = ""
 ScriptForge.SF_Utils._EnterFunction(cstThisSub, cstSubArgs) ' Unconditional !
 If Not ScriptForge.SF_Utils._Validate(Regex, "Regex", V_STRING) Then GoTo Catch

Try:
 bAssert = _Assert("AssertNotRegex", False, A, Empty, Message, Regex)

Finally:
 AssertNotRegex = bAssert
 ScriptForge.SF_Utils._ExitFunction(cstThisSub)
 Exit Function
Catch:
 bAssert = False
 GoTo Finally
End Function ' SFUnitTests.SF_UnitTest.AssertNotRegex

REM -----------------------------------------------------------------------------
Public Function AssertRegex(Optional ByRef A As Variant _
        , Optional ByRef Regex As Variant _
        , Optional ByVal Message As Variant _
        ) As Boolean
''' Returns True when string A matches the given regular expression.
''' The comparison is case-sensitive.

Dim bAssert As Boolean   ' Return value
Const cstThisSub = "UnitTest.AssertRegex"
Const cstSubArgs = "A, Regex, [Message=""""]"

Check:
 If IsMissing(A) Then A = Empty
 If IsMissing(Regex) Then Regex = ""
 If IsMissing(Message) Then Message = ""
 ScriptForge.SF_Utils._EnterFunction(cstThisSub, cstSubArgs) ' Unconditional !
 If Not ScriptForge.SF_Utils._Validate(Regex, "Regex", V_STRING) Then GoTo Catch

Try:
 bAssert = _Assert("AssertRegex", True, A, Empty, Message, Regex)

Finally:
 AssertRegex = bAssert
 ScriptForge.SF_Utils._ExitFunction(cstThisSub)
 Exit Function
Catch:
 bAssert = False
 GoTo Finally
End Function ' SFUnitTests.SF_UnitTest.AssertRegex

REM -----------------------------------------------------------------------------
Public Function AssertTrue(Optional ByRef A As Variant _
        , Optional ByVal Message As Variant _
        ) As Boolean
''' Returns True when A is a Boolean and its value is True

Dim bAssert As Boolean   ' Return value
Const cstThisSub = "UnitTest.AssertTrue"
Const cstSubArgs = "A, [Message=""""]"

Check:
 If IsMissing(A) Then A = Empty
 If IsMissing(Message) Then Message = ""
 ScriptForge.SF_Utils._EnterFunction(cstThisSub, cstSubArgs) ' Unconditional !

Try:
 bAssert = _Assert("AssertTrue", True, A, Empty, Message)

Finally:
 AssertTrue = bAssert
 ScriptForge.SF_Utils._ExitFunction(cstThisSub)
 Exit Function
End Function ' SFUnitTests.SF_UnitTest.AssertTrue

REM -----------------------------------------------------------------------------
Public Sub Fail(Optional ByVal Message As Variant)
''' Forces a test failure

Dim bAssert As Boolean   ' Fictive return value
Const cstThisSub = "UnitTest.Fail"
Const cstSubArgs = "[Message=""""]"

Check:
 If IsMissing(Message) Then Message = ""
 ScriptForge.SF_Utils._EnterFunction(cstThisSub, cstSubArgs) ' Unconditional !

Try:
 bAssert = _Assert("Fail", False, Empty, Empty, Message)

Finally:
 ScriptForge.SF_Utils._ExitFunction(cstThisSub)
 Exit Sub
End Sub ' SFUnitTests.SF_UnitTest.Fail

REM -----------------------------------------------------------------------------
Public Sub Log(Optional ByVal Message As Variant)
''' Records the given message in the test report (console)

Dim bAssert As Boolean   ' Fictive return value
Dim bVerbose As Boolean   : bVerbose = _Verbose
Const cstThisSub = "UnitTest.Log"
Const cstSubArgs = "[Message=""""]"

Check:
 If IsMissing(Message) Then Message = ""
 ScriptForge.SF_Utils._EnterFunction(cstThisSub, cstSubArgs) ' Unconditional !

Try:
 ' Force the display of the message in the console
 _Verbose = True
 bAssert = _Assert("Log", True, Empty, Empty, Message)
 _Verbose = bVerbose

Finally:
 ScriptForge.SF_Utils._ExitFunction(cstThisSub)
 Exit Sub
End Sub ' SFUnitTests.SF_UnitTest.Log

REM -----------------------------------------------------------------------------
Public Function GetProperty(Optional ByVal PropertyName As Variant) As Variant
''' Return the actual value of the given property
''' Args:
'''  PropertyName: the name of the property as a string
''' Returns:
'''  The actual value of the property
''' Exceptions
'''  ARGUMENTERROR  The property does not exist
''' Examples:
'''  myUnitTest.GetProperty("Duration")

Const cstThisSub = "UnitTest.GetProperty"
Const cstSubArgs = "PropertyName"

 If ScriptForge.SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
 GetProperty = Null

Check:
 If ScriptForge.SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then
  If Not ScriptForge.SF_Utils._Validate(PropertyName, "PropertyName", V_STRING, Properties()) Then GoTo Catch
 End If

Try:
 GetProperty = _PropertyGet(PropertyName)

Finally:
 ScriptForge.SF_Utils._ExitFunction(cstThisSub)
 Exit Function
Catch:
 GoTo Finally
End Function ' SFUnitTests.SF_UnitTest.Properties

REM -----------------------------------------------------------------------------
Public Function Methods() As Variant
''' Return the list or methods of the UnitTest class as an array

 Methods = Array( _
     "AssertAlmostEqual" _
     , "AssertEqual" _
     , "AssertFalse" _
     , "AssertGreater" _
     , "AssertGreaterEqual" _
     , "AssertIn" _
     , "AssertIsInstance" _
     , "AssertIsNothing" _
     , "AssertLike" _
     , "AssertNotRegex" _
     , "AssertIsNull" _
     , "AssertLess" _
     , "AssertLessEqual" _
     , "AssertNotAlmostEqual" _
     , "AssertNotEqual" _
     , "AssertNotIn" _
     , "AssertNotInstance" _
     , "AssertNotLike" _
     , "AssertNotNothing" _
     , "AssertNotNull" _
     , "AssertRegex" _
     , "AssertTrue" _
     , "Fail" _
     , "Log" _
     , "RunTest" _
     , "SkipTest" _
     )

End Function ' SFUnitTests.SF_UnitTest.Methods

REM -----------------------------------------------------------------------------
Public Function Properties() As Variant
''' Return the list or properties of the UnitTest class as an array

 Properties = Array( _
     "LongMessage" _
     , "ReturnCode" _
     , "Verbose" _
     , "WhenAssertionFails" _
     )

End Function ' SFUnitTests.SF_UnitTest.Properties

REM -----------------------------------------------------------------------------
Public Sub ReportError(Optional ByVal Message As Variant)
''' DIsplay a message box with the current property values of the "Exception" service.
''' Depending on the WhenAssertionFails property, a Raise() or RaiseWarning()
''' is issued. The Raise() method stops completely the Basic running process.
''' The ReportError() method is presumed present in a user script in an error
''' handling part of the actual testcase.
''' Args:
'''  Message: a string to replace or to complete the standard message description
''' Example:
'''  See the Test_ArraySize() sub in the module's heading example

Dim sLine As String    ' Line number where the error occurred
Dim sError As String   ' Exception description
Dim sErrorCode As String  ' Exception number
Const cstThisSub = "UnitTest.ReportError"
Const cstSubArgs = "[Message=""""]"

Check:
 If IsMissing(Message) Or IsEmpty(Message) Then Message = ""
 ScriptForge.SF_Utils._EnterFunction(cstThisSub, cstSubArgs) ' Unconditional !
 If VarType(Message) <> V_STRING Then Message = ""

Try:
 sLine = "ln " & CStr(Exception.Source)
 If _ExecutionMode = FULLMODE Then sLine = _Module & "." & _TestCase & " " & sLine
 If Len(Message) > 0 Then
  sError = Message
 Else
  If Exception.Number = INVALIDPROCEDURECALL Then
   sError = "Test case failure"
   sErrorCode = "ASSERTIONFAILED"
  Else
   sError = Exception.Description
   sErrorCode = CStr(Exception.Number)
  End If
 End If

 Select Case _WhenAssertionFails
  Case FAILIGNORE
  Case FAILSTOPSUITE
   Exception.RaiseWarning(sErrorCode, sLine, sError)
  Case FAILIMMEDIATESTOP
   Exception.Raise(sErrorCode, sLine, sError)
 End Select

Finally:
 ScriptForge.SF_Utils._ExitFunction(cstThisSub)
 Exit Sub
End Sub   ' SFUnitTests.SF_UnitTest.ReportError
REM -----------------------------------------------------------------------------
Public Function RunTest(Optional ByVal TestSuite As Variant _
       , Optional ByVal TestCasePattern As Variant _
       , Optional ByVal Message As Variant _
       ) As Integer
''' Execute a test suite pointed out by a module name.
''' Each test case will be run independently from each other.
''' The names of the test cases to be run may be selected with a string pattern.
''' The test is "orchestrated" by this method:
'''  1. Execute the optional Setup() method present in the module
'''  2. Execute once each test case, in any order
'''  3, Execute the optional TearDown() method present in the module
''' Args:
'''  TestSuite: the name of the module containing the set of test cases to run
'''  TestCasePattern: the pattern that the test cases must match. The comparison is not case-sensitive.
'''   Non-matching functions and subs are ignored.
'''   Admitted wildcard are: the "?" represents any single character
'''         the "*" represents zero, one, or multiple characters
'''   The default pattern is "Test_*"
'''  Message: the message to be displayed in the console when the test starts.
''' Returns:
'''  One of the return codes of the execution (RCxxx constants)
''' Examples:
'''  GlobalScope.BasicLibraries.loadLibrary("ScriptForge")
'''  Dim test : test = CreateScriptService("UnitTest", ThisComponent, "Tests")
'''  test.RunTest("AllTests") ' AllTests is a module name ; test cases are named "Test_*" (default)

Dim iRun As Integer     ' Return value
Dim sRunMessage As String   ' Reporting
Dim iModule As Integer    ' Index of module currently running
Dim vMethods As Variant    ' Set of methods
Dim sMethod As String    ' A single method
Dim iMethod As Integer    ' Index in MethodNames
Dim m As Integer

Const cstThisSub = "UnitTest.RunTest"
Const cstSubArgs = "TestSuite, [TestCasePattern=""Test_*""], [Message=""""]"

 iRun = RCNORMALEND
 If ScriptForge.SF_Utils._ErrorHandling() Then On Local Error GoTo Catch

Check:
 If IsMissing(TestCasePattern) Or IsEmpty(TestCasePattern) Then TestCasePattern = "Test_*"
 If IsMissing(Message) Or IsEmpty(Message) Then Message = ""
 ScriptForge.SF_Utils._EnterFunction(cstThisSub, cstSubArgs) ' Unconditional !
 If Not ScriptForge.SF_Utils._Validate(TestSuite, "TestSuite", V_STRING, ModuleNames) Then GoTo Catch
 If Not ScriptForge.SF_Utils._Validate(TestCasePattern, "TestCasePattern", V_STRING) Then GoTo Catch
 If Not ScriptForge.SF_Utils._Validate(Message, "Message", V_STRING) Then GoTo Catch

 ' A RunTest() is forbidden inside a test suite or when simple mode
 If _Status <> STATUSSTANDBY Or _ExecutionMode <> FULLMODE Then GoTo CatchMethod

 ' Ignore any call when an abnormal end has been encountered
 If _ReturnCode = RCABORTTEST Then GoTo Catch

Try:
 iModule = ScriptForge.SF_Array.IndexOf(ModuleNames, TestSuite, CaseSensitive := False, SortOrder := "ASC")
 _Module = ModuleNames(iModule)

 ' Start timer
 If Not IsNull(SuiteTimer) Then SuiteTimer = SuiteTimer.Dispose()
 Set SuiteTimer = CreateScriptService("ScriptForge.Timer", True)

 ' Report the start of a new test suite
 sRunMessage =  "RUNTEST ENTER testsuite='" & LibraryName & "." & _Module & "', pattern='" & TestCasePattern & "'"
 _ReportMessage(sRunMessage, Message)
 _Status = STATUSSUITESTARTED

 ' Collect all the methods of the module
 If Modules(iModule).hasChildNodes() Then
  vMethods = Modules(iModule).getChildNodes()
  MethodNames = Array()
  For m = 0 To UBound(vMethods)
   sMethod = vMethods(m).getName()
   MethodNames = ScriptForge.SF_Array.Append(MethodNames, sMethod)
  Next m
 End If

 ' Execute the Setup() method, if it exists
 iMethod = ScriptForge.SF_Array.IndexOf(MethodNames, "Setup", CaseSensitive := False, SortOrder := "ASC")
 If iMethod >= 0 Then
  _TestCase = MethodNames(iMethod) ' _TestCase is used in ReportError()
  If Not _ExecuteScript(_TestCase) Then GoTo Catch
 End If

 ' Execute the test cases that match the pattern
 For iMethod = 0 To UBound(MethodNames)
  If _ReturnCode = RCSKIPTEST Or _ReturnCode = RCASSERTIONFAILED Then Exit For
  sMethod = MethodNames(iMethod)
  If ScriptForge.SF_String.IsLike(sMethod, TestCasePattern, CaseSensitive := False) Then
   _TestCase = sMethod
   ' Start timer
   If Not IsNull(CaseTimer) Then CaseTimer = CaseTimer.Dispose()
   Set CaseTimer = CreateScriptService("ScriptForge.Timer", True)
   If Not _ExecuteScript(sMethod) Then GoTo Catch
   CaseTimer.Terminate()
   _TestCase = ""
  End If
 Next iMethod

 If _ReturnCode <> RCSKIPTEST Then
  ' Execute the TearDown() method, if it exists
  iMethod = ScriptForge.SF_Array.IndexOf(MethodNames, "TearDown", CaseSensitive := False, SortOrder := "ASC")
  If iMethod >= 0 Then
   _TestCase = MethodNames(iMethod) ' _TestCase is used in ReportError()
   If Not _ExecuteScript(_TestCase) Then GoTo Catch
  End If
 End If
 iRun = _ReturnCode

 ' Report the end of the current test suite
 sRunMessage = "RUNTEST EXIT testsuite='" & LibraryName & "." & _Module & "' " & _Duration("Suite", True)
 _ReportMessage(sRunMessage, Message)

 ' Stop timer
 SuiteTimer.Terminate()

 ' Housekeeping
 MethodNames = Array()
 _Module = ""
 _Status = STATUSSTANDBY

Finally:
 _ReturnCode = iRun
 RunTest = iRun
 ScriptForge.SF_Utils._ExitFunction(cstThisSub)
 Exit Function
Catch:
 iRun = RCABORTTEST
 GoTo Finally
CatchMethod:
 ScriptForge.SF_Exception.RaiseFatal(UNITTESTMETHODERROR, "RunTest")
 GoTo Catch
End Function ' SFUnitTests.SF_UnitTest.RunTest

REM -----------------------------------------------------------------------------
Public Function SetProperty(Optional ByVal PropertyName As Variant _
        , Optional ByRef Value As Variant _
        ) As Boolean
''' Set a new value to the given property
''' Args:
'''  PropertyName: the name of the property as a string
'''  Value: its new value
''' Exceptions
'''  ARGUMENTERROR  The property does not exist

Const cstThisSub = "UnitTest.SetProperty"
Const cstSubArgs = "PropertyName, Value"

 If ScriptForge.SF_Utils._ErrorHandling() Then On Local Error GoTo Catch
 SetProperty = False

Check:
 If ScriptForge.SF_Utils._EnterFunction(cstThisSub, cstSubArgs) Then
  If Not ScriptForge.SF_Utils._Validate(PropertyName, "PropertyName", V_STRING, Properties()) Then GoTo Catch
 End If

Try:
 SetProperty = _PropertySet(PropertyName, Value)

Finally:
 ScriptForge.SF_Utils._ExitFunction(cstThisSub)
 Exit Function
Catch:
 GoTo Finally
End Function ' SFUnitTests.SF_UnitTest.SetProperty

REM -----------------------------------------------------------------------------
Public Function SkipTest(Optional ByVal Message As Variant) As Boolean
''' Interrupt the running test suite. The TearDown() method is NOT executed.
''' The SkipTest() method is normally meaningful only in a Setup() method when not all the
''' conditions to run the test are met.
''' It is up to the Setup() script to exit shortly after the SkipTest() call..
''' The method may also be executed in a test case. Next test cases will not be executed.
''' Remember however that the test cases are executed is an arbitrary order.
''' Args:
'''  Message: the message to be displayed in the console
''' Returns:
'''  True when successful
''' Examples:
'''  GlobalScope.BasicLibraries.loadLibrary("ScriptForge")
'''  Dim test : test = CreateScriptService("UnitTest", ThisComponent, "Tests")
'''  test.SkipTest("AllTests") ' AllTests is a module name ; test cases are named "Test_*" (default)

Dim bSkip As Boolean    ' Return value
Dim sSkipMessage As String   ' Reporting

Const cstThisSub = "UnitTest.SkipTest"
Const cstSubArgs = "[Message=""""]"

 bSkip = False
 If ScriptForge.SF_Utils._ErrorHandling() Then On Local Error GoTo Catch

Check:
 If IsMissing(Message) Or IsEmpty(Message) Then Message = ""
 ScriptForge.SF_Utils._EnterFunction(cstThisSub, cstSubArgs) ' Unconditional !
 If Not ScriptForge.SF_Utils._Validate(Message, "Message", V_STRING) Then GoTo Catch

 ' A SkipTest() is forbidden when simple mode
 If _ExecutionMode <> FULLMODE Then GoTo CatchMethod

 ' Ignore any call when an abnormal end has been encountered
 If _ReturnCode = RCABORTTEST Then GoTo Catch

Try:
 If _Status = STATUSSETUP Or _Status = STATUSTESTCASE Then
  _ReturnCode = RCSKIPTEST
  bSkip = True
  ' Exit message
  sSkipMessage = "    SKIPTEST testsuite='" & LibraryName & "." & _Module & "' " & _Duration("Suite", True)
  _ReportMessage(sSkipMessage, Message)
 End If

Finally:
 SkipTest = bSkip
 ScriptForge.SF_Utils._ExitFunction(cstThisSub)
 Exit Function
Catch:
 _ReturnCode = RCABORTTEST
 GoTo Finally
CatchMethod:
 ScriptForge.SF_Exception.RaiseFatal(UNITTESTMETHODERROR, "SkipTest")
 GoTo Catch
End Function ' SFUnitTests.SF_UnitTest.SkipTest

REM =========================================================== PRIVATE FUNCTIONS

REM -----------------------------------------------------------------------------
Private Function _Assert(ByVal psAssert As String _
       , ByVal pvReturn As Variant _
       , ByRef A As Variant _
       , ByRef B As Variant _
       , Optional ByVal pvMessage As Variant _
       , Optional ByVal pvArg As Variant _
       ) As Boolean
''' Evaluation of the assertion and management of the success or the failure
''' Args:
'''  psAssert: the assertion verb as a string
'''  pvReturn: may be True, False or Empty
'''   When True (resp. False), the assertion must be evaluated as True (resp. False)
'''    e.g. AssertEqual() will call _Assert("AssertEqual", True, ...)
'''      AssertNotEqual() will call _Assert("AssertNotEqual", False, ...)
'''   Empty may be used for recursive calls of the function (for comparing arrays, ...)
'''  A: always present
'''  B: may be empty
'''  pvMessage: the message to display on the console
'''  pvArg: optional additional argument of the assert function
''' Returns:
'''  True when success

Dim bAssert As Boolean   ' Return value
Dim bEval As Boolean   ' To be compared with pvReturn
Dim iVarTypeA As Integer  ' Alias of _VarTypeExt(A)
Dim iVarTypeB As Integer  ' Alias of _VarTypeExt(B)
Dim oVarTypeObjA As Object  ' SF_Utils.ObjectDescriptor
Dim oVarTypeObjB As Object  ' SF_Utils.ObjectDescriptor
Dim oUtils As Object   : Set oUtils = ScriptForge.SF_Utils
Dim iDims As Integer   ' Number of dimensions of array
Dim oAliasB As Object   ' Alias of B to bypass the "Object variable not set" issue
Dim dblA As Double    ' Alias of A
Dim dblB As Double    ' Alias of B
Dim dblTolerance As Double  ' Alias of pvArg
Dim oString As Object   : Set oString = ScriptForge.SF_String
Dim sArgName As String   ' Argument description
Dim i As Long, j As Long

Check:
 bAssert = False
 If IsMissing(pvMessage) Then pvMessage = ""
 If Not oUtils._Validate(pvMessage, "Message", V_STRING) Then GoTo Finally
 If IsMissing(pvArg) Then pvArg = ""

Try:
 iVarTypeA = oUtils._VarTypeExt(A)
 iVarTypeB = oUtils._VarTypeExt(B)
 sArgName = ""

 Select Case UCase(psAssert)
  Case UCase("AssertAlmostEqual"), UCase("AssertNotAlmostEqual")
   bEval = ( iVarTypeA = iVarTypeB And iVarTypeA = ScriptForge.V_NUMERIC )
   If bEval Then
    dblA = CDbl(A)
    dblB = CDbl(B)
    dblTolerance = Abs(CDbl(pvArg))
    bEval = ( Abs(dblA - dblB) <= (dblTolerance * Iif(Abs(dblA) > Abs(DblB), Abs(dblA), Abs(dblB))) )
   End If
  Case UCase("AssertEqual"), UCase("AssertNotEqual")
   If Not IsArray(A) Then
    bEval = ( iVarTypeA = iVarTypeB )
    If bEval Then
     Select Case iVarTypeA
      Case V_EMPTY, V_NULL
      Case V_STRING
       bEval = ( StrComp(A, B, 1) = 0 )
      Case ScriptForge.V_NUMERIC, ScriptForge.V_BOOLEAN
       bEval = ( A = B )
      Case V_DATE
       bEval = ( Abs(DateDiff("s", A, B)) = 0 )
      Case ScriptForge.V_OBJECT
       Set oVarTypeObjA = oUtils._VarTypeObj(A)
       Set oVarTypeObjB = oUtils._VarTypeObj(B)
       bEval = ( oVarTypeObjA.iVarType = oVarTypeObjB.iVarType )
       If bEval Then
        Select Case oVarTypeObjA.iVarType
         Case ScriptForge.V_NOTHING
         Case ScriptForge.V_UNOOBJECT
          bEval = EqualUnoObjects(A, B)
         Case ScriptForge.V_SFOBJECT, ScriptForge.V_BASICOBJECT
          bEval = False
        End Select
       End If
     End Select
    End If
   Else ' Compare arrays
--> --------------------

--> maximum size reached

--> --------------------