tcstrutils.pp 5.2 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266
  1. unit tcstrutils;
  2. {$mode objfpc}{$H+}
  3. interface
  4. uses
  5. Classes, SysUtils, fpcunit, testregistry, strutils;
  6. type
  7. { TTestSearchBuf }
  8. TTestSearchBuf= class(TTestCase)
  9. Private
  10. Procedure TestSearch(Sub:String; Start : Integer; O : TStringSearchOptions; Expected : Integer);
  11. published
  12. procedure TestSimple;
  13. procedure TestSimpleNoRes;
  14. procedure TestSimpleDown;
  15. procedure TestSimpleDownNoRes;
  16. procedure TestNotExistDown;
  17. procedure TestNotExist;
  18. procedure TestSimpleDownPos;
  19. procedure TestSimplePos;
  20. procedure TestSimpleCaseSensitive;
  21. procedure TestSimpleCaseSensitiveDown;
  22. procedure TestSimpleWholeWord;
  23. procedure TestSimpleWholeWordDown;
  24. procedure TestSimplePartialend;
  25. procedure TestSimplePartialStart;
  26. procedure TestEndMatchDown;
  27. procedure TestEndMatch;
  28. procedure TestWholeWordAtStart;
  29. procedure TestWholeWordAtStartDown;
  30. procedure TestWholeWordAtEnd;
  31. procedure TestWholeWordAtEndDown;
  32. procedure TestEmptySearchString;
  33. procedure TestSelstartBeforeBuf;
  34. procedure testSelstartAfterBuf;
  35. Procedure TestDecodeSoundexInt;
  36. end;
  37. implementation
  38. Const
  39. // Don't move this comment, it indicates the positions.
  40. // 1 2 3 4
  41. // 1234567890123456789012345678901234567890123456789
  42. S = 'Some very long string with some words in it';
  43. SLen = Length(S);
  44. {$define usenew}
  45. {$ifdef usenew}
  46. {$i searchbuf.inc}
  47. const
  48. WhichSearchbuf = 'new';
  49. {$else}
  50. const
  51. WhichSearchbuf = 'old';
  52. {$endif}
  53. procedure TTestSearchBuf.TestSearch(Sub: String; Start: Integer;
  54. O: TStringSearchOptions; Expected: Integer);
  55. Var
  56. P,PR : PChar;
  57. I : Integer;
  58. begin
  59. P:=PChar(S);
  60. PR:=SearchBuf(P,Length(S),Start,0,Sub,O);
  61. If (PR=Nil) then
  62. begin
  63. If (Expected<>-1) then
  64. Fail(Format('Search for "%s" failed, expected result at %d',[Sub,Expected]));
  65. end
  66. else
  67. begin
  68. I:=(PR-P)+1;
  69. If (I<>Expected) then
  70. Fail(Format('Wrong result for search for "%s", expected result at %d, got %d',[Sub,Expected,I]));
  71. end;
  72. end;
  73. procedure TTestSearchBuf.TestSimpleNoRes;
  74. begin
  75. TestSearch('very',0,[],-1);
  76. end;
  77. procedure TTestSearchBuf.TestSimple;
  78. begin
  79. TestSearch('very',SLen,[],6);
  80. end;
  81. procedure TTestSearchBuf.TestSimpleDownNoRes;
  82. begin
  83. TestSearch('very',0,[soDown],6);
  84. end;
  85. procedure TTestSearchBuf.TestSimpleDown;
  86. begin
  87. TestSearch('very',SLen,[soDown],-1);
  88. end;
  89. procedure TTestSearchBuf.TestSimplePartialend;
  90. begin
  91. TestSearch('its',0,[soDown],-1);
  92. end;
  93. procedure TTestSearchBuf.TestSimplePartialStart;
  94. begin
  95. TestSearch('Tso',SLen,[],-1);
  96. end;
  97. procedure TTestSearchBuf.TestEndMatchDown;
  98. begin
  99. TestSearch('it',30,[soDown],42);
  100. end;
  101. procedure TTestSearchBuf.TestEndMatch;
  102. begin
  103. TestSearch('it',SLen,[],42);
  104. end;
  105. procedure TTestSearchBuf.TestWholeWordAtStart;
  106. begin
  107. TestSearch('Some',20,[soWholeWord],1);
  108. end;
  109. procedure TTestSearchBuf.TestWholeWordAtStartDown;
  110. begin
  111. TestSearch('Some',0,[soDown,soWholeWord],1);
  112. end;
  113. procedure TTestSearchBuf.TestWholeWordAtEnd;
  114. begin
  115. TestSearch('it',SLen,[soWholeWord],42);
  116. end;
  117. procedure TTestSearchBuf.TestWholeWordAtEndDown;
  118. begin
  119. TestSearch('it',30,[soDown,soWholeWord],42);
  120. end;
  121. procedure TTestSearchBuf.TestEmptySearchString;
  122. begin
  123. TestSearch('',30,[],-1);
  124. end;
  125. procedure TTestSearchBuf.TestSelstartBeforeBuf;
  126. begin
  127. TestSearch('very',-5,[soDown],-1);
  128. end;
  129. procedure TTestSearchBuf.testSelstartAfterBuf;
  130. begin
  131. TestSearch('very',100,[],-1);
  132. end;
  133. procedure TTestSearchBuf.TestDecodeSoundexInt;
  134. Const
  135. OrdA = Ord('A');
  136. Ord0 = Ord('0');
  137. Function CreateInt (Const S : String) : Integer;
  138. var
  139. I, Len : Integer;
  140. begin
  141. Result:=-1;
  142. Len:=Length(S);
  143. If Len>0 then
  144. begin
  145. Result:=Ord(S[1])-OrdA;
  146. if Len > 1 then
  147. begin
  148. Result:=Result*26+(Ord(S[2])-Ord0);
  149. for I:=3 to Len do
  150. Result:=(Ord(S[I])-Ord0)+Result*7;
  151. end;
  152. Result:=Len+Result*9;
  153. end;
  154. end;
  155. Procedure TestOneShot(S : String);
  156. Var
  157. R : String;
  158. begin
  159. R:=DecodeSoundexInt(CreateInt(S));
  160. AssertEquals('Decoded Soundexint equals original soundex result:',S,R);
  161. end;
  162. Var
  163. C,J,K : Integer;
  164. S : String;
  165. begin
  166. For C:=Ord('A') to Ord('Z') do
  167. begin
  168. S:=Char(C);
  169. TestOneShot(S);
  170. for J:=1 to 6 do
  171. begin
  172. S:=Char(C);
  173. For K:=1 to 6 do
  174. begin
  175. S:=S+Char(Ord('0')+k);
  176. TestOneShot(S);
  177. end;
  178. end;
  179. end;
  180. end;
  181. procedure TTestSearchBuf.TestSimpleDownPos;
  182. begin
  183. TestSearch('it',30,[soDown],42);
  184. end;
  185. procedure TTestSearchBuf.TestSimplePos;
  186. begin
  187. TestSearch('it',30,[],24);
  188. end;
  189. procedure TTestSearchBuf.TestNotExist;
  190. begin
  191. TestSearch('quid',SLen,[],-1);
  192. end;
  193. procedure TTestSearchBuf.TestNotExistDown;
  194. begin
  195. TestSearch('quid',0,[soDown],-1);
  196. end;
  197. procedure TTestSearchBuf.TestSimpleCaseSensitive;
  198. begin
  199. TestSearch('Very',SLen,[soMatchCase],-1);
  200. end;
  201. procedure TTestSearchBuf.TestSimpleCaseSensitiveDown;
  202. begin
  203. TestSearch('Very',0,[soMatchCase,soDown],-1);
  204. end;
  205. procedure TTestSearchBuf.TestSimpleWholeWord;
  206. begin
  207. TestSearch('in',SLen,[soWholeWord],39);
  208. end;
  209. procedure TTestSearchBuf.TestSimpleWholeWordDown;
  210. begin
  211. TestSearch('in',0,[soWholeWord,soDown],39);
  212. end;
  213. initialization
  214. RegisterTest(TTestSearchBuf);
  215. writeln ('Testing with ', WhichSearchbuf, ' implementation');
  216. writeln;
  217. end.