--- /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
