Option Explicit 

' vbslib  ver3.00  Sep.22, 2009
' Copyright (c) 2008-2009, T's-Neko at Sage Plaisir 21 (Japan)
' All rights reserved. Based on 3-clause BSD license.

Dim  g_SrcPath
Dim  g_TestScript_Path
     g_TestScript_Path = g_SrcPath


' Global Variable
Dim  g_Test, g_echo_on

Function  InitializeModule
  g_echo_on = True
  Set  g_Test = New TestScript : ErrCheck
End Function
Dim  g_InitializeModule
Set  g_InitializeModule = GetRef( "InitializeModule" )

Const  Err_TestPass = 21
Const  Err_TestSkip = 22
Const  Err_TestFail = 23

 
'********************************************************************************
'  <<< [call_vbs_t] >>> 
'   - The difference of call_vbs is not depend on vbslib.
'   - path, func as string, param as variant
'********************************************************************************
Function  call_vbs_t( ByVal path, ByVal func, param )
  Dim oldDir, f, funcX, in_interpret, en, ed, es

  in_interpret = False
  oldDir = g_sh.CurrentDirectory

  path = g_sh.ExpandEnvironmentStrings( path )
  path = g_fs.GetAbsolutePathName( path )

  '-----------------------------------------
  ' Interpret

  g_SrcPath = path

  On Error Resume Next

    g_sh.CurrentDirectory = g_fs.GetParentFolderName( path )
    If Err=0 Then  Set f = g_fs.OpenTextFile( g_fs.GetFileName( path ) )
    If Err=0 Then  in_interpret = True : ExecuteGlobal f.ReadAll()
    If Err=&h411 Then  in_interpret = False : Err.Clear  ' Ignore symbol override error
    If Err=0 Then  in_interpret = False
    If Err=0 Then  Set funcX = GetRef( func )

  en = Err.Number : es = Err.Source : ed = Err.Description : On Error GoTo 0
  If en <> 0 Then
    If in_interpret Then
      ed = ed + " Syntax Error in """ + g_fs.GetFileName( path ) _
              + """. Please double click """ _
              + g_fs.GetFileName( path ) + """."
    End If
    If en = &h35 Then  ed = "Not found file '" + path
    If en = 5 Then  ed = "Not found func name '" + func + "' in " + path
  End If
  f.Close


  '-----------------------------------------
  ' Call
  If en = 0 Then
    On Error Resume Next
      call_vbs_t = funcX( param )
    en = Err.Number : es = Err.Source : ed = Err.Description : On Error GoTo 0
  End If


  '-----------------------------------------
  ' Finally
  g_sh.CurrentDirectory = oldDir
  g_SrcPath = Empty

  If en <> 0 Then  Err.Raise en, es, ed
End Function



 
'********************************************************************************
'  <<< [call_vbs_d] >>> 
'********************************************************************************
Function  call_vbs_d( ByVal path, ByVal func, param )
  Dim oldDir, f, funcX, in_call, in_interpret, en

  oldDir = g_sh.CurrentDirectory

  path = g_sh.ExpandEnvironmentStrings( path )
  path = g_fs.GetAbsolutePathName( path )
  g_SrcPath = path

  g_sh.CurrentDirectory = g_fs.GetParentFolderName( path )

  Set f = g_fs.OpenTextFile( g_fs.GetFileName( path ) )
  ExecuteGlobal f.ReadAll()
  f.Close
  Set funcX = GetRef( func )  ' If error, Not found func symbol
  call_vbs_d = funcX( param )
  g_sh.CurrentDirectory = oldDir
  g_SrcPath = Empty
End Function



 
'*-------------------------------------------------------------------------*
'* ◆<<<< [TestScript] Class >>>> */ 
'*-------------------------------------------------------------------------*

Class  TestScript
  Public  m_nPass  ' as integer
  Public  m_nSkip  ' as integer
  Public  m_nFail  ' as integer
  Public  m_Log    ' as Text File
  Public  m_DefLogFName  ' as string
  Public  m_MemLog  ' as string. Empty=disabled, (""or string)=enabled
  Public  m_Path    ' as string
  Public  m_ManualTests() ' as string
  Public  m_ManualTestsPath() ' as string
  Public  m_Debug  ' as boolean
  Public  m_Pass   ' as boolean
 
'********************************************************************************
'  <<< [TestScript::Class_Initialize] >>> 
'********************************************************************************
Private Sub  Class_Initialize
  m_DefLogFName = "Test_logs.txt"
  m_Debug = g_Debug
  ReDim  m_ManualTests(-1)
  ReDim  m_ManualTestsPath(-1)
End Sub


 
'********************************************************************************
'  <<< [TestScript::Class_Terminate] >>> 
'********************************************************************************
Private Sub  Class_Terminate
  If Not IsEmpty( m_Log ) Then  Finish
End Sub


 
'********************************************************************************
'  <<< [TestScript::Start] >>> 
'********************************************************************************
Public Sub  Start
  Dim  sub_test ' Boolean

  Set m_Log = g_fs.CreateTextFile( m_DefLogFName, True, (g_TextFileCreateFormat = F_Unicode) )
  m_MemLog = Empty
  ReDim  m_ManualTests(-1)
  ReDim  m_ManualTestsPath(-1)

  sub_test = False
  If WScript.Arguments.Count >= 1 Then
    If WScript.Arguments(0) = "-sub_test" Then sub_test = True
  End If

  If Not sub_test Then  echo  "Test Start : " & g_fs.GetFileName( Wscript.ScriptFullName )

  m_nPass = 0
  m_nSkip = 0
  m_nFail = 0
End Sub


 
'********************************************************************************
'  <<< [TestScript::Do_] >>> 
'********************************************************************************
Public Sub  Do_( ByVal vbs_path, ByVal func, ByVal param )
  Dim  en,ed,es, def_log_fname, b_echo_err_func, b_echo_err_file

  If g_debug Then  Debug  vbs_path, func, param :  Exit Sub

  m_Path = vbs_path


  '//=== Call Me.Start
  If IsEmpty( m_Log ) And func <> "test_current" Then
    def_log_fname = m_DefLogFName
    m_DefLogFName = g_fs.GetParentFolderName( vbs_path ) + "\" + def_log_fname
    Me.Start
  End If


  '//=== Echo the Test title
  If func <> "test_current" Then
    echo "=========================================================="
    If g_fs.GetFileName( g_fs.GetParentFolderName( vbs_path ) ) = "" Then
      echo "((( [" & g_fs.GetFileName( vbs_path ) & "] - " & func & " )))"
    Else
      echo "((( [" & g_fs.GetFileName( g_fs.GetParentFolderName( vbs_path ) ) & "\" _
           & g_fs.GetFileName( vbs_path ) & "] - " & func & " )))"
    End If
  End If


  '//=== Call the Test function
  On Error Resume Next

    call_vbs_t  vbs_path, func, param

  en = Err.Number : ed = Err.Description : es = Err.Source : On Error GoTo 0


  '//=== Echo the Test result
  If en = 0 Then
   If func <> "test_current" Then
    m_nFail = m_nFail + 1
    echo "[FAIL] Test is not Pass"
    b_echo_err_func = True
   End If
  ElseIf en = Err_TestPass Then
   If func <> "test_current" Then
    m_nPass = m_nPass + 1
    '// echo "Pass." is already done in Pass function
   End If
  ElseIf en = Err_TestSkip Then
    m_nSkip = m_nSkip + 1
    echo ed
    b_echo_err_func = True
  ElseIf en = Err_TestFail Then
    m_nFail = m_nFail + 1
    echo "[FAIL] " & ed
    b_echo_err_func = True
  Else
    m_nFail = m_nFail + 1
    If en >= 0 and en <= &h7FFF Then
      echo "[FAIL] [ERROR](" & en & ") " & ed
    Else
      echo "[FAIL] [ERROR](" & Hex(en) & ") " & ed
    End If
    If en >= 1000 and en <=4096 Then
      b_echo_err_file = True
    Else
      b_echo_err_func = True
    End If
  End If
  If b_echo_err_func Then
    echo " in """ & func & """ function in """ & vbs_path & """"
  ElseIf b_echo_err_file Then
    echo " in """ & vbs_path & """"
  End If


  '//=== Call Me.Finish
  If Not IsEmpty( def_log_fname ) Then
    Me.Finish
    m_DefLogFName = def_log_fname
  End If

  m_Path = Empty
End Sub


 
'********************************************************************************
'  <<< [TestScript::Debug] >>> 
'********************************************************************************
Public Sub  Debug( ByVal vbs_path, ByVal func, ByVal param )
  echo "=========================================================="
  echo "<<< [" & g_fs.GetFileName( g_fs.GetParentFolderName( vbs_path ) ) & "\" _
           & g_fs.GetFileName( vbs_path ) & "] - " & func & " >>>"
  echo "Debug Mode ..."

  m_Path = vbs_path

  m_Debug = True
  call_vbs_d  vbs_path, func, param
  m_Debug = False

  if m_Pass Then
    If func <> "test_current" Then
      m_nPass = m_nPass + 1
      echo "Pass."
    End If
  End If

  m_Path = Empty
End Sub


 
'********************************************************************************
'  <<< [TestScript::WriteLogLine] >>> 
'********************************************************************************
Public Sub  WriteLogLine( Message )
  If not IsEmpty( m_Log ) Then
    m_Log.WriteLine  Message
  End If
  If not IsEmpty( m_MemLog ) Then
    m_MemLog = m_MemLog + Message + vbCRLF
  End If
End Sub
 
'********************************************************************************
'  <<< [TestScript::AddManualTest] >>> 
'********************************************************************************
Public Sub  AddManualTest( TestSymbol )
  ReDim Preserve  m_ManualTests( UBound( m_ManualTests ) + 1 )
  m_ManualTests( UBound( m_ManualTests ) ) = TestSymbol
  ReDim Preserve  m_ManualTestsPath( UBound( m_ManualTestsPath ) + 1 )
  m_ManualTestsPath( UBound( m_ManualTestsPath ) ) = m_Path
End Sub


 
'********************************************************************************
'  <<< [TestScript::Raise] >>> 
'********************************************************************************
Public Sub  Raise( en, ed )
  m_nFail = m_nFail + 1
  If en >= 0 and en <= &h7FFF Then
    echo "[FAIL] [ERROR](" & en & ") " & ed
  Else
    echo "[FAIL] [ERROR](" & Hex(en) & ") " & ed
  End If
End Sub


 
'********************************************************************************
'  <<< [TestScript::Finish] >>> 
'********************************************************************************
Public Sub  Finish
  Dim  TestSymbol, sub_test ' Boolean
  Dim  i

  i=0
  For Each TestSymbol In m_ManualTests
    echo  "[ManualTest] " + TestSymbol + " in """ + m_ManualTestsPath(i) + """"
    i=i+1
  Next

  m_MemLog = Empty

  sub_test = False
  If WScript.Arguments.Count >= 1 Then
    If WScript.Arguments(0) = "-sub_test" Then sub_test = True
  End If

  If sub_test Then
    If m_nFail = 0 Then WScript.Quit 0  Else WScript.Quit 1  End If
  Else
    echo "=========================================================="
    echo "Test Finish (Pass=" & m_nPass & ", Manual=" & UBound(m_ManualTests)+1 & _
         ", Skip=" & m_nSkip & ", Fail=" & m_nFail & ")"
    echo ""
  End If

  ReDim  m_ManualTests(-1)
  m_Log = Empty
End Sub





 
End Class 
 
'*-------------------------------------------------------------------------*
'* ◆<<<< [Tests] Class >>>> */ 
'*-------------------------------------------------------------------------*
Class Tests

  Private  m_Sets  ' As Dictionary of UnitTest. key is UnitTest::Symbol
  Private  m_BaseFolderPath  ' as string. All Test ROOT
  Private  m_Prompt  ' as TestPrompt or Empty
  Private  m_CurrentSymbol  ' as string of current test symbol or ALL or ALL_R
  Private  m_CurrentSubSymbol  ' as string
  Private  m_CurrentTest   ' as UnitTest of m_CurrentSymbol
  Public   CurrentTestPriority   ' as integer  small is high priority
  Private  m_bAllTest  ' as boolean
  Private  m_AllFName  ' as string
  Private  m_Symbol  ' as string of doing test symbol
  Public   bTargetDebug  ' as boolean
  Public   c_ErrDblSymbol  ' as const number
  Public   m_bDisableAddTestScript  ' as boolean
  Public   m_bAutoDiff  ' as boolean
  Public   m_bSkipSection  ' as boolean

  '----------------------------------
  Public Property Get  Sets : Set Sets = m_Sets : End Property
  Public Property Get  BaseFolderPath : BaseFolderPath = m_BaseFolderPath : End Property
  Public Property Let  BaseFolderPath( x ) : m_BaseFolderPath = x : End Property
  Public Property Set  Prompt( x ) : Set m_Prompt = x : End Property
  Public Property Get  Prompt : Set Prompt = m_Prompt : End Property
  Public Property Get  CurrentSymbol : CurrentSymbol = m_CurrentSymbol : End Property
  Public Property Get  CurrentTest : If IsObject(m_CurrentTest) Then Set CurrentTest = m_CurrentTest : Else CurrentTest = m_CurrentTest : End If : End Property
  Public Property Get  bAllTest : bAllTest = m_bAllTest : End Property
  Public Property Get  Symbol : Symbol = m_Symbol : End Property
 
'********************************************************************************
'  <<< [Tests::Class_Initialize] >>> 
'********************************************************************************
Private  Sub  Class_Initialize
  Set m_Sets = CreateObject("Scripting.Dictionary")
  m_BaseFolderPath = g_fs.GetParentFolderName( WScript.ScriptFullName )
  m_CurrentSymbol = "ALL"
  m_AllFName = "T_ALL.vbs"
  m_bAllTest = False
  Me.bTargetDebug = False
  Me.c_ErrDblSymbol = 1010
  m_bDisableAddTestScript = False
  m_bAutoDiff = False
  m_bSkipSection = not IsEmpty( g_SkipSection )
  If not m_bSkipSection Then  SkipToSection  0
End Sub

 
'********************************************************************************
'  <<< [Tests::AddTestScriptAuto] >>> 
'********************************************************************************
Public Function  AddTestScriptAuto( BasePath, FName )
  m_AllFName = FName
  AddTestScriptAuto_EnumSubFolders  g_fs.GetFolder( BasePath ), FName
End Function


Private Sub AddTestScriptAuto_EnumSubFolders( fo, FName )
  Dim  subfo

  If g_fs.FileExists( fo.Path + "\" + FName ) Then
    AddTestScript  g_fs.GetFileName( fo.Path ), fo.Path + "\" + FName
  End If
  For Each subfo in fo.SubFolders
    AddTestScriptAuto_EnumSubFolders subfo, FName
  Next
End Sub
 
'********************************************************************************
'  <<< [Tests::AddTestScript] >>> 
'********************************************************************************
Public Function  AddTestScript( Symbol, Path )
  Dim  test

  If Not g_fs.FileExists( Path ) Then  Err.Raise 53,,"ファイルが見つかりません " + Path
  If m_bDisableAddTestScript Then  Exit Function

  Set test = new UnitTest : ErrCheck
  test.Symbol = Symbol
  test.ScriptPath = g_fs.GetAbsolutePathName( Path )
  If m_Sets.Exists( test.Symbol ) Then _
    Err.Raise c_ErrDblSymbol,"class Tests", "[ERROR] Already defined the symbol '"+Symbol+"' in "+ _
    m_Sets.Item(Symbol).ScriptPath
  m_Sets.Add  test.Symbol, test

  Me.CurrentTestPriority = 1000
  If g_debug Then  call_vbs_d  Path, "test_current", Me _
  Else             call_vbs_t  Path, "test_current", Me
  test.Priority = Me.CurrentTestPriority

  Set AddTestScript = test
End Function

 
'********************************************************************************
'  <<< [Tests::SetCurrentSymbol] >>> 
'********************************************************************************
Public Function SetCurrentSymbol( Symbol_or_Path )
  Dim  key, item, b

  SetCurrentSymbol = 0

  '// ALL and ALL_R is special symbol
  If Symbol_or_Path = "ALL" or Symbol_or_Path = "ALL_R" Then  m_CurrentSymbol = Symbol_or_Path : _
    m_CurrentTest = Empty : Exit Function

  '// Search by test symbol
  For Each key in m_Sets.Keys()
    If key = Symbol_or_Path Then  m_CurrentSymbol = Symbol_or_Path : _
      Set m_CurrentTest = m_Sets.Item( m_CurrentSymbol ) : Exit Function
  Next

  '// Search by path
  For Each item in m_Sets.Items()
    If item.ScriptPath = Symbol_or_Path Then  m_CurrentSymbol = item.Symbol : _
      Set m_CurrentTest = m_Sets.Item( m_CurrentSymbol ) : Exit Function
  Next

  '// If Symbol is path, Add test symbol
  If g_fs.FileExists( Symbol_or_Path ) Then
    If UCase(g_fs.GetFileName( Symbol_or_Path )) = UCase(m_AllFName) Then _
      m_CurrentSymbol = g_fs.GetFileName( g_fs.GetParentFolderName( g_fs.GetAbsolutePathName(Symbol_or_Path) ) ) _
    Else  m_CurrentSymbol = g_fs.GetBaseName( Symbol_or_Path )

    b = True : If m_Sets.Exists( m_CurrentSymbol ) Then _
      b = ( m_Sets.Item( m_CurrentSymbol ).ScriptPath <> g_fs.GetAbsolutePathName( Symbol_or_Path ) )
    If b Then  'If Not m_Sets.Exists( m_CurrentSymbol ) or _
               '  m_Sets.Item( m_CurrentSymbol ).ScriptPath <> g_fs.GetAbsolutePathName( Symbol_or_Path ) Then
      AddTestScript  m_CurrentSymbol, Symbol_or_Path
    End If
    Set m_CurrentTest = m_Sets.Item( m_CurrentSymbol )
    Exit Function
  End If

  '// Error: Symbol
  echo "[ERROR] Not found symbol or path """ + Symbol_or_Path + """. CurrentDirectory = " & g_sh.CurrentDirectory
  SetCurrentSymbol = 1
End Function


 
'********************************************************************************
'  <<< [Tests::DoTest] >>> 
'********************************************************************************
Public Sub  DoTest( Func, bReverse )

  If m_CurrentSymbol = "ALL" Or m_CurrentSymbol = "ALL_R" Then
    Redim  utests(-1)

    If bReverse Then
      ShakerSort_fromDic  m_Sets, utests, -1, GetRef("CmpUnitTestPriorityDec"), Empty
    Else
      ShakerSort_fromDic  m_Sets, utests, +1, GetRef("CmpUnitTestPriorityInc"), Empty
    End If

    g_Test.m_DefLogFName = m_BaseFolderPath + "\" + g_fs.GetFileName( g_Test.m_DefLogFName )
    g_Test.Start
    If m_bAutoDiff Then  g_Test.m_MemLog = ""
    For Each m_CurrentTest in utests
      TestCurrentSetup
      g_Test.Do_  m_CurrentTest.ScriptPath, "test_current", Me
      TestSetup
      g_Test.Do_  m_CurrentTest.ScriptPath, Func, Me
      If Me.AutoDiff Then  g_Test.Finish : m_bAllTest = False : Exit Sub
    Next
    g_Test.Finish
  Else
    g_Test.m_DefLogFName = g_fs.GetParentFolderName( m_CurrentTest.ScriptPath ) + "\" + g_fs.GetFileName( g_Test.m_DefLogFName )
    g_Test.Start
    If m_bAutoDiff Then  g_Test.m_MemLog = ""
    Set m_CurrentTest = m_Sets.Item( m_CurrentSymbol )
    TestCurrentSetup
    g_Test.Do_  m_CurrentTest.ScriptPath, "test_current", Me
    TestSetup
    g_Test.Do_  m_CurrentTest.ScriptPath, Func, Me
    If Me.AutoDiff Then  g_Test.Finish : m_bAllTest = False : Exit Sub
    g_Test.Finish
  End If
End Sub

 
'********************************************************************************
'  <<< [Tests::DebugTest] >>> 
'********************************************************************************
Public Sub  DebugTest( Func, bReverse )
  If m_CurrentSymbol = "ALL" Or m_CurrentSymbol = "ALL_R" Then
    Dim  items(), i

    i = m_Sets.Count - 1
    ReDim Preserve items( i )
    If bReverse Then
      For Each m_CurrentTest in m_Sets.Items()
        Set items( i ) = m_CurrentTest
        i = i - 1
      Next
    Else
      i = 0
      For Each m_CurrentTest in m_Sets.Items()
        Set items( i ) = m_CurrentTest
        i = i + 1
      Next
    End If

    g_Test.m_DefLogFName = m_BaseFolderPath + "\" + g_fs.GetFileName( g_Test.m_DefLogFName )
    g_Test.Start
    For Each m_CurrentTest in items
      If NotSkipSection() Then
        TestCurrentSetup
        g_Test.Debug  m_CurrentTest.ScriptPath, "test_current", Me
        TestSetup
        g_Test.Debug  m_CurrentTest.ScriptPath, Func, Me
      End If
    Next
    g_Test.Finish
  Else
    g_Test.m_DefLogFName = g_fs.GetParentFolderName( m_CurrentTest.ScriptPath ) + "\" + g_fs.GetFileName( g_Test.m_DefLogFName )
    g_Test.Start
    Set m_CurrentTest = m_Sets.Item( m_CurrentSymbol )
    TestCurrentSetup
    g_Test.Debug  m_CurrentTest.ScriptPath, "test_current", Me
    TestSetup
    g_Test.Debug  m_CurrentTest.ScriptPath, Func, Me
    g_Test.Finish
  End If
End Sub

 
'********************************************************************************
'  <<< [Tests::DoAllTest] >>> 
'********************************************************************************
Public Sub  DoAllTest()
  m_bAllTest = True
  If m_CurrentSymbol = "ALL" Or m_CurrentSymbol = "ALL_R" Then
    Redim  utests_inc(-1), utests_dec(-1)

    ShakerSort_fromDic  m_Sets, utests_inc, +1, GetRef("CmpUnitTestPriorityInc"), Empty
    ShakerSort_fromDic  m_Sets, utests_dec, -1, GetRef("CmpUnitTestPriorityDec"), Empty

    g_Test.m_DefLogFName = m_BaseFolderPath + "\" + g_fs.GetFileName( g_Test.m_DefLogFName )
    g_Test.Start
    If m_bAutoDiff Then  g_Test.m_MemLog = ""

    For Each m_CurrentTest in utests_inc
      If NotSkipSection() Then
        TestCurrentSetup
        g_Test.Do_  m_CurrentTest.ScriptPath, "test_current", Me
        If Me.AutoDiff Then  g_Test.Finish : m_bAllTest = False : Exit Sub
      End If
    Next
    For Each m_CurrentTest in utests_inc
      If NotSkipSection() Then
        TestSetup
        g_Test.Do_  m_CurrentTest.ScriptPath, "test_build", Me
        If Me.AutoDiff Then  g_Test.Finish : m_bAllTest = False : Exit Sub
      End If
    Next
    For Each m_CurrentTest in utests_inc
      If NotSkipSection() Then
        TestSetup
        g_Test.Do_  m_CurrentTest.ScriptPath, "test_setup", Me
        If Me.AutoDiff Then  g_Test.Finish : m_bAllTest = False : Exit Sub
      End If
    Next
    For Each m_CurrentTest in utests_inc
      If NotSkipSection() Then
        TestSetup
        g_Test.Do_  m_CurrentTest.ScriptPath, "test_start", Me
        If Me.AutoDiff Then  g_Test.Finish : m_bAllTest = False : Exit Sub
      End If
    Next
    For Each m_CurrentTest in utests_dec
      If NotSkipSection() Then
        TestSetup
        g_Test.Do_  m_CurrentTest.ScriptPath, "test_check", Me
        If Me.AutoDiff Then  g_Test.Finish : m_bAllTest = False : Exit Sub
      End If
    Next
    For Each m_CurrentTest in utests_dec
      If NotSkipSection() Then
        TestSetup
        g_Test.Do_  m_CurrentTest.ScriptPath, "test_clean", Me
        If Me.AutoDiff Then  g_Test.Finish : m_bAllTest = False : Exit Sub
      End If
    Next
    If m_bSkipSection Then  g_Test.Raise  1, "SkipToSection をカットしてください。"
    g_Test.Finish
  Else
    Set m_CurrentTest = m_Sets.Item( m_CurrentSymbol )
    g_Test.m_DefLogFName = g_fs.GetParentFolderName( m_CurrentTest.ScriptPath ) + "\" + g_fs.GetFileName( g_Test.m_DefLogFName )
    g_Test.Start
    If m_bAutoDiff Then  g_Test.m_MemLog = ""
    If NotSkipSection() Then
      TestCurrentSetup
      g_Test.Do_  m_CurrentTest.ScriptPath, "test_current", Me
    End If
    If NotSkipSection() Then
      TestSetup
      g_Test.Do_  m_CurrentTest.ScriptPath, "test_build", Me
      If Me.AutoDiff Then  g_Test.Finish : m_bAllTest = False : Exit Sub
    End If
    If NotSkipSection() Then
      TestSetup
      g_Test.Do_  m_CurrentTest.ScriptPath, "test_setup", Me
      If Me.AutoDiff Then  g_Test.Finish : m_bAllTest = False : Exit Sub
    End If
    If NotSkipSection() Then
      TestSetup
      g_Test.Do_  m_CurrentTest.ScriptPath, "test_start", Me
      If Me.AutoDiff Then  g_Test.Finish : m_bAllTest = False : Exit Sub
    End If
    If NotSkipSection() Then
      TestSetup
      g_Test.Do_  m_CurrentTest.ScriptPath, "test_check", Me
      If Me.AutoDiff Then  g_Test.Finish : m_bAllTest = False : Exit Sub
    End If
    If NotSkipSection() Then
      TestSetup
      g_Test.Do_  m_CurrentTest.ScriptPath, "test_clean", Me
      If Me.AutoDiff Then  g_Test.Finish : m_bAllTest = False : Exit Sub
    End If
    If m_bSkipSection Then  g_Test.Raise  1, "SkipToSection をカットしてください。"
    g_Test.Finish
  End If

  m_bAllTest = False
End Sub


 
'********************************************************************************
'  <<< [Tests::TestCurrentSetup] >>> 
'********************************************************************************
Private Sub  TestCurrentSetup()
  m_Symbol = m_CurrentTest.Symbol
  CurrentTestPriority = m_CurrentTest.Priority
  g_Test.m_Pass = True
End Sub

 
'********************************************************************************
'  <<< [Tests::TestSetup] >>> 
'********************************************************************************
Private Sub  TestSetup()
  m_Symbol = m_CurrentTest.Symbol
  g_Test.m_Pass = False
End Sub

 
'********************************************************************************
'  <<< [Tests::SetCur] >>> 
'********************************************************************************
Public Sub  SetCur( SubSymbol )
  m_CurrentSubSymbol = SubSymbol
End Sub

 
'********************************************************************************
'  <<< [Tests::IsCur] >>> 
'********************************************************************************
Public Function  IsCur( SubSymbol )
  If m_CurrentSubSymbol = "ALL" Or m_CurrentSubSymbol = "ALL_R" Or _
     m_CurrentSubSymbol = SubSymbol Then
    IsCur = True
  Else
    IsCur = False
  End IF
End Function

 
'********************************************************************************
'  <<< [Tests::AutoDiff] >>> 
'********************************************************************************
Public Function  AutoDiff()
  If m_bAutoDiff and g_Test.m_nFail > 0 Then
    Dim  f : Set f = new StringStream : ErrCheck
    ReDim  path(1)
    Dim    n_path, line


    '//=== parse the output of fc command
    n_path = 0
    f.SetString  g_Test.m_MemLog
    Do Until f.AtEndOfStream
      line = f.ReadLine
      If Left( line, 6 ) = "***** " Then
        path( n_path ) = Mid( line, 7 )
        n_path = n_path + 1
        If n_path = 2 Then Exit Do
      End If
    Loop
    f = Empty


    '//=== Start Diff tool
    If not IsEmpty( path(1) ) Then
      path(0) = GetAbsPath( path(0), g_fs.GetParentFolderName( m_CurrentTest.ScriptPath ) )
      path(1) = GetAbsPath( path(1), g_fs.GetParentFolderName( m_CurrentTest.ScriptPath ) )
      If IsDefined("Setting_getDiffCmdLine") Then
        line = """" + Setting_getDiffCmdLine(0) + """ """ + path(0) + """ """ + path(1) + """"
        CreateFile  g_fs.GetParentFolderName( m_CurrentTest.ScriptPath ) + "\Test_diff.bat", _
                    "start """" " + line
        g_sh.Run  line
      Else
        echo  "[WARNING] Cannot open diff tool : not defined Setting_getDiffCmdLine"
      End If
      AutoDiff = True : Exit Function
    End If

  End If
  AutoDiff = False
End Function

 
'********************************************************************************
'  <<< [Tests::OpenFailFolder] >>> 
'********************************************************************************
Public Sub  OpenFailFolder()
  echo  ">OpenFailFolder"
  Dim  ec
  Set  ec = new EchoOff : ErrCheck

  Dim  f, line, i, s
  Dim  ds_:Set ds_= new CurDirStack : ErrCheck

  Set f = OpenTextFile( g_Test.m_DefLogFName )
  ec = Empty

  Do Until f.AtEndOfStream
    line = f.ReadLine
    If Left( line, 6 ) = "[FAIL]" Then

      '//=== Open fail folder and ReTest
      echo  line
      line = f.ReadLine
      echo  line

      Set ec = new EchoOff : ErrCheck
      i = 1
      s = MeltQuot( line, i )
      If i > 0 Then
        s = MeltQuot( line, i )
        If not IsEmpty( s ) Then

          Setting_openFolder  s

          If LCase( g_fs.GetFileName( s ) ) = "test.vbs" Then
            CreateFile  g_fs.GetParentFolderName( s ) + "\Test_debugger.bat", _
                        "cscript //x  Test.vbs /g_debug:1 /set_input:8.5.5."
            echo "Created debug.bat"
            Sleep 1000
            echo "Run Test.vbs AutoDiff mode"
            g_sh.Run  "cscript """ + s + """ /set_input:8.5.2.9.",,True

            '// echo "Run Test.vbs AutoDiff mode"
            '// cd g_fs.GetParentFolderName( s )
            '// g_sh.Run  "debug.bat"
          End If
        End If
      End If


      '//=== Change from [FAIL] to [FAIL:Checked] in Test_logs.txt file
      f = Empty
      Set f = StartReplace( "Test_logs.txt", "Test_logs_replacing.txt", False )
      i = 0
      Do Until f.r.AtEndOfStream
        line = f.r.ReadLine
        If i = 0 and InStr( line, "[FAIL]" ) > 0 Then
          line = Replace( line, "[FAIL]", "[FAIL:Checked]" )
          i = 1
        End If
        f.w.WriteLine  line
      Loop
      f.Finish
      ec = Empty
      Exit Sub
    End If
  Loop
  Raise  1, "No Fail"
End Sub
 
'********************************************************************************
'  <<< [Tests::NextFail] >>> 
'********************************************************************************
Public Sub  NextFail()
  Dim  f, line, i, s
  Dim  ds_:Set ds_= new CurDirStack : ErrCheck

  Set f = OpenTextFile( g_Test.m_DefLogFName )

  Do Until f.AtEndOfStream
    line = f.ReadLine
    If Left( line, 6 ) = "[FAIL]" Then

      '//=== Open fail folder
      echo  line
      line = f.ReadLine
      echo  line
      i = 1
      s = MeltQuot( line, i )
      If i > 0 Then
        s = MeltQuot( line, i )
        If not IsEmpty( s ) Then
          Setting_openFolder  s
          If LCase( g_fs.GetFileName( s ) ) = "test.vbs" Then
            CreateFile  g_fs.GetParentFolderName( s ) + "\Test_debugger.bat", _
                        "cscript //x  Test.vbs /g_debug:1 /set_input:8.5.5."
            echo "Created debug.bat"
            Sleep 1000
            echo "Run Test.vbs AutoDiff mode"
            g_sh.Run  "cscript """ + s + """ /set_input:8.5.2.9.",,True

            '// echo "Run Test.vbs AutoDiff mode"
            '// cd g_fs.GetParentFolderName( s )
            '// g_sh.Run  "debug.bat"
          End If
        End If
      End If


      '//=== Change from [FAIL] to [FAIL:Checked] in Test_logs.txt file
      f = Empty
      Set f = StartReplace( "Test_logs.txt", "Test_logs_replacing.txt", False )
      i = 0
      Do Until f.r.AtEndOfStream
        line = f.r.ReadLine
        If i = 0 and InStr( line, "[FAIL]" ) > 0 Then
          line = Replace( line, "[FAIL]", "[FAIL:Checked]" )
          i = 1
        End If
        f.w.WriteLine  line
      Loop
      f = Empty
      Exit Sub
    End If
  Loop
  Raise  1, "No Fail"
End Sub
 
End Class 
 
'********************************************************************************
'  <<< [CmpUnitTestPriorityInc] >>> 
'********************************************************************************
Function  CmpUnitTestPriorityInc( left, right, param )
  CmpUnitTestPriorityInc = left.Priority - right.Priority
End Function
 
'********************************************************************************
'  <<< [CmpUnitTestPriorityDec] >>> 
'********************************************************************************
Function  CmpUnitTestPriorityDec( left, right, param )
  CmpUnitTestPriorityDec = right.Priority - left.Priority
End Function
 
'*-------------------------------------------------------------------------*
'* ◆<<<< [UnitTest] Class >>>> */ 
'*-------------------------------------------------------------------------*
Class UnitTest

  Public  Symbol     ' As String
  Public  ScriptPath ' As String
  Public  Priority   ' As Integer

  '----------------------------------
  Private  Sub  Class_Initialize
    Symbol = "NoSymbol"
    ScriptPath = ""
  End Sub

  Public  Function  Value
    Value = "[" & Symbol & "]" & vbCR & vbLF & " " & ScriptPath
  End Function

  Public Function  PathToAbs( BaseFolderPath )
    Dim  s
    PathToAbs = True
    s = g_fs.GetAbsolutePathName( BaseFolderPath & "\" & ScriptPath )
    If Not g_fs.FileExists( s ) Then  echo "[ERROR] Not found " + ScriptPath + ", Base=" + BaseFolderPath : PathToAbs = False
    ScriptPath = s
  End Function

End Class


 
'*-------------------------------------------------------------------------*
'* ◆<<<< Test Result >>>> */ 
'*-------------------------------------------------------------------------*

 
'********************************************************************************
'  <<< [Pass] >>> 
'********************************************************************************
Sub  Pass
  Dim  b : b = g_EchoObj.m_bEchoOff : g_EchoObj.m_bEchoOff = False
  echo  "Pass."
  g_EchoObj.m_bEchoOff = b

  Err.Raise  Err_TestPass, WScript.ScriptFullName, "Pass."
End Sub



 
'********************************************************************************
'  <<< [Fail] >>> 
'********************************************************************************
Sub  Fail()
  Err.Raise  Err_TestFail,, "Fail the Test"
End Sub



 
'********************************************************************************
'  <<< [Skip] >>> 
'********************************************************************************
Sub  Skip()
  Err.Raise  Err_TestSkip,, "[SKIP] Skip the Test"
End Sub



 
'********************************************************************************
'  <<< [ManualTest] >>> 
'********************************************************************************
Sub  ManualTest( TestSymbol )
  Dim  b : b = g_EchoObj.m_bEchoOff : g_EchoObj.m_bEchoOff = False
  echo  "((( ["+TestSymbol+"] )))"
  echo  "This is ManualTest."
  g_EchoObj.m_bEchoOff = b

  g_Test.AddManualTest  TestSymbol
End Sub

 
'*-------------------------------------------------------------------------*
'* ◆<<<< Tools for Test Program >>>> */ 
'*-------------------------------------------------------------------------*

 
'********************************************************************************
'  <<< [EchoTestStart] >>> 
'********************************************************************************
Sub  EchoTestStart( TestSymbol )
  echo  "((( ["+TestSymbol+"] )))"
End Sub


 
'********************************************************************************
'  <<< [CheckTestErrLevel] >>> 
'********************************************************************************
Sub  CheckTestErrLevel( r )
  If r = Err_TestSkip Then
    Skip
  ElseIf r <> Err_TestPass Then
    Fail
  End If
End Sub


 
'********************************************************************************
'  <<< [ConvertToAbsPath] >>> 
'********************************************************************************
Sub  ConvertToAbsPath( SrcPath, DstPath )
  Dim  src, dst, dst_parent, line, p1, p2, path

  Set  src = OpenTextFile( SrcPath )
  mkdir_for  DstPath
  echo  ">ConvertToAbsPath """ + SrcPath + """, """ + DstPath + """"
  g_AppKey.AddNewWritableFolder  DstPath
  Set  dst = g_fs.CreateTextFile( DstPath, True, (g_TextFileConvertFormat = F_Unicode) )

  Do Until src.AtEndOfStream
    line = src.ReadLine
    Do
      p1 = InStr( line, "%AbsPath(" )
      If p1 = 0 Then Exit Do
      p2 = InStr( p1 + 9, line, ")%" )
      path = Mid( line, p1+9, p2-p1-9 )
      path = GetAbsPath( path, g_fs.GetParentFolderName( g_fs.GetAbsolutePathName( SrcPath ) ) )
      line = Left( line, p1 - 1 ) + path + Mid( line, p2 + 2 )
    Loop
    line = Replace( line, "%DesktopPath%", g_sh.SpecialFolders("Desktop") )
    dst.WriteLine  line
  Loop
  src = Empty
  dst = Empty
End Sub

 
'********************************************************************************
'  <<< [OpenTextFile] >>> 
'********************************************************************************
Function  OpenTextFile( Path )
  Dim  en, ed

  On Error Resume Next
     Set OpenTextFile = g_fs.OpenTextFile( Path,,,-2 )
  en = Err.Number : ed = Err.Description : On Error GoTo 0
  If en = E_FileNotExist or en = E_PathNotFound  Then  Err.raise  en,,ed+" : "+Path
  If en <> 0 Then  Err.Raise en,,ed
End Function