* 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: trunk@16506 -

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);

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;

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;

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,