123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293294295296297298299300301302303304305306307308309310311312313314315316317318319320321322323324325326327328329330331332333334335336337338339340341342343344345346347348349350351352353354355356357358359360361362363364365366367368369370371372373374375376377378379380381382383384385386387388389390391392393394395396397398399400401402403404405406407408409410411412413414415416417418419420421422423424425426427428429430431432433434435436437438439440441442443 |
- { %norun }
- unit tcregexp;
- {$mode objfpc}{$H+}
- { $DEFINE DUMPTESTS} //define this to dump a
- interface
- uses
- Classes, SysUtils, fpcunit, testregistry, regexpr;
- type
- { TTestRegexpr }
- TTestRegexpr= class(TTestCase)
- private
- FRE: TRegExpr;
- protected
- class function PrintableString(AString: string): string;
- Procedure RunRETest(aIndex : Integer);
- procedure SetUp; override;
- procedure TearDown; override;
- Property RE : TRegExpr read FRE;
- published
- procedure TestEmpty;
- Procedure RunTest1;
- Procedure RunTest2;
- Procedure RunTest3;
- Procedure RunTest4;
- Procedure RunTest5;
- Procedure RunTest6;
- Procedure RunTest7;
- Procedure RunTest8;
- Procedure RunTest9;
- Procedure RunTest10;
- Procedure RunTest11;
- Procedure RunTest12;
- Procedure RunTest13;
- Procedure RunTest14;
- Procedure RunTest15;
- Procedure RunTest16;
- Procedure RunTest17;
- Procedure RunTest18;
- Procedure RunTest19;
- Procedure RunTest20;
- Procedure RunTest21;
- Procedure RunTest22;
- Procedure RunTest23;
- Procedure RunTest24;
- Procedure RunTest25;
- end;
- implementation
- Type
- TRegExTest = record
- Expression: string;
- InputText: string;
- SubstitutionText: string;
- ExpectedResult: string;
- MatchStart: integer;
- end;
- const
- testCases: array [1..25] of TRegExTest = (
- (
- expression: '\nd';
- inputText: 'abc'#13#10'def';
- substitutionText: '\n\x{10}\r\\';
- expectedResult: 'abc'#13#10#16#13'\ef';
- MatchStart: 0
- ),
- (
- expression: '(\w*)';
- inputText: 'name.ext';
- substitutionText: '$1.new';
- expectedResult: 'name.new.new.ext.new.new';
- MatchStart: 0
- ),
- (
- expression: #$d'('#$a')';
- inputText: 'word'#$d#$a;
- substitutionText: '$1';
- expectedResult: 'word'#$a;
- MatchStart: 0
- ),
- (
- expression: '(word)';
- inputText: 'word';
- substitutionText: '\U$1\\r';
- expectedResult: 'WORD\r';
- MatchStart: 0
- ),
- (
- expression: '(word)';
- inputText: 'word';
- substitutionText: '$1\n';
- expectedResult: 'word'#$a;
- MatchStart: 0
- ),
- (
- expression: '[A-Z]';
- inputText: '234578923457823659GHJK38';
- substitutionText: '';
- expectedResult: 'G';
- matchStart: 19;
- ),
- (
- expression: '[A-Z]*?';
- inputText: '234578923457823659ARTZU38';
- substitutionText: '';
- expectedResult: '';
- matchStart: 1
- ),
- (
- expression: '[A-Z]+';
- inputText: '234578923457823659ARTZU38';
- substitutionText: '';
- expectedResult: 'ARTZU';
- matchStart: 19
- ),
- (
- expression: '[A-Z][A-Z]*';
- inputText: '234578923457823659ARTZU38';
- substitutionText: '';
- expectedResult: 'ARTZU';
- matchStart: 19
- ),
- (
- expression: '[A-Z][A-Z]?';
- inputText: '234578923457823659ARTZU38';
- substitutionText: '';
- expectedResult: 'AR';
- matchStart: 19
- ),
- (
- expression: '[^\d]+';
- inputText: '234578923457823659ARTZU38';
- substitutionText: '';
- expectedResult: 'ARTZU';
- matchStart: 19
- ),
- (
- expression: '[A-Z][A-Z]?[A-Z]';
- inputText: '234578923457823659ARTZU38';
- substitutionText: '';
- expectedResult: 'ART';
- matchStart: 19
- ),
- (
- expression: '[A-Z][A-Z]*[0-9]';
- inputText: '234578923457823659ARTZU38';
- substitutionText: '';
- expectedResult: 'ARTZU3';
- matchStart: 19
- ),
- (
- expression: '[A-Z]+[0-9]';
- inputText: '234578923457823659ARTZU38';
- substitutionText: '';
- expectedResult: 'ARTZU3';
- matchStart: 19
- ),
- (
- expression: '(?i)[A-Z]';
- inputText: '234578923457823659a38';
- substitutionText: '';
- expectedResult: 'a';
- matchStart: 19
- ),
- (
- expression: '(?i)[a-z]';
- inputText: '234578923457823659A38';
- substitutionText: '';
- expectedResult: 'A';
- matchStart: 19
- ),
- (
- expression: '(foo)1234';
- inputText: '1234 foo1234XXXX';
- substitutionText: '';
- expectedResult: 'foo1234';
- matchStart: 8
- ),
- (
- expression: '(((foo)))1234';
- inputText: '1234 foo1234XXXX';
- substitutionText: '';
- expectedResult: 'foo1234';
- matchStart: 8
- ),
- (
- expression: '(foo)(1234)';
- inputText: '1234 foo1234XXXX';
- substitutionText: '';
- expectedResult: 'foo1234';
- matchStart: 8
- ),
- (
- expression: 'nofoo|foo';
- inputText: '1234 foo1234XXXX';
- substitutionText: '';
- expectedResult: 'foo';
- matchStart: 8
- ),
- (
- expression: '(nofoo|foo)1234';
- inputText: '1234 nofoo1234XXXX';
- substitutionText: '';
- expectedResult: 'nofoo1234';
- matchStart: 8
- ),
- (
- expression: '(nofoo|foo|anotherfoo)1234';
- inputText: '1234 nofoo1234XXXX';
- substitutionText: '';
- expectedResult: 'nofoo1234';
- matchStart: 8
- ),
- (
- expression: 'nofoo1234|foo1234';
- inputText: '1234 foo1234XXXX';
- substitutionText: '';
- expectedResult: 'foo1234';
- matchStart: 8
- ),
- (
- expression: '(\w*)';
- inputText: 'name.ext';
- substitutionText: '';
- expectedResult: 'name';
- matchStart: 1
- ),
- (
- expression: '\r(\n)';
- inputText: #$d#$a;
- substitutionText: '';
- expectedResult: #$d#$a;
- matchStart: 1
- )
- );
- procedure TTestRegexpr.TestEmpty;
- begin
- AssertNotNull('Have RE',RE);
- AssertFalse('UseOsLineEndOnReplace correcly set', RE.UseOsLineEndOnReplace);
- end;
- procedure TTestRegexpr.RunTest1;
- begin
- RunRETest(1);
- end;
- procedure TTestRegexpr.RunTest2;
- begin
- RunRETest(2);
- end;
- procedure TTestRegexpr.RunTest3;
- begin
- RunRETest(3);
- end;
- procedure TTestRegexpr.RunTest4;
- begin
- RunRETest(4);
- end;
- procedure TTestRegexpr.RunTest5;
- begin
- RunRETest(5);
- end;
- procedure TTestRegexpr.RunTest6;
- begin
- RunRETest(6);
- end;
- procedure TTestRegexpr.RunTest7;
- begin
- RunRETest(7);
- end;
- procedure TTestRegexpr.RunTest8;
- begin
- RunRETest(8);
- end;
- procedure TTestRegexpr.RunTest9;
- begin
- RunRETest(9);
- end;
- procedure TTestRegexpr.RunTest10;
- begin
- RunRETest(10);
- end;
- procedure TTestRegexpr.RunTest11;
- begin
- RunRETest(11);
- end;
- procedure TTestRegexpr.RunTest12;
- begin
- RunRETest(12);
- end;
- procedure TTestRegexpr.RunTest13;
- begin
- RunRETest(13);
- end;
- procedure TTestRegexpr.RunTest14;
- begin
- RunRETest(14);
- end;
- procedure TTestRegexpr.RunTest15;
- begin
- RunRETest(15);
- end;
- procedure TTestRegexpr.RunTest16;
- begin
- RunRETest(16);
- end;
- procedure TTestRegexpr.RunTest17;
- begin
- RunRETest(17);
- end;
- procedure TTestRegexpr.RunTest18;
- begin
- RunRETest(18);
- end;
- procedure TTestRegexpr.RunTest19;
- begin
- RunRETest(19);
- end;
- procedure TTestRegexpr.RunTest20;
- begin
- RunRETest(20);
- end;
- procedure TTestRegexpr.RunTest21;
- begin
- RunRETest(21);
- end;
- procedure TTestRegexpr.RunTest22;
- begin
- RunRETest(22);
- end;
- procedure TTestRegexpr.RunTest23;
- begin
- RunRETest(23);
- end;
- procedure TTestRegexpr.RunTest24;
- begin
- RunRETest(24);
- end;
- procedure TTestRegexpr.RunTest25;
- begin
- RunRETest(25);
- end;
- Class function TTestRegexpr.PrintableString(AString: string): string;
- var
- ch: Char;
- begin
- Result := '';
- for ch in AString do
- if ch < #31 then
- Result := Result + '#' + IntToStr(Ord(ch))
- else
- Result := Result + ch;
- end;
- procedure TTestRegexpr.RunRETest(aIndex: Integer);
- var
- T: TRegExTest;
- act : String;
- begin
- T:=testCases[aIndex];
- RE.Expression:=T.Expression;
- RE.Compile;
- {$IFDEF DUMPTESTS}
- Writeln('Test: ',TestName);
- writeln(' Modifiers "', RE.ModifierStr, '"');
- writeln(' Regular expression: ', T.Expression,' ,');
- writeln(' compiled into p-code: ');
- writeln(' ',RE.Dump);
- writeln(' Input text: "', PrintableString(T.inputText), '"');
- if (T.substitutionText <> '') then
- Writeln(' Substitution text: "', PrintableString(T.substitutionText), '"');
- {$ENDIF}
- if (T.SubstitutionText <> '') then
- begin
- act:=RE.Replace(T.InputText,T.SubstitutionText,True);
- AssertEquals('Replace failed', T.ExpectedResult,Act)
- end
- else
- begin
- RE.Exec(T.inputText);
- AssertEquals('Search position',T.MatchStart,RE.MatchPos[0]);
- AssertEquals('Matched text',T.ExpectedResult,RE.Match[0]);
- end;
- end;
- procedure TTestRegexpr.SetUp;
- begin
- Inherited;
- FRE := TRegExpr.Create;
- FRE.UseOsLineEndOnReplace:=False;
- end;
- procedure TTestRegexpr.TearDown;
- begin
- FreeAndNil(FRE);
- Inherited;
- end;
- initialization
- RegisterTest(TTestRegexpr);
- end.
|