_src/Test/vbslib_test/vbslib/TestScript.vbs

   1 Option Explicit \r
   2 \r
   3 ' vbslib  ver2.00 2008/8/17\r
   4 ' Copyright (c) 2008, T's-Neko\r
   5 ' All rights reserved. 3-clause BSD license.\r
   6 \r
   7 \r
   8 ' Global Variable\r
   9 Dim  g_Test, g_echo_on\r
  10 \r
  11 Function  InitializeModule\r
  12   g_echo_on = True\r
  13   Set  g_Test = New TestScript\r
  14 End Function\r
  15 Dim  g_InitializeModule\r
  16 Set  g_InitializeModule = GetRef( "InitializeModule" )\r
  17 \r
  18 Const  Err_TestPass = 21\r
  19 Const  Err_TestSkip = 22\r
  20 Const  Err_TestFail = 23\r
  21 \r
  22  \r
  23 '********************************************************************************\r
  24 '  <<< [call_vbs_t] >>> \r
  25 '   - The difference of call_vbs is not depend on vbslib.\r
  26 '   - path, func as string, param as variant\r
  27 '********************************************************************************\r
  28 Function  call_vbs_t( ByVal path, ByVal func, ByVal param )\r
  29   Dim oldDir, f, funcX, in_interpret, en, ed, es\r
  30 \r
  31   in_interpret = False\r
  32   oldDir = g_sh.CurrentDirectory\r
  33 \r
  34   path = g_sh.ExpandEnvironmentStrings( path )\r
  35   path = g_fs.GetAbsolutePathName( path )\r
  36 \r
  37   '-----------------------------------------\r
  38   ' Interpret\r
  39   On Error Resume Next  'try\r
  40     g_sh.CurrentDirectory = g_fs.GetParentFolderName( path )\r
  41     If Err=0 Then  Set f = g_fs.OpenTextFile( g_fs.GetFileName( path ) )\r
  42     If Err=0 Then  in_interpret = True : ExecuteGlobal f.ReadAll()\r
  43     If Err=&h411 Then  in_interpret = False : Err.Clear  ' Ignore symbol override error\r
  44     If Err=0 Then  in_interpret = False\r
  45     If Err=0 Then  Set funcX = GetRef( func )\r
  46 \r
  47   en = Err.Number : es = Err.Source : ed = Err.Description : On Error GoTo 0 : If en <> 0 Then  'catch\r
  48     If in_interpret Then\r
  49       ed = ed + " Syntax ERROR in """ + g_fs.GetFileName( path ) _\r
  50               + """. Please double click """ _\r
  51               + g_fs.GetFileName( path ) + """."\r
  52     End If\r
  53     If en = &h35 Then  ed = "Not found file '" + path\r
  54     If en = 5 Then  ed = "Not found func name '" + func + "' in " + path\r
  55   End If\r
  56 \r
  57 \r
  58   '-----------------------------------------\r
  59   ' Call\r
  60   If en = 0 Then\r
  61     On Error Resume Next  'try\r
  62       call_vbs_t = funcX( param )\r
  63     en = Err.Number : es = Err.Source : ed = Err.Description : On Error GoTo 0 : If en <> 0 Then  'catch\r
  64       If en = Err_TestPass Then\r
  65         en = 0\r
  66       Else\r
  67         ed = ed + " - Runtime ERROR in the function of """ + func + """ in """ _\r
  68            + GetStepPath( path, g_fs.GetParentFolderName( WScript.ScriptFullName ) ) + """."\r
  69       End If\r
  70     End If\r
  71   End If\r
  72 \r
  73 \r
  74   '-----------------------------------------\r
  75   ' Finally\r
  76   f.Close\r
  77   g_sh.CurrentDirectory = oldDir\r
  78 \r
  79   If en <> 0 Then  Err.Raise en, es, ed\r
  80 End Function\r
  81 \r
  82 \r
  83 \r
  84  \r
  85 '********************************************************************************\r
  86 '  <<< [call_vbs_d] >>> \r
  87 '********************************************************************************\r
  88 Function  call_vbs_d( ByVal path, ByVal func, ByVal param )\r
  89   Dim oldDir, f, funcX, in_call, in_interpret, en\r
  90 \r
  91   oldDir = g_sh.CurrentDirectory\r
  92 \r
  93   path = g_sh.ExpandEnvironmentStrings( path )\r
  94   path = g_fs.GetAbsolutePathName( path )\r
  95 \r
  96   g_sh.CurrentDirectory = g_fs.GetParentFolderName( path )\r
  97 \r
  98   Set f = g_fs.OpenTextFile( g_fs.GetFileName( path ) )\r
  99   ExecuteGlobal f.ReadAll()\r
 100   Set funcX = GetRef( func )  ' If error, Not found func symbol\r
 101   call_vbs_d = funcX( param )\r
 102   f.Close\r
 103   g_sh.CurrentDirectory = oldDir\r
 104 End Function\r
 105 \r
 106 \r
 107 \r
 108  \r
 109 '*-------------------------------------------------------------------------*\r
 110 '* \81\9f<<<< [TestScript] Class >>>> */ \r
 111 '*-------------------------------------------------------------------------*\r
 112 \r
 113 Class  TestScript\r
 114   Public  m_nPass  ' as integer\r
 115   Public  m_nSkip  ' as integer\r
 116   Public  m_nFail  ' as integer\r
 117   Public  m_Log    ' as Text File\r
 118   Public  m_DefLogFName  ' as string\r
 119   Public  m_ManualTests() ' as string\r
 120   Public  m_Debug  ' as boolean\r
 121   Public  m_Pass   ' as boolean\r
 122  \r
 123 '********************************************************************************\r
 124 '  <<< [TestScript::Class_Initialize] >>> \r
 125 '********************************************************************************\r
 126 Private Sub  Class_Initialize\r
 127   m_DefLogFName = "Test_logs.txt"\r
 128   m_Debug = g_Debug\r
 129   ReDim  m_ManualTests(-1)\r
 130 End Sub\r
 131 \r
 132 \r
 133  \r
 134 '********************************************************************************\r
 135 '  <<< [TestScript::Class_Terminate] >>> \r
 136 '********************************************************************************\r
 137 Private Sub  Class_Terminate\r
 138   If Not IsEmpty( m_Log ) Then  Finish\r
 139 End Sub\r
 140 \r
 141 \r
 142  \r
 143 '********************************************************************************\r
 144 '  <<< [TestScript::Start] >>> \r
 145 '********************************************************************************\r
 146 Public Sub  Start\r
 147   Dim  sub_test ' Boolean\r
 148 \r
 149   Set m_Log = g_fs.CreateTextFile( m_DefLogFName, True, False )\r
 150   ReDim  m_ManualTests(-1)\r
 151 \r
 152   sub_test = False\r
 153   If WScript.Arguments.Count >= 1 Then\r
 154     If WScript.Arguments(0) = "-sub_test" Then sub_test = True\r
 155   End If\r
 156 \r
 157   If Not sub_test Then  echo  "Test Start : " & g_fs.GetFileName( Wscript.ScriptFullName )\r
 158 \r
 159   m_nPass = 0\r
 160   m_nSkip = 0\r
 161   m_nFail = 0\r
 162 End Sub\r
 163 \r
 164 \r
 165  \r
 166 '********************************************************************************\r
 167 '  <<< [TestScript::Do_] >>> \r
 168 '********************************************************************************\r
 169 Public Sub  Do_( ByVal vbs_path, ByVal func, ByVal param )\r
 170   Dim  e,ed,es, DefLogFName\r
 171 \r
 172   If g_debug Then  Debug  vbs_path, func, param :  Exit Sub\r
 173 \r
 174   If IsEmpty( m_Log ) And func <> "test_current" Then\r
 175     DefLogFName = m_DefLogFName\r
 176     m_DefLogFName = g_fs.GetParentFolderName( vbs_path ) + "\" + DefLogFName\r
 177     Start\r
 178   End If\r
 179 \r
 180   If func <> "test_current" Then\r
 181     echo "=========================================================="\r
 182     If g_fs.GetFileName( g_fs.GetParentFolderName( vbs_path ) ) = "" Then\r
 183       echo "<<< [" & g_fs.GetFileName( vbs_path ) & "] - " & func & " >>>"\r
 184     Else\r
 185       echo "<<< [" & g_fs.GetFileName( g_fs.GetParentFolderName( vbs_path ) ) & "\" _\r
 186            & g_fs.GetFileName( vbs_path ) & "] - " & func & " >>>"\r
 187     End If\r
 188   End If\r
 189 \r
 190   On Error Resume Next\r
 191     call_vbs_t  vbs_path, func, param\r
 192     If Err.Number=0 And Not m_Pass Then  Err.Raise  Err_TestFail, "VBSLib TestScript", _\r
 193       "No result" + " - Runtime ERROR in the function of """ + func + """ in """ + _\r
 194       g_fs.GetFileName( vbs_path ) + """."\r
 195   e = Err.Number : ed = Err.Description : es = Err.Source : On Error GoTo 0 : If e <> 0 Then\r
 196     If e = Err_TestSkip Then\r
 197       m_nSkip = m_nSkip + 1\r
 198       echo "[Skip] " & ed\r
 199       echo " in """ & vbs_path & """"\r
 200     ElseIf e = Err_TestFail Then\r
 201       m_nFail = m_nFail + 1\r
 202       echo "[Fail] " & ed\r
 203       echo " in """ & vbs_path & """"\r
 204     Else\r
 205       m_nFail = m_nFail + 1\r
 206       If e >= 0 And e <= &h7fff Then  e = e + &h800A0000\r
 207       echo "[Fail] [Error] (" & Hex(e) & ") " & ed\r
 208       echo " in """ & vbs_path & """"\r
 209     End If\r
 210     e = Empty\r
 211   Else\r
 212     If func <> "test_current" Then\r
 213       m_nPass = m_nPass + 1\r
 214       echo "Pass."\r
 215     End If\r
 216   End If\r
 217 \r
 218   If Not IsEmpty( DefLogFName ) Then\r
 219     Finish\r
 220     m_DefLogFName = DefLogFName\r
 221   End If\r
 222 \r
 223 End Sub\r
 224 \r
 225 \r
 226  \r
 227 '********************************************************************************\r
 228 '  <<< [TestScript::Debug] >>> \r
 229 '********************************************************************************\r
 230 Public Sub  Debug( ByVal vbs_path, ByVal func, ByVal param )\r
 231   echo "=========================================================="\r
 232   echo "<<< [" & g_fs.GetFileName( g_fs.GetParentFolderName( vbs_path ) ) & "\" _\r
 233            & g_fs.GetFileName( vbs_path ) & "] - " & func & " >>>"\r
 234   echo "Debug Mode ..."\r
 235 \r
 236   m_Debug = True\r
 237   call_vbs_d  vbs_path, func, param\r
 238   m_Debug = False\r
 239 \r
 240   if m_Pass Then\r
 241     If func <> "test_current" Then\r
 242       m_nPass = m_nPass + 1\r
 243       echo "Pass."\r
 244     End If\r
 245   End If\r
 246 End Sub\r
 247 \r
 248 \r
 249  \r
 250 '********************************************************************************\r
 251 '  <<< [TestScript::AddManualTest] >>> \r
 252 '********************************************************************************\r
 253 Public Sub  AddManualTest( TestSymbol )\r
 254   ReDim Preserve  m_ManualTests( UBound( m_ManualTests ) + 1 )\r
 255   m_ManualTests( UBound( m_ManualTests ) ) = TestSymbol\r
 256 End Sub\r
 257 \r
 258 \r
 259  \r
 260 '********************************************************************************\r
 261 '  <<< [TestScript::Finish] >>> \r
 262 '********************************************************************************\r
 263 Public Sub  Finish\r
 264   Dim  TestSymbol, sub_test ' Boolean\r
 265 \r
 266   For Each TestSymbol In m_ManualTests\r
 267     echo  "[ManualTest] " + TestSymbol\r
 268   Next\r
 269 \r
 270   sub_test = False\r
 271   If WScript.Arguments.Count >= 1 Then\r
 272     If WScript.Arguments(0) = "-sub_test" Then sub_test = True\r
 273   End If\r
 274 \r
 275   If sub_test Then\r
 276     If m_nFail = 0 Then WScript.Quit 0  Else WScript.Quit 1  End If\r
 277   Else\r
 278     echo "=========================================================="\r
 279     echo "Test Finish (Pass=" & m_nPass & ", Manual=" & UBound(m_ManualTests)+1 & _\r
 280          ", Skip=" & m_nSkip & ", Fail=" & m_nFail & ")"\r
 281     echo ""\r
 282   End If\r
 283 \r
 284   m_Log = Empty\r
 285 End Sub\r
 286 \r
 287 \r
 288 \r
 289 \r
 290 \r
 291  \r
 292 End Class \r
 293  \r
 294 '*-------------------------------------------------------------------------*\r
 295 '* \81\9f<<<< [Tests] Class >>>> */ \r
 296 '*-------------------------------------------------------------------------*\r
 297 Class Tests\r
 298 \r
 299   Private  m_Sets  ' As Dictionary of UnitTest. key is UnitTest::Symbol\r
 300   Private  m_BaseFolderPath  ' as string. All Test ROOT\r
 301   Private  m_Prompt  ' as TestPrompt or Empty\r
 302   Private  m_CurrentSymbol  ' as string of current test symbol or ALL or ALL_R\r
 303   Private  m_CurrentSubSymbol  ' as string\r
 304   Private  m_CurrentTest   ' as UnitTest of m_CurrentSymbol\r
 305   Public   CurrentTestPriority   ' as integer  small is high priority\r
 306   Private  m_bAllTest  ' as boolean\r
 307   Private  m_AllFName  ' as string\r
 308   Private  m_Symbol  ' as string of doing test symbol\r
 309   Public   bTargetDebug  ' as boolean\r
 310   Public   c_ErrDblSymbol  ' as const number\r
 311 \r
 312   '----------------------------------\r
 313   Public Property Get  Sets : Set Sets = m_Sets : End Property\r
 314   Public Property Get  BaseFolderPath : BaseFolderPath = m_BaseFolderPath : End Property\r
 315   Public Property Let  BaseFolderPath( x ) : m_BaseFolderPath = x : End Property\r
 316   Public Property Set  Prompt( x ) : Set m_Prompt = x : End Property\r
 317   Public Property Get  Prompt : Set Prompt = m_Prompt : End Property\r
 318   Public Property Get  CurrentSymbol : CurrentSymbol = m_CurrentSymbol : End Property\r
 319   Public Property Get  CurrentTest : If IsObject(m_CurrentTest) Then Set CurrentTest = m_CurrentTest : Else CurrentTest = m_CurrentTest : End If : End Property\r
 320   Public Property Get  bAllTest : bAllTest = m_bAllTest : End Property\r
 321   Public Property Get  Symbol : Symbol = m_Symbol : End Property\r
 322  \r
 323 '********************************************************************************\r
 324 '  <<< [Tests::Class_Initialize] >>> \r
 325 '********************************************************************************\r
 326 Private  Sub  Class_Initialize\r
 327   Set m_Sets = CreateObject("Scripting.Dictionary")\r
 328   m_BaseFolderPath = g_fs.GetParentFolderName( WScript.ScriptFullName )\r
 329   m_CurrentSymbol = "ALL"\r
 330   m_AllFName = "T_ALL.vbs"\r
 331   m_bAllTest = False\r
 332   bTargetDebug = False\r
 333   c_ErrDblSymbol = 1010\r
 334 End Sub\r
 335 \r
 336  \r
 337 '********************************************************************************\r
 338 '  <<< [Tests::AddTestScriptAuto] >>> \r
 339 '********************************************************************************\r
 340 Public Function  AddTestScriptAuto( BasePath, FName )\r
 341   m_AllFName = FName\r
 342   AddTestScriptAuto_EnumSubFolders  g_fs.GetFolder( BasePath ), FName\r
 343 End Function\r
 344 \r
 345 \r
 346 Private Sub AddTestScriptAuto_EnumSubFolders( fo, FName )\r
 347   Dim  subfo\r
 348 \r
 349   If g_fs.FileExists( fo.Path + "\" + FName ) Then\r
 350     AddTestScript  g_fs.GetFileName( fo.Path ), fo.Path + "\" + FName\r
 351   End If\r
 352   For Each subfo in fo.SubFolders\r
 353     AddTestScriptAuto_EnumSubFolders subfo, FName\r
 354   Next\r
 355 End Sub\r
 356  \r
 357 '********************************************************************************\r
 358 '  <<< [Tests::AddTestScript] >>> \r
 359 '********************************************************************************\r
 360 Public Function  AddTestScript( Symbol, Path )\r
 361   Dim  test\r
 362 \r
 363   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
 364 \r
 365   Set test = New UnitTest\r
 366   test.Symbol = Symbol\r
 367   test.ScriptPath = g_fs.GetAbsolutePathName( Path )\r
 368   If m_Sets.Exists( test.Symbol ) Then _\r
 369     Err.Raise c_ErrDblSymbol,"class Tests", "[ERROR] Already defined the symbol '"+Symbol+"' in "+ _\r
 370     m_Sets.Item(Symbol).ScriptPath\r
 371   m_Sets.Add  test.Symbol, test\r
 372 \r
 373   Me.CurrentTestPriority = 1000\r
 374   If g_debug Then  call_vbs_d  Path, "test_current", Me _\r
 375   Else             call_vbs_t  Path, "test_current", Me\r
 376   test.Priority = Me.CurrentTestPriority\r
 377 \r
 378   Set AddTestScript = test\r
 379 End Function\r
 380 \r
 381  \r
 382 '********************************************************************************\r
 383 '  <<< [Tests::SetCurrentSymbol] >>> \r
 384 '********************************************************************************\r
 385 Public Function SetCurrentSymbol( Symbol_or_Path )\r
 386   Dim  key, item, b\r
 387 \r
 388   SetCurrentSymbol = 0\r
 389 \r
 390   '// ALL and ALL_R is special symbol\r
 391   If Symbol_or_Path = "ALL" or Symbol_or_Path = "ALL_R" Then  m_CurrentSymbol = Symbol_or_Path : _\r
 392     m_CurrentTest = Empty : Exit Function\r
 393 \r
 394   '// Search by test symbol\r
 395   For Each key in m_Sets.Keys()\r
 396     If key = Symbol_or_Path Then  m_CurrentSymbol = Symbol_or_Path : _\r
 397       Set m_CurrentTest = m_Sets.Item( m_CurrentSymbol ) : Exit Function\r
 398   Next\r
 399 \r
 400   '// Search by path\r
 401   For Each item in m_Sets.Items()\r
 402     If item.ScriptPath = Symbol_or_Path Then  m_CurrentSymbol = item.Symbol : _\r
 403       Set m_CurrentTest = m_Sets.Item( m_CurrentSymbol ) : Exit Function\r
 404   Next\r
 405 \r
 406   '// If Symbol is path, Add test symbol\r
 407   If g_fs.FileExists( Symbol_or_Path ) Then\r
 408     If UCase(g_fs.GetFileName( Symbol_or_Path )) = UCase(m_AllFName) Then _\r
 409       m_CurrentSymbol = g_fs.GetFileName( g_fs.GetParentFolderName( g_fs.GetAbsolutePathName(Symbol_or_Path) ) ) _\r
 410     Else  m_CurrentSymbol = g_fs.GetBaseName( Symbol_or_Path )\r
 411 \r
 412     b = True : If m_Sets.Exists( m_CurrentSymbol ) Then _\r
 413       b = ( m_Sets.Item( m_CurrentSymbol ).ScriptPath <> g_fs.GetAbsolutePathName( Symbol_or_Path ) )\r
 414     If b Then  'If Not m_Sets.Exists( m_CurrentSymbol ) or _\r
 415                '  m_Sets.Item( m_CurrentSymbol ).ScriptPath <> g_fs.GetAbsolutePathName( Symbol_or_Path ) Then\r
 416       AddTestScript  m_CurrentSymbol, Symbol_or_Path\r
 417     End If\r
 418     Set m_CurrentTest = m_Sets.Item( m_CurrentSymbol )\r
 419     Exit Function\r
 420   End If\r
 421 \r
 422   '// Error: Symbol\r
 423   echo "[ERROR] Not found symbol or path """ + Symbol_or_Path + """. CurrentDirectory = " & g_sh.CurrentDirectory\r
 424   SetCurrentSymbol = 1\r
 425 End Function\r
 426 \r
 427 \r
 428  \r
 429 '********************************************************************************\r
 430 '  <<< [Tests::DoTest] >>> \r
 431 '********************************************************************************\r
 432 Public Sub  DoTest( Func, bReverse )\r
 433   If m_CurrentSymbol = "ALL" Or m_CurrentSymbol = "ALL_R" Then\r
 434     Redim  utests(-1)\r
 435 \r
 436     If bReverse Then\r
 437       ShakerSort_fromDic  m_Sets, utests, -1, GetRef("CmpUnitTestPriorityDec"), Empty\r
 438     Else\r
 439       ShakerSort_fromDic  m_Sets, utests, +1, GetRef("CmpUnitTestPriorityInc"), Empty\r
 440     End If\r
 441 \r
 442     g_Test.m_DefLogFName = m_BaseFolderPath + "\" + g_fs.GetFileName( g_Test.m_DefLogFName )\r
 443     g_Test.Start\r
 444     For Each m_CurrentTest in utests\r
 445       TestCurrentSetup\r
 446       g_Test.Do_  m_CurrentTest.ScriptPath, "test_current", Me\r
 447       TestSetup\r
 448       g_Test.Do_  m_CurrentTest.ScriptPath, Func, Me\r
 449     Next\r
 450     g_Test.Finish\r
 451   Else\r
 452     g_Test.m_DefLogFName = g_fs.GetParentFolderName( m_CurrentTest.ScriptPath ) + "\" + g_fs.GetFileName( g_Test.m_DefLogFName )\r
 453     g_Test.Start\r
 454     Set m_CurrentTest = m_Sets.Item( m_CurrentSymbol )\r
 455     TestCurrentSetup\r
 456     g_Test.Do_  m_CurrentTest.ScriptPath, "test_current", Me\r
 457     TestSetup\r
 458     g_Test.Do_  m_CurrentTest.ScriptPath, Func, Me\r
 459     g_Test.Finish\r
 460   End If\r
 461 End Sub\r
 462 \r
 463  \r
 464 '********************************************************************************\r
 465 '  <<< [Tests::DebugTest] >>> \r
 466 '********************************************************************************\r
 467 Public Sub  DebugTest( Func, bReverse )\r
 468   If m_CurrentSymbol = "ALL" Or m_CurrentSymbol = "ALL_R" Then\r
 469     Dim  items(), i\r
 470 \r
 471     i = m_Sets.Count - 1\r
 472     ReDim Preserve items( i )\r
 473     If bReverse Then\r
 474       For Each m_CurrentTest in m_Sets.Items()\r
 475         Set items( i ) = m_CurrentTest\r
 476         i = i - 1\r
 477       Next\r
 478     Else\r
 479       i = 0\r
 480       For Each m_CurrentTest in m_Sets.Items()\r
 481         Set items( i ) = m_CurrentTest\r
 482         i = i + 1\r
 483       Next\r
 484     End If\r
 485 \r
 486     g_Test.m_DefLogFName = m_BaseFolderPath + "\" + g_fs.GetFileName( g_Test.m_DefLogFName )\r
 487     g_Test.Start\r
 488     For Each m_CurrentTest in items\r
 489       TestCurrentSetup\r
 490       g_Test.Debug  m_CurrentTest.ScriptPath, "test_current", Me\r
 491       TestSetup\r
 492       g_Test.Debug  m_CurrentTest.ScriptPath, Func, Me\r
 493     Next\r
 494     g_Test.Finish\r
 495   Else\r
 496     g_Test.m_DefLogFName = g_fs.GetParentFolderName( m_CurrentTest.ScriptPath ) + "\" + g_fs.GetFileName( g_Test.m_DefLogFName )\r
 497     g_Test.Start\r
 498     Set m_CurrentTest = m_Sets.Item( m_CurrentSymbol )\r
 499     TestCurrentSetup\r
 500     g_Test.Debug  m_CurrentTest.ScriptPath, "test_current", Me\r
 501     TestSetup\r
 502     g_Test.Debug  m_CurrentTest.ScriptPath, Func, Me\r
 503     g_Test.Finish\r
 504   End If\r
 505 End Sub\r
 506 \r
 507  \r
 508 '********************************************************************************\r
 509 '  <<< [Tests::DoAllTest] >>> \r
 510 '********************************************************************************\r
 511 Public Sub  DoAllTest()\r
 512   m_bAllTest = True\r
 513   If m_CurrentSymbol = "ALL" Or m_CurrentSymbol = "ALL_R" Then\r
 514     Redim  utests_inc(-1), utests_dec(-1)\r
 515 \r
 516     ShakerSort_fromDic  m_Sets, utests_inc, +1, GetRef("CmpUnitTestPriorityInc"), Empty\r
 517     ShakerSort_fromDic  m_Sets, utests_dec, -1, GetRef("CmpUnitTestPriorityDec"), Empty\r
 518 \r
 519     g_Test.m_DefLogFName = m_BaseFolderPath + "\" + g_fs.GetFileName( g_Test.m_DefLogFName )\r
 520     g_Test.Start\r
 521 \r
 522     For Each m_CurrentTest in utests_inc\r
 523       TestCurrentSetup\r
 524       g_Test.Do_  m_CurrentTest.ScriptPath, "test_current", Me\r
 525     Next\r
 526     For Each m_CurrentTest in utests_inc\r
 527       TestSetup\r
 528       g_Test.Do_  m_CurrentTest.ScriptPath, "test_build", Me\r
 529     Next\r
 530     For Each m_CurrentTest in utests_inc\r
 531       TestSetup\r
 532       g_Test.Do_  m_CurrentTest.ScriptPath, "test_setup", Me\r
 533     Next\r
 534     For Each m_CurrentTest in utests_dec\r
 535       TestSetup\r
 536       g_Test.Do_  m_CurrentTest.ScriptPath, "test_start", Me\r
 537     Next\r
 538     For Each m_CurrentTest in utests_dec\r
 539       TestSetup\r
 540       g_Test.Do_  m_CurrentTest.ScriptPath, "test_check", Me\r
 541     Next\r
 542     For Each m_CurrentTest in utests_dec\r
 543       TestSetup\r
 544       g_Test.Do_  m_CurrentTest.ScriptPath, "test_clean", Me\r
 545     Next\r
 546     g_Test.Finish\r
 547   Else\r
 548     Set m_CurrentTest = m_Sets.Item( m_CurrentSymbol )\r
 549     g_Test.m_DefLogFName = g_fs.GetParentFolderName( m_CurrentTest.ScriptPath ) + "\" + g_fs.GetFileName( g_Test.m_DefLogFName )\r
 550     g_Test.Start\r
 551     TestCurrentSetup\r
 552     g_Test.Do_  m_CurrentTest.ScriptPath, "test_current", Me\r
 553     TestSetup\r
 554     g_Test.Do_  m_CurrentTest.ScriptPath, "test_build", Me\r
 555     TestSetup\r
 556     g_Test.Do_  m_CurrentTest.ScriptPath, "test_setup", Me\r
 557     TestSetup\r
 558     g_Test.Do_  m_CurrentTest.ScriptPath, "test_start", Me\r
 559     TestSetup\r
 560     g_Test.Do_  m_CurrentTest.ScriptPath, "test_check", Me\r
 561     TestSetup\r
 562     g_Test.Do_  m_CurrentTest.ScriptPath, "test_clean", Me\r
 563     g_Test.Finish\r
 564   End If\r
 565   m_bAllTest = False\r
 566 End Sub\r
 567 \r
 568 \r
 569  \r
 570 '********************************************************************************\r
 571 '  <<< [Tests::TestCurrentSetup] >>> \r
 572 '********************************************************************************\r
 573 Private Sub  TestCurrentSetup()\r
 574   m_Symbol = m_CurrentTest.Symbol\r
 575   CurrentTestPriority = m_CurrentTest.Priority\r
 576   g_Test.m_Pass = True\r
 577 End Sub\r
 578 \r
 579  \r
 580 '********************************************************************************\r
 581 '  <<< [Tests::TestSetup] >>> \r
 582 '********************************************************************************\r
 583 Private Sub  TestSetup()\r
 584   m_Symbol = m_CurrentTest.Symbol\r
 585   g_Test.m_Pass = False\r
 586 End Sub\r
 587 \r
 588  \r
 589 '********************************************************************************\r
 590 '  <<< [Tests::SetCur] >>> \r
 591 '********************************************************************************\r
 592 Public Sub  SetCur( SubSymbol )\r
 593   m_CurrentSubSymbol = SubSymbol\r
 594 End Sub\r
 595 \r
 596  \r
 597 '********************************************************************************\r
 598 '  <<< [Tests::IsCur] >>> \r
 599 '********************************************************************************\r
 600 Public Function  IsCur( SubSymbol )\r
 601   If m_CurrentSubSymbol = "ALL" Or m_CurrentSubSymbol = "ALL_R" Or _\r
 602      m_CurrentSubSymbol = SubSymbol Then\r
 603     IsCur = True\r
 604   Else\r
 605     IsCur = False\r
 606   End IF\r
 607 End Function\r
 608 \r
 609  \r
 610 End Class \r
 611  \r
 612 '********************************************************************************\r
 613 '  <<< [CmpUnitTestPriorityInc] >>> \r
 614 '********************************************************************************\r
 615 Function  CmpUnitTestPriorityInc( left, right, param )\r
 616   CmpUnitTestPriorityInc = left.Priority - right.Priority\r
 617 End Function\r
 618  \r
 619 '********************************************************************************\r
 620 '  <<< [CmpUnitTestPriorityDec] >>> \r
 621 '********************************************************************************\r
 622 Function  CmpUnitTestPriorityDec( left, right, param )\r
 623   CmpUnitTestPriorityDec = right.Priority - left.Priority\r
 624 End Function\r
 625  \r
 626 '*-------------------------------------------------------------------------*\r
 627 '* \81\9f<<<< [UnitTest] Class >>>> */ \r
 628 '*-------------------------------------------------------------------------*\r
 629 Class UnitTest\r
 630 \r
 631   Public  Symbol     ' As String\r
 632   Public  ScriptPath ' As String\r
 633   Public  Priority   ' As Integer\r
 634 \r
 635   '----------------------------------\r
 636   Private  Sub  Class_Initialize\r
 637     Symbol = "NoSymbol"\r
 638     ScriptPath = ""\r
 639   End Sub\r
 640 \r
 641   Public  Function  Value\r
 642     Value = "[" & Symbol & "]" & vbCR & vbLF & " " & ScriptPath\r
 643   End Function\r
 644 \r
 645   Public Function  PathToAbs( BaseFolderPath )\r
 646     Dim  s\r
 647     PathToAbs = True\r
 648     s = g_fs.GetAbsolutePathName( BaseFolderPath & "\" & ScriptPath )\r
 649     If Not g_fs.FileExists( s ) Then  echo "[ERROR] Not found " + ScriptPath + ", Base=" + BaseFolderPath : PathToAbs = False\r
 650     ScriptPath = s\r
 651   End Function\r
 652 \r
 653 End Class\r
 654 \r
 655 \r
 656  \r
 657 '*-------------------------------------------------------------------------*\r
 658 '* \81\9f<<<< Test Result >>>> */ \r
 659 '*-------------------------------------------------------------------------*\r
 660 \r
 661  \r
 662 '********************************************************************************\r
 663 '  <<< [Pass] >>> \r
 664 '********************************************************************************\r
 665 Sub  Pass\r
 666   If IsEmpty( g_Test ) Then\r
 667     WScript.Quit  Err_TestPass\r
 668   ElseIf IsEmpty( g_Test.m_Log ) Then\r
 669     WScript.Echo  "Pass"\r
 670     WScript.Quit  Err_TestPass\r
 671   Else\r
 672     g_Test.m_Pass = True\r
 673   End If\r
 674 End Sub\r
 675 \r
 676 \r
 677 \r
 678  \r
 679 '********************************************************************************\r
 680 '  <<< [Fail] >>> \r
 681 '********************************************************************************\r
 682 Sub  Fail()\r
 683   If IsEmpty( g_Test ) Then\r
 684     WScript.Quit  Err_TestFail\r
 685   ElseIf IsEmpty( g_Test.m_Log ) Then\r
 686     WScript.Echo  "Fail"\r
 687     WScript.Quit  Err_TestFail\r
 688   Else\r
 689     Err.Raise  Err_TestFail, "VBSLib TestScript", "Fail the Test"\r
 690   End If\r
 691 End Sub\r
 692 \r
 693 \r
 694 \r
 695  \r
 696 '********************************************************************************\r
 697 '  <<< [Skip] >>> \r
 698 '********************************************************************************\r
 699 Sub  Skip()\r
 700   If IsEmpty( g_Test ) Then\r
 701     WScript.Quit  Err_TestSkip\r
 702   ElseIf IsEmpty( g_Test.m_Log ) Then\r
 703     WScript.Echo  "Skip"\r
 704     WScript.Quit  Err_TestSkip\r
 705   Else\r
 706     Err.Raise  Err_TestSkip, "VBSLib TestScript", "Skip the Test"\r
 707   End If\r
 708 End Sub\r
 709 \r
 710 \r
 711 \r
 712  \r
 713 '********************************************************************************\r
 714 '  <<< [ManualTest] >>> \r
 715 '********************************************************************************\r
 716 Sub  ManualTest( TestSymbol )\r
 717   echo  "<<< ["+TestSymbol+"] >>>"\r
 718   echo  "This is ManualTest."\r
 719   g_Test.AddManualTest  TestSymbol\r
 720 End Sub\r
 721 \r
 722  \r
 723 '*-------------------------------------------------------------------------*\r
 724 '* \81\9f<<<< Tools for Test Program >>>> */ \r
 725 '*-------------------------------------------------------------------------*\r
 726 \r
 727  \r
 728 '********************************************************************************\r
 729 '  <<< [EchoTestStart] >>> \r
 730 '********************************************************************************\r
 731 Sub  EchoTestStart( TestSymbol )\r
 732   echo  "<<< ["+TestSymbol+"] >>>"\r
 733 End Sub\r
 734 \r
 735 \r
 736  \r
 737 '********************************************************************************\r
 738 '  <<< [echo] >>> \r
 739 ' return: output message\r
 740 '********************************************************************************\r
 741 Function  echo( ByVal msg )\r
 742   If IsObject( msg ) Then  msg = msg.Value\r
 743 \r
 744   WScript.Echo  msg\r
 745   If Not IsEmpty( g_Test.m_Log ) Then  g_Test.m_Log.WriteLine  msg\r
 746   echo = msg\r
 747 End Function\r
 748 \r
 749 \r
 750  \r
 751 '********************************************************************************\r
 752 '  <<< [CheckTestErrLevel] >>> \r
 753 '********************************************************************************\r
 754 Sub  CheckTestErrLevel( r )\r
 755   If r = Err_TestSkip Then\r
 756     Skip\r
 757   ElseIf r <> Err_TestPass Then\r
 758     Fail\r
 759   End If\r
 760 End Sub\r
 761 \r
 762 \r
 763  \r
 764 '********************************************************************************\r
 765 '  <<< [ConvertToAbsPath] >>> \r
 766 '********************************************************************************\r
 767 Sub  ConvertToAbsPath( SrcPath, DstPath )\r
 768   Dim  src, dst, dst_parent, line, p1, p2, path\r
 769 \r
 770   Set  src = g_fs.OpenTextFile( SrcPath )\r
 771   mkdir  g_fs.GetParentFolderName( g_fs.GetAbsolutePathName( DstPath ) )\r
 772   Set  dst = g_fs.CreateTextFile( DstPath, True, False )\r
 773 \r
 774   Do Until src.AtEndOfStream\r
 775     line = src.ReadLine\r
 776     Do\r
 777       p1 = InStr( line, "%AbsPath(" )\r
 778       If p1 = 0 Then Exit Do\r
 779       p2 = InStr( p1 + 9, line, ")%" )\r
 780       path = Mid( line, p1+9, p2-p1-9 )\r
 781       path = GetAbsPath( path, g_fs.GetParentFolderName( g_fs.GetAbsolutePathName( SrcPath ) ) )\r
 782       line = Left( line, p1 - 1 ) + path + Mid( line, p2 + 2 )\r
 783     Loop\r
 784     line = Replace( line, "%DesktopPath%", g_sh.SpecialFolders("Desktop") )\r
 785     dst.WriteLine  line\r
 786   Loop\r
 787 DstPath = "a"\r
 788   src = Empty\r
 789   dst = Empty\r
 790 End Sub\r
 791 \r
 792  \r