From 26e713b77b912349e440364d0bc60182f7d20502 Mon Sep 17 00:00:00 2001 From: marco Date: Sun, 5 Dec 2010 11:10:06 +0000 Subject: * patch for regex. Fixes exception in rcclear, some casing issues and matching of \w. Also a fix for currentpos in the old version. Mantis 15466 git-svn-id: http://svn.freepascal.org/svn/fpc/trunk@16506 3ad0048d-3df7-0310-abae-a5850022a9f2 --- packages/regexpr/examples/testreg1.pp | 54 +++++++++++++++++++++++++++++++++-- packages/regexpr/src/old/regexpr.pp | 2 +- packages/regexpr/src/regex.pp | 32 ++++++++++++++++++++- packages/regexpr/src/regexpr.pp | 9 +++++- 4 files changed, 92 insertions(+), 5 deletions(-) (limited to 'packages/regexpr') diff --git a/packages/regexpr/examples/testreg1.pp b/packages/regexpr/examples/testreg1.pp index a8381a83f1..2347ff8649 100644 --- a/packages/regexpr/examples/testreg1.pp +++ b/packages/regexpr/examples/testreg1.pp @@ -24,15 +24,49 @@ var begin writeln('*** Testing unit regexpr ***'); + { runtime error test } + initok:=GenerateRegExprEngine('[o]{1,2}',[],r); + if not initok then + do_error(1); + if not(RegExprPos(r,'book',index,len)) or + (index<>1) or (len<>2) then + do_error(1); + // if it has bug, error An unhandled exception when r.Free + DestroyregExprEngine(r); // bug:Test for rcClear + writeln('*** Searching tests ***'); { basic tests } initok:=GenerateRegExprEngine('.*',[],r); if not initok then - do_error(90); + do_error(50); if not(RegExprPos(r,'CXXXX',index,len)) or (index<>0) or (len<>5) then - do_error(91); + do_error(51); + DestroyregExprEngine(r); + + initok:=GenerateRegExprEngine('\t\t',[],r); + if not initok then + do_error(52); + if not(RegExprPos(r,'a'+#9+#9+'b'+'\t\t',index,len)) or + (index<>1) or (len<>2) then + do_error(52); + DestroyregExprEngine(r); + + initok:=GenerateRegExprEngine('\t',[],r); + if not initok then + do_error(53); + if not(RegExprPos(r,'a'+#9+#9+'b'+'\t\t',index,len)) or + (index<>1) or (len<>1) then + do_error(53); + DestroyregExprEngine(r); + + initok:=GenerateRegExprEngine('\w',[],r); + if not initok then + do_error(54); + if not(RegExprPos(r,'- abc \w',index,len)) or + (index<>2) or (len<>1) then + do_error(54); DestroyregExprEngine(r); { java package name } @@ -364,6 +398,14 @@ begin do_error(718); DestroyregExprEngine(r); + initok:=GenerateRegExprEngine('o{2}',[],r); + if not initok then + do_error(719); + if not(RegExprPos(r,'book',index,len)) or + (index<>1) or (len<>2) then + do_error(719); + DestroyregExprEngine(r); + (* {n,m} tests *) initok:=GenerateRegExprEngine('Cat(AZ){1,3}',[],r); if not initok then @@ -412,6 +454,14 @@ begin do_error(729); DestroyregExprEngine(r); + initok:=GenerateRegExprEngine('o{2,2}',[],r); + if not initok then + do_error(730); + if not(RegExprPos(r,'book',index,len)) or + (index<>1) or (len<>2) then + do_error(730); + DestroyregExprEngine(r); + { ()* tests } initok:=GenerateRegExprEngine('(AZ)*',[],r); diff --git a/packages/regexpr/src/old/regexpr.pp b/packages/regexpr/src/old/regexpr.pp index 9dd7ea14bf..0888b0c5c2 100644 --- a/packages/regexpr/src/old/regexpr.pp +++ b/packages/regexpr/src/old/regexpr.pp @@ -564,7 +564,7 @@ unit regexpr; begin if not parseOccurences(currentPos,minOccurs,maxOccurs) then exit; - inc(currentpos); + // currentpos is increased by parseOccurences new(hp3); doregister(hp3); hp3^.typ:=ret_pattern; diff --git a/packages/regexpr/src/regex.pp b/packages/regexpr/src/regex.pp index 0ceb96cc4a..134df40bd8 100644 --- a/packages/regexpr/src/regex.pp +++ b/packages/regexpr/src/regex.pp @@ -452,7 +452,7 @@ end; {--------} procedure TRegexEngine.rcClear; var - i : integer; + i, j : integer; begin {free all items in the state transition table} for i := 0 to FStateCount-1 do begin @@ -460,7 +460,13 @@ begin if (sdMatchType = mtClass) or (sdMatchType = mtNegClass) then if (sdClass <> nil) then + begin + for j := i+1 to FStateCount-1 do + if (FStateTable[j].sdClass = sdClass) then + FStateTable[j].sdClass := nil; FreeMem(sdClass, sizeof(TCharSet)); + end; + FillChar(FStateTable[i],SizeOf(FStateTable[i]),#0); end; end; {clear the state transition table} @@ -734,6 +740,25 @@ begin Result := rcAddState(mtAnyChar, #0, nil, NewFinalState, UnusedState); end; + '\' : + begin + case (FPosn+1)^ of + 'd','D','s','S','w','W': + begin + New(CharClass); + CharClass^ := []; + if not rcParseCharRange(CharClass) then begin + Dispose(CharClass); + Result := ErrorState; + Exit; + end; + Result := rcAddState(mtClass, #0, CharClass, + NewFinalState, UnusedState); + end; + else + Result := rcParseChar; + end; + end; else {otherwise parse a single character} Result := rcParseChar; @@ -791,6 +816,8 @@ begin begin inc(FPosn); ch := rcReturnEscapeChar; + if (FRegexType <> rtRegEx) then + FRegexType := rtRegEx; end else ch :=FPosn^; @@ -1060,6 +1087,9 @@ begin if m = -1 then rcAddState(mtNone, #0, nil, NewFinalState, TempEndStateAtom); + if FRegexType <> rtRegEx then + FRegexType := rtRegEx; + Result := StartStateAtom; end; end; diff --git a/packages/regexpr/src/regexpr.pp b/packages/regexpr/src/regexpr.pp index e1ee245c74..2726632623 100644 --- a/packages/regexpr/src/regexpr.pp +++ b/packages/regexpr/src/regexpr.pp @@ -71,7 +71,9 @@ end; procedure DestroyRegExprEngine(var regexpr: TRegExprEngine); begin - regexpr.Free; + if regexpr <> nil then + regexpr.Free; + regexpr := nil; end; function RegExprPos(RegExprEngine: TRegExprEngine; p: pchar; var index, @@ -81,6 +83,11 @@ begin Result := RegExprEngine.MatchString(p,index,len); Len := Len - index; Dec(Index); + if not Result then + begin + index := -1; + len := 0; + end; end; function RegExprReplaceAll(RegExprEngine: TRegExprEngine; const src, -- cgit v1.2.1