paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-11-02 19:19:30 +01:00
Code Issues Packages Projects Releases Wiki Activity

+ added flags

Browse Source 
+ support of case insensitive search
This commit is contained in:
florian 2000-03-14 22:57:51 +00:00
parent b87d671416
commit 5321706ab5
2 changed files with 51 additions and 17 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

33
packages/regexpr/regexpr.pp
View File

@ -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
}

35
packages/regexpr/test1.pp
View File

@ -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.