+ added flags

  + support of case insensitive search

packages/regexpr/regexpr.pp

@@ -35,9 +35,13 @@ unit regexpr;
              ret_or : (alternative : pregexprentry);
        end;
 
+       tregexprflag = (ref_singleline,ref_multiline,ref_caseinsensitive);
+       tregexprflags = set of tregexprflag;
+
        TRegExprEngine = record
           Data : pregexprentry;
           DestroyList : pregexprentry;
+          Flags : TRegExprFlags;
        end;
 
      const
@@ -55,7 +59,7 @@ unit regexpr;
 
      { the following procedures can be used by units basing }
      { on the regexpr unit                                  }
-     function GenerateRegExprEngine(regexpr : pchar) : TRegExprEngine;
+     function GenerateRegExprEngine(regexpr : pchar;flags : tregexprflags) : TRegExprEngine;
 
      procedure DestroyRegExprEngine(var regexpr : TRegExprEngine);
 
@@ -80,7 +84,7 @@ unit regexpr;
        end;
 {$endif DEBUG}
 
-     function GenerateRegExprEngine(regexpr : pchar) : TRegExprEngine;
+     function GenerateRegExprEngine(regexpr : pchar;flags : tregexprflags) : TRegExprEngine;
 
        var
           first : pregexprentry;
@@ -175,7 +179,11 @@ unit regexpr;
                   end;
                else
                  begin
-                    c1:=currentpos^;
+                    if ref_caseinsensitive in flags then
+                       c1:=upcase(currentpos^)
+                    else
+                       c1:=currentpos^;
+
                     inc(currentpos);
                     if currentpos^='-' then
                       begin
@@ -185,7 +193,10 @@ unit regexpr;
                               error:=true;
                               exit;
                            end;
-                         readchars:=[c1..currentpos^];
+                         if ref_caseinsensitive in flags then
+                           readchars:=[c1..upcase(currentpos^)]
+                         else
+                           readchars:=[c1..currentpos^];
                          inc(currentpos);
                       end
                     else
@@ -356,13 +367,14 @@ unit regexpr;
           new(endp);
           doregister(endp);
           endp^.typ:=ret_illegalend;
+          GenerateRegExprEngine.flags:=flags;
           GenerateRegExprEngine.Data:=parseregexpr(endp);
           GenerateRegExprEngine.DestroyList:=first;
           if error then
             DestroyRegExprEngine(GenerateRegExprEngine);
        end;
 
-     procedure DestroyRegExprEngine(var regexpr : TRegExprEngine);
+    procedure DestroyRegExprEngine(var regexpr : TRegExprEngine);
 
        var
           hp : pregexprentry;
@@ -405,7 +417,9 @@ unit regexpr;
                       else
                         exit;
                    end;
-                 if pos^ in regexpr^.chars then
+                 if (pos^ in regexpr^.chars) or
+                   ((ref_caseinsensitive in regexprengine.flags) and
+                    (upcase(pos^) in regexpr^.chars)) then
                    begin
 {$ifdef DEBUG}
                       writeln('Found matching: ',pos^);
@@ -463,7 +477,10 @@ begin
 end.
 {
   $Log$
-  Revision 1.1  2000-03-14 22:09:03  florian
-    * Initial revision
+  Revision 1.2  2000-03-14 22:57:51  florian
+    + added flags
+    + support of case insensitive search
 
+  Revision 1.1  2000/03/14 22:09:03  florian
+    * Initial revision
 }

packages/regexpr/test1.pp

@@ -16,54 +16,71 @@ procedure do_error(i : longint);
 begin
    writeln('*** Testing unit regexpr ***');
 
-   r:=GenerateRegExprEngine('[A-Z]');
+   r:=GenerateRegExprEngine('[A-Z]',[]);
    if not(RegExprPos(r,'234578923457823659A38',index,len)) or
      (index<>18) or (len<>1) then
      do_error(1000);
    DestroyregExprEngine(r);
 
-   r:=GenerateRegExprEngine('[A-Z]*');
+   r:=GenerateRegExprEngine('[A-Z]*',[]);
    if not(RegExprPos(r,'234578923457823659ARTZU38',index,len)) or
    { is this result correct ??? }
      (index<>0) or (len<>0) then
      do_error(1002);
    DestroyregExprEngine(r);
 
-   r:=GenerateRegExprEngine('[A-Z]+');
+   r:=GenerateRegExprEngine('[A-Z]+',[]);
    if not(RegExprPos(r,'234578923457823659ARTZU38',index,len)) or
      (index<>18) or (len<>5) then
      do_error(1003);
    DestroyregExprEngine(r);
 
-   r:=GenerateRegExprEngine('[A-Z][A-Z]*');
+   r:=GenerateRegExprEngine('[A-Z][A-Z]*',[]);
    if not(RegExprPos(r,'234578923457823659ARTZU38',index,len)) or
      (index<>18) or (len<>5) then
      do_error(1004);
    DestroyregExprEngine(r);
 
-   r:=GenerateRegExprEngine('[A-Z][A-Z]?');
+   r:=GenerateRegExprEngine('[A-Z][A-Z]?',[]);
    if not(RegExprPos(r,'234578923457823659ARTZU38',index,len)) or
      (index<>18) or (len<>2) then
      do_error(1005);
    DestroyregExprEngine(r);
 
-   r:=GenerateRegExprEngine('^\d+');
+   r:=GenerateRegExprEngine('^\d+',[]);
    if not(RegExprPos(r,'234578923457823659ARTZU38',index,len)) or
      (index<>18) or (len<>5) then
      do_error(1006);
    DestroyregExprEngine(r);
 
-   r:=GenerateRegExprEngine('(nofoo|foo)1234');
+   {
+   r:=GenerateRegExprEngine('(nofoo|foo)1234',[]);
    if not(RegExprPos(r,'1234   foo1234XXXX',index,len)) or
      (index<>8) or (len<>7) then
      do_error(1007);
    DestroyregExprEngine(r);
 
-   r:=GenerateRegExprEngine('(nofoo|foo)1234');
+   r:=GenerateRegExprEngine('(nofoo|foo)1234',[]);
    if not(RegExprPos(r,'1234   nofoo1234XXXX',index,len)) or
      (index<>8) or (len<>9) then
      do_error(1008);
    DestroyregExprEngine(r);
+   }
+
+   { case insensitive: }
+
+   r:=GenerateRegExprEngine('[A-Z]',[ref_caseinsensitive]);
+   if not(RegExprPos(r,'234578923457823659a38',index,len)) or
+     (index<>18) or (len<>1) then
+     do_error(1009);
+   DestroyregExprEngine(r);
+
+   { case insensitive: }
+   r:=GenerateRegExprEngine('[a-z]',[ref_caseinsensitive]);
+   if not(RegExprPos(r,'234578923457823659A38',index,len)) or
+     (index<>18) or (len<>1) then
+     do_error(1010);
+   DestroyregExprEngine(r);
 
    writeln('*** Testing unit regexpr was successful ***');
-end.
+end.