fpc/tests/test/units/fpcunit/tcstrutils.pp

unit tcstrutils;

{$mode objfpc}{$H+}
{$codepage utf8}

interface

uses
  Classes, SysUtils, fpcunit, testregistry, strutils;

type

  TTestSearchBuf= class(TTestCase)
  Private
    Procedure TestSearch(Sub:String; Start : Integer; O : TStringSearchOptions; Expected : Integer);
  published
    procedure TestSimple;
    procedure TestSimpleNoRes;
    procedure TestSimpleDown;
    procedure TestSimpleDownNoRes;
    procedure TestNotExistDown;
    procedure TestNotExist;
    procedure TestSimpleDownPos;
    procedure TestSimplePos;
    procedure TestSimpleCaseSensitive;
    procedure TestSimpleCaseSensitiveDown;
    procedure TestSimpleWholeWord;
    procedure TestSimpleWholeWordDown;
    procedure TestSimplePartialend;
    procedure TestSimplePartialStart;
    procedure TestEndMatchDown;
    procedure TestEndMatch;
    procedure TestWholeWordAtStart;
    procedure TestWholeWordAtStartDown;
    procedure TestWholeWordAtEnd;
    procedure TestWholeWordAtEndDown;
    procedure TestEmptySearchString;
    procedure TestSelstartBeforeBuf;
    procedure testSelstartAfterBuf;
    Procedure TestDecodeSoundexInt;
  end;


  TTestGeneral = class(TTestCase)
  published
    procedure TestIndexStr;
    procedure TestMatchStr;
  end;


implementation

Const
   // Don't move this comment, it indicates the positions.
   //           1         2         3         4
   //  1234567890123456789012345678901234567890123456789
  S = 'Some very long string with some words in it';
  SLen = Length(S);
  
{$define usenew}
{$ifdef usenew}
{$i searchbuf.inc}
const
  WhichSearchbuf = 'new';
{$else}
const
  WhichSearchbuf = 'old';
{$endif}

procedure TTestSearchBuf.TestSearch(Sub: String; Start: Integer;
  O: TStringSearchOptions; Expected: Integer);

Var
  P,PR : PChar;
  I : Integer;
  
begin
  P:=PChar(S);
  PR:=SearchBuf(P,Length(S),Start,0,Sub,O);
  If (PR=Nil) then
    begin
    If (Expected<>-1) then
      Fail(Format('Search for "%s" failed, expected result at %d',[Sub,Expected]));
    end
  else
    begin
    I:=(PR-P)+1;
    If (I<>Expected) then
      Fail(Format('Wrong result for search for "%s", expected result at %d, got %d',[Sub,Expected,I]));
    end;
end;

procedure TTestSearchBuf.TestSimpleNoRes;
begin
  TestSearch('very',0,[],-1);
end;

procedure TTestSearchBuf.TestSimple;
begin
  TestSearch('very',SLen,[],6);
end;

procedure TTestSearchBuf.TestSimpleDownNoRes;
begin
  TestSearch('very',0,[soDown],6);
end;

procedure TTestSearchBuf.TestSimpleDown;
begin
  TestSearch('very',SLen,[soDown],-1);
end;

procedure TTestSearchBuf.TestSimplePartialend;
begin
  TestSearch('its',0,[soDown],-1);
end;

procedure TTestSearchBuf.TestSimplePartialStart;
begin
  TestSearch('Tso',SLen,[],-1);
end;

procedure TTestSearchBuf.TestEndMatchDown;
begin
  TestSearch('it',30,[soDown],42);
end;

procedure TTestSearchBuf.TestEndMatch;
begin
  TestSearch('it',SLen,[],42);
end;

procedure TTestSearchBuf.TestWholeWordAtStart;
begin
  TestSearch('Some',20,[soWholeWord],1);
end;

procedure TTestSearchBuf.TestWholeWordAtStartDown;
begin
  TestSearch('Some',0,[soDown,soWholeWord],1);
end;

procedure TTestSearchBuf.TestWholeWordAtEnd;
begin
  TestSearch('it',SLen,[soWholeWord],42);
end;

procedure TTestSearchBuf.TestWholeWordAtEndDown;
begin
  TestSearch('it',30,[soDown,soWholeWord],42);
end;

procedure TTestSearchBuf.TestEmptySearchString;
begin
  TestSearch('',30,[],-1);
end;

procedure TTestSearchBuf.TestSelstartBeforeBuf;
begin
  TestSearch('very',-5,[soDown],-1);
end;

procedure TTestSearchBuf.testSelstartAfterBuf;
begin
  TestSearch('very',100,[],-1);
end;

procedure TTestSearchBuf.TestDecodeSoundexInt;

Const
  OrdA = Ord('A');
  Ord0 = Ord('0');

  Function CreateInt (Const S : String) : Integer;

  var
    I, Len : Integer;

  begin
    Result:=-1;
    Len:=Length(S);
    If Len>0 then
      begin
      Result:=Ord(S[1])-OrdA;
      if Len > 1 then
        begin
        Result:=Result*26+(Ord(S[2])-Ord0);
        for I:=3 to Len do
          Result:=(Ord(S[I])-Ord0)+Result*7;
        end;
      Result:=Len+Result*9;
      end;
  end;


  Procedure TestOneShot(S : String);

  Var
    R : String;

  begin
    R:=DecodeSoundexInt(CreateInt(S));
    AssertEquals('Decoded Soundexint equals original soundex result:',S,R);
  end;

Var
  C,J,K : Integer;
  S : String;

begin
  For C:=Ord('A') to Ord('Z') do
    begin
    S:=Char(C);
    TestOneShot(S);
    for J:=1 to 6 do
      begin
      S:=Char(C);
      For K:=1 to 6 do
        begin
        S:=S+Char(Ord('0')+k);
        TestOneShot(S);
        end;
      end;
    end;

end;

procedure TTestSearchBuf.TestSimpleDownPos;
begin
  TestSearch('it',30,[soDown],42);
end;

procedure TTestSearchBuf.TestSimplePos;
begin
  TestSearch('it',30,[],24);
end;

procedure TTestSearchBuf.TestNotExist;
begin
  TestSearch('quid',SLen,[],-1);
end;

procedure TTestSearchBuf.TestNotExistDown;
begin
  TestSearch('quid',0,[soDown],-1);
end;

procedure TTestSearchBuf.TestSimpleCaseSensitive;
begin
  TestSearch('Very',SLen,[soMatchCase],-1);
end;

procedure TTestSearchBuf.TestSimpleCaseSensitiveDown;
begin
  TestSearch('Very',0,[soMatchCase,soDown],-1);
end;

procedure TTestSearchBuf.TestSimpleWholeWord;
begin
  TestSearch('in',SLen,[soWholeWord],39);
end;

procedure TTestSearchBuf.TestSimpleWholeWordDown;
begin
  TestSearch('in',0,[soWholeWord,soDown],39);
end;

procedure TTestGeneral.TestIndexStr;
var
  s: UnicodeString;
  a: array of UnicodeString;
begin
  s := 'Henry';
  AssertTrue('Failed on 1', IndexStr(s, ['Brian', 'Jim', 'Henry']) = 2);
  AssertTrue('Failed on 2', IndexStr(s, ['Brian', 'Jim', 'henry']) = -1);
  AssertTrue('Failed on 3', IndexStr(s, ['BRIAN', 'JIM', 'HENRY']) = -1);
  s := 'HENRY';
  AssertTrue('Failed on 4', IndexStr(s, ['BRIAN', 'HENRY', 'JIM']) = 1);

  SetLength(a, 3);
  a[0] := 'Brian';
  a[1] := 'Jim';
  a[2] := 'Henry';
  AssertTrue('Failed on 5', IndexStr(s, a) = -1);
  s := 'Henry';
  AssertTrue('Failed on 6', IndexStr(s, a) = 2);
  a[2] := 'henry';
  AssertTrue('Failed on 7', IndexStr(s, a) = -1);
end;

procedure TTestGeneral.TestMatchStr;
var
  s: UnicodeString;
  a: array of UnicodeString;
begin
  s := 'Henry';
  AssertEquals('Failed on 1', True, MatchStr(s, ['Brian', 'Jim', 'Henry']));
  AssertEquals('Failed on 2', False, MatchStr(s, ['Brian', 'Jim', 'henry']));
  AssertEquals('Failed on 3', False, MatchStr(s, ['BRIAN', 'JIM', 'HENRY']));
  s := 'HENRY';
  AssertEquals('Failed on 4', True, MatchStr(s, ['BRIAN', 'HENRY', 'JIM']));

  SetLength(a, 3);
  a[0] := 'Brian';
  a[1] := 'Jim';
  a[2] := 'Henry';
  AssertEquals('Failed on 5', False, MatchStr(s, a));
  s := 'Henry';
  AssertEquals('Failed on 6', True, MatchStr(s, a));
  a[2] := 'henry';
  AssertEquals('Failed on 7', False, MatchStr(s, a));
end;


initialization
  RegisterTest(TTestSearchBuf);
  RegisterTest(TTestGeneral);
  writeln ('Testing with ', WhichSearchbuf, ' implementation');
  writeln;
end.