_src/Test/vbslib_test/T_Sort/T_QSort/T_QSort.vbs

   1 Option Explicit \r
   2 '--- start of vbslib include ------------------------------------------------------\r
   3 Dim  g_debug, g_vbslib_path, g_IncludeType, g_CommandPrompt, g_fs, g_sh\r
   4 If IsEmpty( g_fs ) Then\r
   5   '--- start of parameters for vbslib include -------------------------------\r
   6   g_debug = 0\r
   7   g_vbslib_path = "vbslib\vbs_inc.vbs"\r
   8   g_IncludeType = ""\r
   9   g_CommandPrompt = 2\r
  10   '--- end of parameters for vbslib include ---------------------------------\r
  11   Dim  g_f, g_include_path, i : Set  g_fs = CreateObject( "Scripting.FileSystemObject" )\r
  12   If g_fs.FileExists("setting.vbs") Then  Set g_f = g_fs.OpenTextFile( "setting.vbs" ): Execute g_f.ReadAll()\r
  13   If not IsEmpty( WScript.Arguments.Named.Item("IncludeType") ) Then  g_IncludeType = WScript.Arguments.Named.Item("IncludeType")\r
  14   Set  g_sh = WScript.CreateObject("WScript.Shell") : g_f = g_sh.CurrentDirectory\r
  15   g_sh.CurrentDirectory = g_fs.GetParentFolderName( WScript.ScriptFullName )\r
  16   For i = 10 To 1 Step -1 : If g_fs.FileExists(g_vbslib_path) Then  Exit For\r
  17   g_vbslib_path = "..\" + g_vbslib_path  : Next\r
  18   If g_fs.FileExists(g_vbslib_path) Then  g_vbslib_path = g_fs.GetAbsolutePathName( g_vbslib_path )\r
  19   g_sh.CurrentDirectory = g_f\r
  20   If i=0 Then WScript.Echo "Not found " + g_fs.GetFileName( g_vbslib_path ) +vbCR+vbLF+ "Check g_vbslib_path in " + WScript.ScriptName + " or setting.vbs" : WScript.Quit 1\r
  21   Set g_f = g_fs.OpenTextFile( g_vbslib_path ): Execute g_f.ReadAll() : g_f = Empty\r
  22   If ResumePush Then  On Error Resume Next\r
  23     main\r
  24   ResumePop : On Error GoTo 0\r
  25 End If\r
  26 '--- end of vbslib include --------------------------------------------------------\r
  27 \r
  28 \r
  29 '********************************************************************************\r
  30 '  <<< [ClassA] >>>\r
  31 '********************************************************************************\r
  32 Class  ClassA : Public id : End Class\r
  33 \r
  34 \r
  35 '********************************************************************************\r
  36 '  <<< [main] >>>\r
  37 '********************************************************************************\r
  38 Sub main()\r
  39   Dim  TestName, TestParamPath, f\r
  40 \r
  41 \r
  42   '//=== Get test parameters from command line\r
  43   TestName = WScript.Arguments.Named.Item("Test")\r
  44   If IsEmpty( TestName ) Then  TestName = "T_QSort1"\r
  45 \r
  46 \r
  47   '//=== Do T_QSort1 test :  Return Pass by errorlevel\r
  48   If TestName = "T_QSort1" Then\r
  49     EchoTestStart  "T_QSort1"\r
  50 \r
  51     Redim  arr(8)\r
  52     Set arr(0) = new ClassA : arr(0).id = 1000\r
  53     Set arr(1) = new ClassA : arr(1).id = 500\r
  54     Set arr(2) = new ClassA : arr(2).id = 1000\r
  55     Set arr(3) = new ClassA : arr(3).id = 1000\r
  56     Set arr(4) = new ClassA : arr(4).id = 1000\r
  57     Set arr(5) = new ClassA : arr(5).id = 1000\r
  58     Set arr(6) = new ClassA : arr(6).id = 1000\r
  59     Set arr(7) = new ClassA : arr(7).id = 1000\r
  60     Set arr(8) = new ClassA : arr(8).id = 1000\r
  61 \r
  62     QuickSort  arr, 0, 8, GetRef("CmpFunc1"), Empty\r
  63     CheckSorted  arr, 0, 8\r
  64 \r
  65     Redim  arr(5)\r
  66     Set arr(1) = new ClassA : arr(1).id = 6\r
  67     Set arr(2) = new ClassA : arr(2).id = 3\r
  68     Set arr(3) = new ClassA : arr(3).id = 4\r
  69     Set arr(4) = new ClassA : arr(4).id = 4\r
  70     Set arr(5) = new ClassA : arr(5).id = 1\r
  71     QuickSort  arr, 1, 5, GetRef("CmpFunc1"), Empty\r
  72     CheckSorted  arr, 1, 5\r
  73 \r
  74     Redim  arr(2)\r
  75     Set arr(0) = new ClassA : arr(0).id = 1\r
  76     Set arr(1) = new ClassA : arr(1).id = 2\r
  77     Set arr(2) = new ClassA : arr(2).id = 3\r
  78 Stop\r
  79     QuickSort  arr, 0, 2, GetRef("CmpFunc1"), Empty\r
  80     CheckSorted  arr, 0, 2\r
  81 \r
  82     Sleep  1500\r
  83     Pass\r
  84   Else\r
  85     Fail\r
  86   End If\r
  87 End Sub\r
  88 \r
  89 \r
  90 '********************************************************************************\r
  91 '  <<< [CmpFunc1] >>>\r
  92 '********************************************************************************\r
  93 Function  CmpFunc1( left, right, param )\r
  94   CmpFunc1 = left.id - right.id    '// \8d~\8f\87\82È\82ç right.id - left.id\r
  95 End Function\r
  96 \r
  97 \r
  98 '********************************************************************************\r
  99 '  <<< [CheckSorted] >>>\r
 100 '********************************************************************************\r
 101 Sub  CheckSorted( Arr, iStart, iLast )\r
 102   Dim  i, key, s, b\r
 103 \r
 104   echo  "CheckSorted"\r
 105   key = Arr(iStart).id : b = False\r
 106   For i=iStart To iLast\r
 107     s="" : If Arr(i).id < key Then  s = " (Fail)" : b = True\r
 108     echo  "("&i&") " & Arr(i).id & s\r
 109     key = Arr(i).id\r
 110   Next\r
 111 \r
 112   If b Then  Sleep 1000 : Fail\r
 113 End Sub\r
 114 \r
 115 \r
 116  \r