tcstrutils.pp 4.2 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205
  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. end;
  36. implementation
  37. Const
  38. // Don't move this comment, it indicates the positions.
  39. // 1 2 3 4
  40. // 1234567890123456789012345678901234567890123456789
  41. S = 'Some very long string with some words in it';
  42. SLen = Length(S);
  43. {$define usenew}
  44. {$ifdef usenew}
  45. {$i searchbuf.inc}
  46. const
  47. WhichSearchbuf = 'new';
  48. {$else}
  49. const
  50. WhichSearchbuf = 'old';
  51. {$endif}
  52. procedure TTestSearchBuf.TestSearch(Sub: String; Start: Integer;
  53. O: TStringSearchOptions; Expected: Integer);
  54. Var
  55. P,PR : PChar;
  56. I : Integer;
  57. begin
  58. P:=PChar(S);
  59. PR:=SearchBuf(P,Length(S),Start,0,Sub,O);
  60. If (PR=Nil) then
  61. begin
  62. If (Expected<>-1) then
  63. Fail(Format('Search for "%s" failed, expected result at %d',[Sub,Expected]));
  64. end
  65. else
  66. begin
  67. I:=(PR-P)+1;
  68. If (I<>Expected) then
  69. Fail(Format('Wrong result for search for "%s", expected result at %d, got %d',[Sub,Expected,I]));
  70. end;
  71. end;
  72. procedure TTestSearchBuf.TestSimpleNoRes;
  73. begin
  74. TestSearch('very',0,[],-1);
  75. end;
  76. procedure TTestSearchBuf.TestSimple;
  77. begin
  78. TestSearch('very',SLen,[],6);
  79. end;
  80. procedure TTestSearchBuf.TestSimpleDownNoRes;
  81. begin
  82. TestSearch('very',0,[soDown],6);
  83. end;
  84. procedure TTestSearchBuf.TestSimpleDown;
  85. begin
  86. TestSearch('very',SLen,[soDown],-1);
  87. end;
  88. procedure TTestSearchBuf.TestSimplePartialend;
  89. begin
  90. TestSearch('its',0,[soDown],-1);
  91. end;
  92. procedure TTestSearchBuf.TestSimplePartialStart;
  93. begin
  94. TestSearch('Tso',SLen,[],-1);
  95. end;
  96. procedure TTestSearchBuf.TestEndMatchDown;
  97. begin
  98. TestSearch('it',30,[soDown],42);
  99. end;
  100. procedure TTestSearchBuf.TestEndMatch;
  101. begin
  102. TestSearch('it',SLen,[],42);
  103. end;
  104. procedure TTestSearchBuf.TestWholeWordAtStart;
  105. begin
  106. TestSearch('Some',20,[soWholeWord],1);
  107. end;
  108. procedure TTestSearchBuf.TestWholeWordAtStartDown;
  109. begin
  110. TestSearch('Some',0,[soDown,soWholeWord],1);
  111. end;
  112. procedure TTestSearchBuf.TestWholeWordAtEnd;
  113. begin
  114. TestSearch('it',SLen,[soWholeWord],42);
  115. end;
  116. procedure TTestSearchBuf.TestWholeWordAtEndDown;
  117. begin
  118. TestSearch('it',30,[soDown,soWholeWord],42);
  119. end;
  120. procedure TTestSearchBuf.TestEmptySearchString;
  121. begin
  122. TestSearch('',30,[],-1);
  123. end;
  124. procedure TTestSearchBuf.TestSelstartBeforeBuf;
  125. begin
  126. TestSearch('very',-5,[soDown],-1);
  127. end;
  128. procedure TTestSearchBuf.testSelstartAfterBuf;
  129. begin
  130. TestSearch('very',100,[],-1);
  131. end;
  132. procedure TTestSearchBuf.TestSimpleDownPos;
  133. begin
  134. TestSearch('it',30,[soDown],42);
  135. end;
  136. procedure TTestSearchBuf.TestSimplePos;
  137. begin
  138. TestSearch('it',30,[],24);
  139. end;
  140. procedure TTestSearchBuf.TestNotExist;
  141. begin
  142. TestSearch('quid',SLen,[],-1);
  143. end;
  144. procedure TTestSearchBuf.TestNotExistDown;
  145. begin
  146. TestSearch('quid',0,[soDown],-1);
  147. end;
  148. procedure TTestSearchBuf.TestSimpleCaseSensitive;
  149. begin
  150. TestSearch('Very',SLen,[soMatchCase],-1);
  151. end;
  152. procedure TTestSearchBuf.TestSimpleCaseSensitiveDown;
  153. begin
  154. TestSearch('Very',0,[soMatchCase,soDown],-1);
  155. end;
  156. procedure TTestSearchBuf.TestSimpleWholeWord;
  157. begin
  158. TestSearch('in',SLen,[soWholeWord],39);
  159. end;
  160. procedure TTestSearchBuf.TestSimpleWholeWordDown;
  161. begin
  162. TestSearch('in',0,[soWholeWord,soDown],39);
  163. end;
  164. initialization
  165. RegisterTest(TTestSearchBuf);
  166. writeln ('Testing with ', WhichSearchbuf, ' implementation');
  167. writeln;
  168. end.