+++ /dev/null
-Option Explicit \r
-\r
-' vbslib ver3.00 Sep.22, 2009\r
-' Copyright (c) 2008-2009, T's-Neko at Sage Plaisir 21 (Japan)\r
-' All rights reserved. Based on 3-clause BSD license.\r
-\r
-Dim g_SrcPath\r
-Dim g_TestScript_Path\r
- g_TestScript_Path = g_SrcPath\r
-\r
-\r
-' Global Variable\r
-Dim g_Test, g_echo_on\r
-\r
-Function InitializeModule\r
- g_echo_on = True\r
- Set g_Test = New TestScript : ErrCheck\r
-End Function\r
-Dim g_InitializeModule\r
-Set g_InitializeModule = GetRef( "InitializeModule" )\r
-\r
-Const Err_TestPass = 21\r
-Const Err_TestSkip = 22\r
-Const Err_TestFail = 23\r
-\r
- \r
-'********************************************************************************\r
-' <<< [call_vbs_t] >>> \r
-' - The difference of call_vbs is not depend on vbslib.\r
-' - path, func as string, param as variant\r
-'********************************************************************************\r
-Function call_vbs_t( ByVal path, ByVal func, param )\r
- Dim oldDir, f, funcX, in_interpret, en, ed, es\r
-\r
- in_interpret = False\r
- oldDir = g_sh.CurrentDirectory\r
-\r
- path = g_sh.ExpandEnvironmentStrings( path )\r
- path = g_fs.GetAbsolutePathName( path )\r
-\r
- '-----------------------------------------\r
- ' Interpret\r
-\r
- g_SrcPath = path\r
-\r
- On Error Resume Next\r
-\r
- g_sh.CurrentDirectory = g_fs.GetParentFolderName( path )\r
- If Err=0 Then Set f = g_fs.OpenTextFile( g_fs.GetFileName( path ) )\r
- If Err=0 Then in_interpret = True : ExecuteGlobal f.ReadAll()\r
- If Err=&h411 Then in_interpret = False : Err.Clear ' Ignore symbol override error\r
- If Err=0 Then in_interpret = False\r
- If Err=0 Then Set funcX = GetRef( func )\r
-\r
- en = Err.Number : es = Err.Source : ed = Err.Description : On Error GoTo 0\r
- If en <> 0 Then\r
- If in_interpret Then\r
- ed = ed + " Syntax Error in """ + g_fs.GetFileName( path ) _\r
- + """. Please double click """ _\r
- + g_fs.GetFileName( path ) + """."\r
- End If\r
- If en = &h35 Then ed = "Not found file '" + path\r
- If en = 5 Then ed = "Not found func name '" + func + "' in " + path\r
- End If\r
- f.Close\r
-\r
-\r
- '-----------------------------------------\r
- ' Call\r
- If en = 0 Then\r
- On Error Resume Next\r
- call_vbs_t = funcX( param )\r
- en = Err.Number : es = Err.Source : ed = Err.Description : On Error GoTo 0\r
- End If\r
-\r
-\r
- '-----------------------------------------\r
- ' Finally\r
- g_sh.CurrentDirectory = oldDir\r
- g_SrcPath = Empty\r
-\r
- If en <> 0 Then Err.Raise en, es, ed\r
-End Function\r
-\r
-\r
-\r
- \r
-'********************************************************************************\r
-' <<< [call_vbs_d] >>> \r
-'********************************************************************************\r
-Function call_vbs_d( ByVal path, ByVal func, param )\r
- Dim oldDir, f, funcX, in_call, in_interpret, en\r
-\r
- oldDir = g_sh.CurrentDirectory\r
-\r
- path = g_sh.ExpandEnvironmentStrings( path )\r
- path = g_fs.GetAbsolutePathName( path )\r
- g_SrcPath = path\r
-\r
- g_sh.CurrentDirectory = g_fs.GetParentFolderName( path )\r
-\r
- Set f = g_fs.OpenTextFile( g_fs.GetFileName( path ) )\r
- ExecuteGlobal f.ReadAll()\r
- f.Close\r
- Set funcX = GetRef( func ) ' If error, Not found func symbol\r
- call_vbs_d = funcX( param )\r
- g_sh.CurrentDirectory = oldDir\r
- g_SrcPath = Empty\r
-End Function\r
-\r
-\r
-\r
- \r
-'*-------------------------------------------------------------------------*\r
-'* \81\9f<<<< [TestScript] Class >>>> */ \r
-'*-------------------------------------------------------------------------*\r
-\r
-Class TestScript\r
- Public m_nPass ' as integer\r
- Public m_nSkip ' as integer\r
- Public m_nFail ' as integer\r
- Public m_Log ' as Text File\r
- Public m_DefLogFName ' as string\r
- Public m_MemLog ' as string. Empty=disabled, (""or string)=enabled\r
- Public m_Path ' as string\r
- Public m_ManualTests() ' as string\r
- Public m_ManualTestsPath() ' as string\r
- Public m_Debug ' as boolean\r
- Public m_Pass ' as boolean\r
- \r
-'********************************************************************************\r
-' <<< [TestScript::Class_Initialize] >>> \r
-'********************************************************************************\r
-Private Sub Class_Initialize\r
- m_DefLogFName = "Test_logs.txt"\r
- m_Debug = g_Debug\r
- ReDim m_ManualTests(-1)\r
- ReDim m_ManualTestsPath(-1)\r
-End Sub\r
-\r
-\r
- \r
-'********************************************************************************\r
-' <<< [TestScript::Class_Terminate] >>> \r
-'********************************************************************************\r
-Private Sub Class_Terminate\r
- If Not IsEmpty( m_Log ) Then Finish\r
-End Sub\r
-\r
-\r
- \r
-'********************************************************************************\r
-' <<< [TestScript::Start] >>> \r
-'********************************************************************************\r
-Public Sub Start\r
- Dim sub_test ' Boolean\r
-\r
- Set m_Log = g_fs.CreateTextFile( m_DefLogFName, True, (g_TextFileCreateFormat = F_Unicode) )\r
- m_MemLog = Empty\r
- ReDim m_ManualTests(-1)\r
- ReDim m_ManualTestsPath(-1)\r
-\r
- sub_test = False\r
- If WScript.Arguments.Count >= 1 Then\r
- If WScript.Arguments(0) = "-sub_test" Then sub_test = True\r
- End If\r
-\r
- If Not sub_test Then echo "Test Start : " & g_fs.GetFileName( Wscript.ScriptFullName )\r
-\r
- m_nPass = 0\r
- m_nSkip = 0\r
- m_nFail = 0\r
-End Sub\r
-\r
-\r
- \r
-'********************************************************************************\r
-' <<< [TestScript::Do_] >>> \r
-'********************************************************************************\r
-Public Sub Do_( ByVal vbs_path, ByVal func, ByVal param )\r
- Dim en,ed,es, def_log_fname, b_echo_err_func, b_echo_err_file\r
-\r
- If g_debug Then Debug vbs_path, func, param : Exit Sub\r
-\r
- m_Path = vbs_path\r
-\r
-\r
- '//=== Call Me.Start\r
- If IsEmpty( m_Log ) And func <> "test_current" Then\r
- def_log_fname = m_DefLogFName\r
- m_DefLogFName = g_fs.GetParentFolderName( vbs_path ) + "\" + def_log_fname\r
- Me.Start\r
- End If\r
-\r
-\r
- '//=== Echo the Test title\r
- If func <> "test_current" Then\r
- echo "=========================================================="\r
- If g_fs.GetFileName( g_fs.GetParentFolderName( vbs_path ) ) = "" Then\r
- echo "((( [" & g_fs.GetFileName( vbs_path ) & "] - " & func & " )))"\r
- Else\r
- echo "((( [" & g_fs.GetFileName( g_fs.GetParentFolderName( vbs_path ) ) & "\" _\r
- & g_fs.GetFileName( vbs_path ) & "] - " & func & " )))"\r
- End If\r
- End If\r
-\r
-\r
- '//=== Call the Test function\r
- On Error Resume Next\r
-\r
- call_vbs_t vbs_path, func, param\r
-\r
- en = Err.Number : ed = Err.Description : es = Err.Source : On Error GoTo 0\r
-\r
-\r
- '//=== Echo the Test result\r
- If en = 0 Then\r
- If func <> "test_current" Then\r
- m_nFail = m_nFail + 1\r
- echo "[FAIL] Test is not Pass"\r
- b_echo_err_func = True\r
- End If\r
- ElseIf en = Err_TestPass Then\r
- If func <> "test_current" Then\r
- m_nPass = m_nPass + 1\r
- '// echo "Pass." is already done in Pass function\r
- End If\r
- ElseIf en = Err_TestSkip Then\r
- m_nSkip = m_nSkip + 1\r
- echo ed\r
- b_echo_err_func = True\r
- ElseIf en = Err_TestFail Then\r
- m_nFail = m_nFail + 1\r
- echo "[FAIL] " & ed\r
- b_echo_err_func = True\r
- Else\r
- m_nFail = m_nFail + 1\r
- If en >= 0 and en <= &h7FFF Then\r
- echo "[FAIL] [ERROR](" & en & ") " & ed\r
- Else\r
- echo "[FAIL] [ERROR](" & Hex(en) & ") " & ed\r
- End If\r
- If en >= 1000 and en <=4096 Then\r
- b_echo_err_file = True\r
- Else\r
- b_echo_err_func = True\r
- End If\r
- End If\r
- If b_echo_err_func Then\r
- echo " in """ & func & """ function in """ & vbs_path & """"\r
- ElseIf b_echo_err_file Then\r
- echo " in """ & vbs_path & """"\r
- End If\r
-\r
-\r
- '//=== Call Me.Finish\r
- If Not IsEmpty( def_log_fname ) Then\r
- Me.Finish\r
- m_DefLogFName = def_log_fname\r
- End If\r
-\r
- m_Path = Empty\r
-End Sub\r
-\r
-\r
- \r
-'********************************************************************************\r
-' <<< [TestScript::Debug] >>> \r
-'********************************************************************************\r
-Public Sub Debug( ByVal vbs_path, ByVal func, ByVal param )\r
- echo "=========================================================="\r
- echo "<<< [" & g_fs.GetFileName( g_fs.GetParentFolderName( vbs_path ) ) & "\" _\r
- & g_fs.GetFileName( vbs_path ) & "] - " & func & " >>>"\r
- echo "Debug Mode ..."\r
-\r
- m_Path = vbs_path\r
-\r
- m_Debug = True\r
- call_vbs_d vbs_path, func, param\r
- m_Debug = False\r
-\r
- if m_Pass Then\r
- If func <> "test_current" Then\r
- m_nPass = m_nPass + 1\r
- echo "Pass."\r
- End If\r
- End If\r
-\r
- m_Path = Empty\r
-End Sub\r
-\r
-\r
- \r
-'********************************************************************************\r
-' <<< [TestScript::WriteLogLine] >>> \r
-'********************************************************************************\r
-Public Sub WriteLogLine( Message )\r
- If not IsEmpty( m_Log ) Then\r
- m_Log.WriteLine Message\r
- End If\r
- If not IsEmpty( m_MemLog ) Then\r
- m_MemLog = m_MemLog + Message + vbCRLF\r
- End If\r
-End Sub\r
- \r
-'********************************************************************************\r
-' <<< [TestScript::AddManualTest] >>> \r
-'********************************************************************************\r
-Public Sub AddManualTest( TestSymbol )\r
- ReDim Preserve m_ManualTests( UBound( m_ManualTests ) + 1 )\r
- m_ManualTests( UBound( m_ManualTests ) ) = TestSymbol\r
- ReDim Preserve m_ManualTestsPath( UBound( m_ManualTestsPath ) + 1 )\r
- m_ManualTestsPath( UBound( m_ManualTestsPath ) ) = m_Path\r
-End Sub\r
-\r
-\r
- \r
-'********************************************************************************\r
-' <<< [TestScript::Raise] >>> \r
-'********************************************************************************\r
-Public Sub Raise( en, ed )\r
- m_nFail = m_nFail + 1\r
- If en >= 0 and en <= &h7FFF Then\r
- echo "[FAIL] [ERROR](" & en & ") " & ed\r
- Else\r
- echo "[FAIL] [ERROR](" & Hex(en) & ") " & ed\r
- End If\r
-End Sub\r
-\r
-\r
- \r
-'********************************************************************************\r
-' <<< [TestScript::Finish] >>> \r
-'********************************************************************************\r
-Public Sub Finish\r
- Dim TestSymbol, sub_test ' Boolean\r
- Dim i\r
-\r
- i=0\r
- For Each TestSymbol In m_ManualTests\r
- echo "[ManualTest] " + TestSymbol + " in """ + m_ManualTestsPath(i) + """"\r
- i=i+1\r
- Next\r
-\r
- m_MemLog = Empty\r
-\r
- sub_test = False\r
- If WScript.Arguments.Count >= 1 Then\r
- If WScript.Arguments(0) = "-sub_test" Then sub_test = True\r
- End If\r
-\r
- If sub_test Then\r
- If m_nFail = 0 Then WScript.Quit 0 Else WScript.Quit 1 End If\r
- Else\r
- echo "=========================================================="\r
- echo "Test Finish (Pass=" & m_nPass & ", Manual=" & UBound(m_ManualTests)+1 & _\r
- ", Skip=" & m_nSkip & ", Fail=" & m_nFail & ")"\r
- echo ""\r
- End If\r
-\r
- ReDim m_ManualTests(-1)\r
- m_Log = Empty\r
-End Sub\r
-\r
-\r
-\r
-\r
-\r
- \r
-End Class \r
- \r
-'*-------------------------------------------------------------------------*\r
-'* \81\9f<<<< [Tests] Class >>>> */ \r
-'*-------------------------------------------------------------------------*\r
-Class Tests\r
-\r
- Private m_Sets ' As Dictionary of UnitTest. key is UnitTest::Symbol\r
- Private m_BaseFolderPath ' as string. All Test ROOT\r
- Private m_Prompt ' as TestPrompt or Empty\r
- Private m_CurrentSymbol ' as string of current test symbol or ALL or ALL_R\r
- Private m_CurrentSubSymbol ' as string\r
- Private m_CurrentTest ' as UnitTest of m_CurrentSymbol\r
- Public CurrentTestPriority ' as integer small is high priority\r
- Private m_bAllTest ' as boolean\r
- Private m_AllFName ' as string\r
- Private m_Symbol ' as string of doing test symbol\r
- Public bTargetDebug ' as boolean\r
- Public c_ErrDblSymbol ' as const number\r
- Public m_bDisableAddTestScript ' as boolean\r
- Public m_bAutoDiff ' as boolean\r
- Public m_bSkipSection ' as boolean\r
-\r
- '----------------------------------\r
- Public Property Get Sets : Set Sets = m_Sets : End Property\r
- Public Property Get BaseFolderPath : BaseFolderPath = m_BaseFolderPath : End Property\r
- Public Property Let BaseFolderPath( x ) : m_BaseFolderPath = x : End Property\r
- Public Property Set Prompt( x ) : Set m_Prompt = x : End Property\r
- Public Property Get Prompt : Set Prompt = m_Prompt : End Property\r
- Public Property Get CurrentSymbol : CurrentSymbol = m_CurrentSymbol : End Property\r
- Public Property Get CurrentTest : If IsObject(m_CurrentTest) Then Set CurrentTest = m_CurrentTest : Else CurrentTest = m_CurrentTest : End If : End Property\r
- Public Property Get bAllTest : bAllTest = m_bAllTest : End Property\r
- Public Property Get Symbol : Symbol = m_Symbol : End Property\r
- \r
-'********************************************************************************\r
-' <<< [Tests::Class_Initialize] >>> \r
-'********************************************************************************\r
-Private Sub Class_Initialize\r
- Set m_Sets = CreateObject("Scripting.Dictionary")\r
- m_BaseFolderPath = g_fs.GetParentFolderName( WScript.ScriptFullName )\r
- m_CurrentSymbol = "ALL"\r
- m_AllFName = "T_ALL.vbs"\r
- m_bAllTest = False\r
- Me.bTargetDebug = False\r
- Me.c_ErrDblSymbol = 1010\r
- m_bDisableAddTestScript = False\r
- m_bAutoDiff = False\r
- m_bSkipSection = not IsEmpty( g_SkipSection )\r
- If not m_bSkipSection Then SkipToSection 0\r
-End Sub\r
-\r
- \r
-'********************************************************************************\r
-' <<< [Tests::AddTestScriptAuto] >>> \r
-'********************************************************************************\r
-Public Function AddTestScriptAuto( BasePath, FName )\r
- m_AllFName = FName\r
- AddTestScriptAuto_EnumSubFolders g_fs.GetFolder( BasePath ), FName\r
-End Function\r
-\r
-\r
-Private Sub AddTestScriptAuto_EnumSubFolders( fo, FName )\r
- Dim subfo\r
-\r
- If g_fs.FileExists( fo.Path + "\" + FName ) Then\r
- AddTestScript g_fs.GetFileName( fo.Path ), fo.Path + "\" + FName\r
- End If\r
- For Each subfo in fo.SubFolders\r
- AddTestScriptAuto_EnumSubFolders subfo, FName\r
- Next\r
-End Sub\r
- \r
-'********************************************************************************\r
-' <<< [Tests::AddTestScript] >>> \r
-'********************************************************************************\r
-Public Function AddTestScript( Symbol, Path )\r
- Dim test\r
-\r
- If Not g_fs.FileExists( Path ) Then Err.Raise 53,,"\83t\83@\83C\83\8b\82ª\8c©\82Â\82©\82è\82Ü\82¹\82ñ " + Path\r
- If m_bDisableAddTestScript Then Exit Function\r
-\r
- Set test = new UnitTest : ErrCheck\r
- test.Symbol = Symbol\r
- test.ScriptPath = g_fs.GetAbsolutePathName( Path )\r
- If m_Sets.Exists( test.Symbol ) Then _\r
- Err.Raise c_ErrDblSymbol,"class Tests", "[ERROR] Already defined the symbol '"+Symbol+"' in "+ _\r
- m_Sets.Item(Symbol).ScriptPath\r
- m_Sets.Add test.Symbol, test\r
-\r
- Me.CurrentTestPriority = 1000\r
- If g_debug Then call_vbs_d Path, "test_current", Me _\r
- Else call_vbs_t Path, "test_current", Me\r
- test.Priority = Me.CurrentTestPriority\r
-\r
- Set AddTestScript = test\r
-End Function\r
-\r
- \r
-'********************************************************************************\r
-' <<< [Tests::SetCurrentSymbol] >>> \r
-'********************************************************************************\r
-Public Function SetCurrentSymbol( Symbol_or_Path )\r
- Dim key, item, b\r
-\r
- SetCurrentSymbol = 0\r
-\r
- '// ALL and ALL_R is special symbol\r
- If Symbol_or_Path = "ALL" or Symbol_or_Path = "ALL_R" Then m_CurrentSymbol = Symbol_or_Path : _\r
- m_CurrentTest = Empty : Exit Function\r
-\r
- '// Search by test symbol\r
- For Each key in m_Sets.Keys()\r
- If key = Symbol_or_Path Then m_CurrentSymbol = Symbol_or_Path : _\r
- Set m_CurrentTest = m_Sets.Item( m_CurrentSymbol ) : Exit Function\r
- Next\r
-\r
- '// Search by path\r
- For Each item in m_Sets.Items()\r
- If item.ScriptPath = Symbol_or_Path Then m_CurrentSymbol = item.Symbol : _\r
- Set m_CurrentTest = m_Sets.Item( m_CurrentSymbol ) : Exit Function\r
- Next\r
-\r
- '// If Symbol is path, Add test symbol\r
- If g_fs.FileExists( Symbol_or_Path ) Then\r
- If UCase(g_fs.GetFileName( Symbol_or_Path )) = UCase(m_AllFName) Then _\r
- m_CurrentSymbol = g_fs.GetFileName( g_fs.GetParentFolderName( g_fs.GetAbsolutePathName(Symbol_or_Path) ) ) _\r
- Else m_CurrentSymbol = g_fs.GetBaseName( Symbol_or_Path )\r
-\r
- b = True : If m_Sets.Exists( m_CurrentSymbol ) Then _\r
- b = ( m_Sets.Item( m_CurrentSymbol ).ScriptPath <> g_fs.GetAbsolutePathName( Symbol_or_Path ) )\r
- If b Then 'If Not m_Sets.Exists( m_CurrentSymbol ) or _\r
- ' m_Sets.Item( m_CurrentSymbol ).ScriptPath <> g_fs.GetAbsolutePathName( Symbol_or_Path ) Then\r
- AddTestScript m_CurrentSymbol, Symbol_or_Path\r
- End If\r
- Set m_CurrentTest = m_Sets.Item( m_CurrentSymbol )\r
- Exit Function\r
- End If\r
-\r
- '// Error: Symbol\r
- echo "[ERROR] Not found symbol or path """ + Symbol_or_Path + """. CurrentDirectory = " & g_sh.CurrentDirectory\r
- SetCurrentSymbol = 1\r
-End Function\r
-\r
-\r
- \r
-'********************************************************************************\r
-' <<< [Tests::DoTest] >>> \r
-'********************************************************************************\r
-Public Sub DoTest( Func, bReverse )\r
-\r
- If m_CurrentSymbol = "ALL" Or m_CurrentSymbol = "ALL_R" Then\r
- Redim utests(-1)\r
-\r
- If bReverse Then\r
- ShakerSort_fromDic m_Sets, utests, -1, GetRef("CmpUnitTestPriorityDec"), Empty\r
- Else\r
- ShakerSort_fromDic m_Sets, utests, +1, GetRef("CmpUnitTestPriorityInc"), Empty\r
- End If\r
-\r
- g_Test.m_DefLogFName = m_BaseFolderPath + "\" + g_fs.GetFileName( g_Test.m_DefLogFName )\r
- g_Test.Start\r
- If m_bAutoDiff Then g_Test.m_MemLog = ""\r
- For Each m_CurrentTest in utests\r
- TestCurrentSetup\r
- g_Test.Do_ m_CurrentTest.ScriptPath, "test_current", Me\r
- TestSetup\r
- g_Test.Do_ m_CurrentTest.ScriptPath, Func, Me\r
- If Me.AutoDiff Then g_Test.Finish : m_bAllTest = False : Exit Sub\r
- Next\r
- g_Test.Finish\r
- Else\r
- g_Test.m_DefLogFName = g_fs.GetParentFolderName( m_CurrentTest.ScriptPath ) + "\" + g_fs.GetFileName( g_Test.m_DefLogFName )\r
- g_Test.Start\r
- If m_bAutoDiff Then g_Test.m_MemLog = ""\r
- Set m_CurrentTest = m_Sets.Item( m_CurrentSymbol )\r
- TestCurrentSetup\r
- g_Test.Do_ m_CurrentTest.ScriptPath, "test_current", Me\r
- TestSetup\r
- g_Test.Do_ m_CurrentTest.ScriptPath, Func, Me\r
- If Me.AutoDiff Then g_Test.Finish : m_bAllTest = False : Exit Sub\r
- g_Test.Finish\r
- End If\r
-End Sub\r
-\r
- \r
-'********************************************************************************\r
-' <<< [Tests::DebugTest] >>> \r
-'********************************************************************************\r
-Public Sub DebugTest( Func, bReverse )\r
- If m_CurrentSymbol = "ALL" Or m_CurrentSymbol = "ALL_R" Then\r
- Dim items(), i\r
-\r
- i = m_Sets.Count - 1\r
- ReDim Preserve items( i )\r
- If bReverse Then\r
- For Each m_CurrentTest in m_Sets.Items()\r
- Set items( i ) = m_CurrentTest\r
- i = i - 1\r
- Next\r
- Else\r
- i = 0\r
- For Each m_CurrentTest in m_Sets.Items()\r
- Set items( i ) = m_CurrentTest\r
- i = i + 1\r
- Next\r
- End If\r
-\r
- g_Test.m_DefLogFName = m_BaseFolderPath + "\" + g_fs.GetFileName( g_Test.m_DefLogFName )\r
- g_Test.Start\r
- For Each m_CurrentTest in items\r
- If NotSkipSection() Then\r
- TestCurrentSetup\r
- g_Test.Debug m_CurrentTest.ScriptPath, "test_current", Me\r
- TestSetup\r
- g_Test.Debug m_CurrentTest.ScriptPath, Func, Me\r
- End If\r
- Next\r
- g_Test.Finish\r
- Else\r
- g_Test.m_DefLogFName = g_fs.GetParentFolderName( m_CurrentTest.ScriptPath ) + "\" + g_fs.GetFileName( g_Test.m_DefLogFName )\r
- g_Test.Start\r
- Set m_CurrentTest = m_Sets.Item( m_CurrentSymbol )\r
- TestCurrentSetup\r
- g_Test.Debug m_CurrentTest.ScriptPath, "test_current", Me\r
- TestSetup\r
- g_Test.Debug m_CurrentTest.ScriptPath, Func, Me\r
- g_Test.Finish\r
- End If\r
-End Sub\r
-\r
- \r
-'********************************************************************************\r
-' <<< [Tests::DoAllTest] >>> \r
-'********************************************************************************\r
-Public Sub DoAllTest()\r
- m_bAllTest = True\r
- If m_CurrentSymbol = "ALL" Or m_CurrentSymbol = "ALL_R" Then\r
- Redim utests_inc(-1), utests_dec(-1)\r
-\r
- ShakerSort_fromDic m_Sets, utests_inc, +1, GetRef("CmpUnitTestPriorityInc"), Empty\r
- ShakerSort_fromDic m_Sets, utests_dec, -1, GetRef("CmpUnitTestPriorityDec"), Empty\r
-\r
- g_Test.m_DefLogFName = m_BaseFolderPath + "\" + g_fs.GetFileName( g_Test.m_DefLogFName )\r
- g_Test.Start\r
- If m_bAutoDiff Then g_Test.m_MemLog = ""\r
-\r
- For Each m_CurrentTest in utests_inc\r
- If NotSkipSection() Then\r
- TestCurrentSetup\r
- g_Test.Do_ m_CurrentTest.ScriptPath, "test_current", Me\r
- If Me.AutoDiff Then g_Test.Finish : m_bAllTest = False : Exit Sub\r
- End If\r
- Next\r
- For Each m_CurrentTest in utests_inc\r
- If NotSkipSection() Then\r
- TestSetup\r
- g_Test.Do_ m_CurrentTest.ScriptPath, "test_build", Me\r
- If Me.AutoDiff Then g_Test.Finish : m_bAllTest = False : Exit Sub\r
- End If\r
- Next\r
- For Each m_CurrentTest in utests_inc\r
- If NotSkipSection() Then\r
- TestSetup\r
- g_Test.Do_ m_CurrentTest.ScriptPath, "test_setup", Me\r
- If Me.AutoDiff Then g_Test.Finish : m_bAllTest = False : Exit Sub\r
- End If\r
- Next\r
- For Each m_CurrentTest in utests_inc\r
- If NotSkipSection() Then\r
- TestSetup\r
- g_Test.Do_ m_CurrentTest.ScriptPath, "test_start", Me\r
- If Me.AutoDiff Then g_Test.Finish : m_bAllTest = False : Exit Sub\r
- End If\r
- Next\r
- For Each m_CurrentTest in utests_dec\r
- If NotSkipSection() Then\r
- TestSetup\r
- g_Test.Do_ m_CurrentTest.ScriptPath, "test_check", Me\r
- If Me.AutoDiff Then g_Test.Finish : m_bAllTest = False : Exit Sub\r
- End If\r
- Next\r
- For Each m_CurrentTest in utests_dec\r
- If NotSkipSection() Then\r
- TestSetup\r
- g_Test.Do_ m_CurrentTest.ScriptPath, "test_clean", Me\r
- If Me.AutoDiff Then g_Test.Finish : m_bAllTest = False : Exit Sub\r
- End If\r
- Next\r
- If m_bSkipSection Then g_Test.Raise 1, "SkipToSection \82ð\83J\83b\83g\82µ\82Ä\82\82¾\82³\82¢\81B"\r
- g_Test.Finish\r
- Else\r
- Set m_CurrentTest = m_Sets.Item( m_CurrentSymbol )\r
- g_Test.m_DefLogFName = g_fs.GetParentFolderName( m_CurrentTest.ScriptPath ) + "\" + g_fs.GetFileName( g_Test.m_DefLogFName )\r
- g_Test.Start\r
- If m_bAutoDiff Then g_Test.m_MemLog = ""\r
- If NotSkipSection() Then\r
- TestCurrentSetup\r
- g_Test.Do_ m_CurrentTest.ScriptPath, "test_current", Me\r
- End If\r
- If NotSkipSection() Then\r
- TestSetup\r
- g_Test.Do_ m_CurrentTest.ScriptPath, "test_build", Me\r
- If Me.AutoDiff Then g_Test.Finish : m_bAllTest = False : Exit Sub\r
- End If\r
- If NotSkipSection() Then\r
- TestSetup\r
- g_Test.Do_ m_CurrentTest.ScriptPath, "test_setup", Me\r
- If Me.AutoDiff Then g_Test.Finish : m_bAllTest = False : Exit Sub\r
- End If\r
- If NotSkipSection() Then\r
- TestSetup\r
- g_Test.Do_ m_CurrentTest.ScriptPath, "test_start", Me\r
- If Me.AutoDiff Then g_Test.Finish : m_bAllTest = False : Exit Sub\r
- End If\r
- If NotSkipSection() Then\r
- TestSetup\r
- g_Test.Do_ m_CurrentTest.ScriptPath, "test_check", Me\r
- If Me.AutoDiff Then g_Test.Finish : m_bAllTest = False : Exit Sub\r
- End If\r
- If NotSkipSection() Then\r
- TestSetup\r
- g_Test.Do_ m_CurrentTest.ScriptPath, "test_clean", Me\r
- If Me.AutoDiff Then g_Test.Finish : m_bAllTest = False : Exit Sub\r
- End If\r
- If m_bSkipSection Then g_Test.Raise 1, "SkipToSection \82ð\83J\83b\83g\82µ\82Ä\82\82¾\82³\82¢\81B"\r
- g_Test.Finish\r
- End If\r
-\r
- m_bAllTest = False\r
-End Sub\r
-\r
-\r
- \r
-'********************************************************************************\r
-' <<< [Tests::TestCurrentSetup] >>> \r
-'********************************************************************************\r
-Private Sub TestCurrentSetup()\r
- m_Symbol = m_CurrentTest.Symbol\r
- CurrentTestPriority = m_CurrentTest.Priority\r
- g_Test.m_Pass = True\r
-End Sub\r
-\r
- \r
-'********************************************************************************\r
-' <<< [Tests::TestSetup] >>> \r
-'********************************************************************************\r
-Private Sub TestSetup()\r
- m_Symbol = m_CurrentTest.Symbol\r
- g_Test.m_Pass = False\r
-End Sub\r
-\r
- \r
-'********************************************************************************\r
-' <<< [Tests::SetCur] >>> \r
-'********************************************************************************\r
-Public Sub SetCur( SubSymbol )\r
- m_CurrentSubSymbol = SubSymbol\r
-End Sub\r
-\r
- \r
-'********************************************************************************\r
-' <<< [Tests::IsCur] >>> \r
-'********************************************************************************\r
-Public Function IsCur( SubSymbol )\r
- If m_CurrentSubSymbol = "ALL" Or m_CurrentSubSymbol = "ALL_R" Or _\r
- m_CurrentSubSymbol = SubSymbol Then\r
- IsCur = True\r
- Else\r
- IsCur = False\r
- End IF\r
-End Function\r
-\r
- \r
-'********************************************************************************\r
-' <<< [Tests::AutoDiff] >>> \r
-'********************************************************************************\r
-Public Function AutoDiff()\r
- If m_bAutoDiff and g_Test.m_nFail > 0 Then\r
- Dim f : Set f = new StringStream : ErrCheck\r
- ReDim path(1)\r
- Dim n_path, line\r
-\r
-\r
- '//=== parse the output of fc command\r
- n_path = 0\r
- f.SetString g_Test.m_MemLog\r
- Do Until f.AtEndOfStream\r
- line = f.ReadLine\r
- If Left( line, 6 ) = "***** " Then\r
- path( n_path ) = Mid( line, 7 )\r
- n_path = n_path + 1\r
- If n_path = 2 Then Exit Do\r
- End If\r
- Loop\r
- f = Empty\r
-\r
-\r
- '//=== Start Diff tool\r
- If not IsEmpty( path(1) ) Then\r
- path(0) = GetAbsPath( path(0), g_fs.GetParentFolderName( m_CurrentTest.ScriptPath ) )\r
- path(1) = GetAbsPath( path(1), g_fs.GetParentFolderName( m_CurrentTest.ScriptPath ) )\r
- If IsDefined("Setting_getDiffCmdLine") Then\r
- line = """" + Setting_getDiffCmdLine(0) + """ """ + path(0) + """ """ + path(1) + """"\r
- CreateFile g_fs.GetParentFolderName( m_CurrentTest.ScriptPath ) + "\Test_diff.bat", _\r
- "start """" " + line\r
- g_sh.Run line\r
- Else\r
- echo "[WARNING] Cannot open diff tool : not defined Setting_getDiffCmdLine"\r
- End If\r
- AutoDiff = True : Exit Function\r
- End If\r
-\r
- End If\r
- AutoDiff = False\r
-End Function\r
-\r
- \r
-'********************************************************************************\r
-' <<< [Tests::OpenFailFolder] >>> \r
-'********************************************************************************\r
-Public Sub OpenFailFolder()\r
- echo ">OpenFailFolder"\r
- Dim ec\r
- Set ec = new EchoOff : ErrCheck\r
-\r
- Dim f, line, i, s\r
- Dim ds_:Set ds_= new CurDirStack : ErrCheck\r
-\r
- Set f = OpenTextFile( g_Test.m_DefLogFName )\r
- ec = Empty\r
-\r
- Do Until f.AtEndOfStream\r
- line = f.ReadLine\r
- If Left( line, 6 ) = "[FAIL]" Then\r
-\r
- '//=== Open fail folder and ReTest\r
- echo line\r
- line = f.ReadLine\r
- echo line\r
-\r
- Set ec = new EchoOff : ErrCheck\r
- i = 1\r
- s = MeltQuot( line, i )\r
- If i > 0 Then\r
- s = MeltQuot( line, i )\r
- If not IsEmpty( s ) Then\r
-\r
- Setting_openFolder s\r
-\r
- If LCase( g_fs.GetFileName( s ) ) = "test.vbs" Then\r
- CreateFile g_fs.GetParentFolderName( s ) + "\Test_debugger.bat", _\r
- "cscript //x Test.vbs /g_debug:1 /set_input:8.5.5."\r
- echo "Created debug.bat"\r
- Sleep 1000\r
- echo "Run Test.vbs AutoDiff mode"\r
- g_sh.Run "cscript """ + s + """ /set_input:8.5.2.9.",,True\r
-\r
- '// echo "Run Test.vbs AutoDiff mode"\r
- '// cd g_fs.GetParentFolderName( s )\r
- '// g_sh.Run "debug.bat"\r
- End If\r
- End If\r
- End If\r
-\r
-\r
- '//=== Change from [FAIL] to [FAIL:Checked] in Test_logs.txt file\r
- f = Empty\r
- Set f = StartReplace( "Test_logs.txt", "Test_logs_replacing.txt", False )\r
- i = 0\r
- Do Until f.r.AtEndOfStream\r
- line = f.r.ReadLine\r
- If i = 0 and InStr( line, "[FAIL]" ) > 0 Then\r
- line = Replace( line, "[FAIL]", "[FAIL:Checked]" )\r
- i = 1\r
- End If\r
- f.w.WriteLine line\r
- Loop\r
- f.Finish\r
- ec = Empty\r
- Exit Sub\r
- End If\r
- Loop\r
- Raise 1, "No Fail"\r
-End Sub\r
- \r
-'********************************************************************************\r
-' <<< [Tests::NextFail] >>> \r
-'********************************************************************************\r
-Public Sub NextFail()\r
- Dim f, line, i, s\r
- Dim ds_:Set ds_= new CurDirStack : ErrCheck\r
-\r
- Set f = OpenTextFile( g_Test.m_DefLogFName )\r
-\r
- Do Until f.AtEndOfStream\r
- line = f.ReadLine\r
- If Left( line, 6 ) = "[FAIL]" Then\r
-\r
- '//=== Open fail folder\r
- echo line\r
- line = f.ReadLine\r
- echo line\r
- i = 1\r
- s = MeltQuot( line, i )\r
- If i > 0 Then\r
- s = MeltQuot( line, i )\r
- If not IsEmpty( s ) Then\r
- Setting_openFolder s\r
- If LCase( g_fs.GetFileName( s ) ) = "test.vbs" Then\r
- CreateFile g_fs.GetParentFolderName( s ) + "\Test_debugger.bat", _\r
- "cscript //x Test.vbs /g_debug:1 /set_input:8.5.5."\r
- echo "Created debug.bat"\r
- Sleep 1000\r
- echo "Run Test.vbs AutoDiff mode"\r
- g_sh.Run "cscript """ + s + """ /set_input:8.5.2.9.",,True\r
-\r
- '// echo "Run Test.vbs AutoDiff mode"\r
- '// cd g_fs.GetParentFolderName( s )\r
- '// g_sh.Run "debug.bat"\r
- End If\r
- End If\r
- End If\r
-\r
-\r
- '//=== Change from [FAIL] to [FAIL:Checked] in Test_logs.txt file\r
- f = Empty\r
- Set f = StartReplace( "Test_logs.txt", "Test_logs_replacing.txt", False )\r
- i = 0\r
- Do Until f.r.AtEndOfStream\r
- line = f.r.ReadLine\r
- If i = 0 and InStr( line, "[FAIL]" ) > 0 Then\r
- line = Replace( line, "[FAIL]", "[FAIL:Checked]" )\r
- i = 1\r
- End If\r
- f.w.WriteLine line\r
- Loop\r
- f = Empty\r
- Exit Sub\r
- End If\r
- Loop\r
- Raise 1, "No Fail"\r
-End Sub\r
- \r
-End Class \r
- \r
-'********************************************************************************\r
-' <<< [CmpUnitTestPriorityInc] >>> \r
-'********************************************************************************\r
-Function CmpUnitTestPriorityInc( left, right, param )\r
- CmpUnitTestPriorityInc = left.Priority - right.Priority\r
-End Function\r
- \r
-'********************************************************************************\r
-' <<< [CmpUnitTestPriorityDec] >>> \r
-'********************************************************************************\r
-Function CmpUnitTestPriorityDec( left, right, param )\r
- CmpUnitTestPriorityDec = right.Priority - left.Priority\r
-End Function\r
- \r
-'*-------------------------------------------------------------------------*\r
-'* \81\9f<<<< [UnitTest] Class >>>> */ \r
-'*-------------------------------------------------------------------------*\r
-Class UnitTest\r
-\r
- Public Symbol ' As String\r
- Public ScriptPath ' As String\r
- Public Priority ' As Integer\r
-\r
- '----------------------------------\r
- Private Sub Class_Initialize\r
- Symbol = "NoSymbol"\r
- ScriptPath = ""\r
- End Sub\r
-\r
- Public Function Value\r
- Value = "[" & Symbol & "]" & vbCR & vbLF & " " & ScriptPath\r
- End Function\r
-\r
- Public Function PathToAbs( BaseFolderPath )\r
- Dim s\r
- PathToAbs = True\r
- s = g_fs.GetAbsolutePathName( BaseFolderPath & "\" & ScriptPath )\r
- If Not g_fs.FileExists( s ) Then echo "[ERROR] Not found " + ScriptPath + ", Base=" + BaseFolderPath : PathToAbs = False\r
- ScriptPath = s\r
- End Function\r
-\r
-End Class\r
-\r
-\r
- \r
-'*-------------------------------------------------------------------------*\r
-'* \81\9f<<<< Test Result >>>> */ \r
-'*-------------------------------------------------------------------------*\r
-\r
- \r
-'********************************************************************************\r
-' <<< [Pass] >>> \r
-'********************************************************************************\r
-Sub Pass\r
- Dim b : b = g_EchoObj.m_bEchoOff : g_EchoObj.m_bEchoOff = False\r
- echo "Pass."\r
- g_EchoObj.m_bEchoOff = b\r
-\r
- Err.Raise Err_TestPass, WScript.ScriptFullName, "Pass."\r
-End Sub\r
-\r
-\r
-\r
- \r
-'********************************************************************************\r
-' <<< [Fail] >>> \r
-'********************************************************************************\r
-Sub Fail()\r
- Err.Raise Err_TestFail,, "Fail the Test"\r
-End Sub\r
-\r
-\r
-\r
- \r
-'********************************************************************************\r
-' <<< [Skip] >>> \r
-'********************************************************************************\r
-Sub Skip()\r
- Err.Raise Err_TestSkip,, "[SKIP] Skip the Test"\r
-End Sub\r
-\r
-\r
-\r
- \r
-'********************************************************************************\r
-' <<< [ManualTest] >>> \r
-'********************************************************************************\r
-Sub ManualTest( TestSymbol )\r
- Dim b : b = g_EchoObj.m_bEchoOff : g_EchoObj.m_bEchoOff = False\r
- echo "((( ["+TestSymbol+"] )))"\r
- echo "This is ManualTest."\r
- g_EchoObj.m_bEchoOff = b\r
-\r
- g_Test.AddManualTest TestSymbol\r
-End Sub\r
-\r
- \r
-'*-------------------------------------------------------------------------*\r
-'* \81\9f<<<< Tools for Test Program >>>> */ \r
-'*-------------------------------------------------------------------------*\r
-\r
- \r
-'********************************************************************************\r
-' <<< [EchoTestStart] >>> \r
-'********************************************************************************\r
-Sub EchoTestStart( TestSymbol )\r
- echo "((( ["+TestSymbol+"] )))"\r
-End Sub\r
-\r
-\r
- \r
-'********************************************************************************\r
-' <<< [CheckTestErrLevel] >>> \r
-'********************************************************************************\r
-Sub CheckTestErrLevel( r )\r
- If r = Err_TestSkip Then\r
- Skip\r
- ElseIf r <> Err_TestPass Then\r
- Fail\r
- End If\r
-End Sub\r
-\r
-\r
- \r
-'********************************************************************************\r
-' <<< [ConvertToAbsPath] >>> \r
-'********************************************************************************\r
-Sub ConvertToAbsPath( SrcPath, DstPath )\r
- Dim src, dst, dst_parent, line, p1, p2, path\r
-\r
- Set src = OpenTextFile( SrcPath )\r
- mkdir_for DstPath\r
- echo ">ConvertToAbsPath """ + SrcPath + """, """ + DstPath + """"\r
- g_AppKey.AddNewWritableFolder DstPath\r
- Set dst = g_fs.CreateTextFile( DstPath, True, (g_TextFileConvertFormat = F_Unicode) )\r
-\r
- Do Until src.AtEndOfStream\r
- line = src.ReadLine\r
- Do\r
- p1 = InStr( line, "%AbsPath(" )\r
- If p1 = 0 Then Exit Do\r
- p2 = InStr( p1 + 9, line, ")%" )\r
- path = Mid( line, p1+9, p2-p1-9 )\r
- path = GetAbsPath( path, g_fs.GetParentFolderName( g_fs.GetAbsolutePathName( SrcPath ) ) )\r
- line = Left( line, p1 - 1 ) + path + Mid( line, p2 + 2 )\r
- Loop\r
- line = Replace( line, "%DesktopPath%", g_sh.SpecialFolders("Desktop") )\r
- dst.WriteLine line\r
- Loop\r
- src = Empty\r
- dst = Empty\r
-End Sub\r
-\r
- \r
-'********************************************************************************\r
-' <<< [OpenTextFile] >>> \r
-'********************************************************************************\r
-Function OpenTextFile( Path )\r
- Dim en, ed\r
-\r
- On Error Resume Next\r
- Set OpenTextFile = g_fs.OpenTextFile( Path,,,-2 )\r
- en = Err.Number : ed = Err.Description : On Error GoTo 0\r
- If en = E_FileNotExist or en = E_PathNotFound Then Err.raise en,,ed+" : "+Path\r
- If en <> 0 Then Err.Raise en,,ed\r
-End Function\r
-\r
-\r
- \r
OSDN Git Service
