Skip to content

Commit

Permalink
Merge pull request #387 from ThomasKalten/master
Browse files Browse the repository at this point in the history 
Backwards kompatible with D7
  • Loading branch information
@Alexey-T
Alexey-T authored Apr 17, 2024
2 parents afdc505 + 4e0c755 commit b2fe07d
Show file tree
Hide file tree
Showing 3 changed files with 139 additions and 9 deletions.
77 changes: 75 additions & 2 deletions src/regexpr.pas
View file
Original file line number Diff line number Diff line change
Expand Up @@ -113,12 +113,18 @@ interface
// Define 'InlineFuncs' options, to use inline keyword (do not edit this definitions).
{$IFDEF D8} {$DEFINE InlineFuncs} {$ENDIF}
{$IFDEF FPC} {$DEFINE InlineFuncs} {$ENDIF}

{$IF DEFINED(D8) OR DEFINED(FPC)}
{$PointerMath on}
{$DEFINE HASPOINTERARRAYACCESS}
{$ELSE}
{$UNDEF HASPOINTERARRAYACCESS}
{$IFEND}

{$IFDEF RegExpWithStackOverflowCheck} // Define the stack checking algorithm for the current platform/CPU
{$IF defined(Linux) or defined(Windows)}{$IF defined(CPU386) or defined(CPUX86_64)}
{$DEFINE RegExpWithStackOverflowCheck_DecStack_Frame} // Stack-pointer decrements // use getframe over Sptr()
{$ENDIF}{$ENDIF}
{$IFEND}{$IFEND}
{$ENDIF}
uses
SysUtils, // Exception
Expand Down Expand Up @@ -2063,6 +2069,7 @@ destructor TRegExpr.Destroy;
FreeMem(programm);
programm := nil;
end;
inherited;
end;

procedure TRegExpr.SetExpression(const AStr: RegExprString);
Expand Down Expand Up @@ -5427,6 +5434,20 @@ TRegExprMatchPrimLocals = record
);
end;

{$IFNDEF HASPOINTERARRAYACCESS}
function PRegExprCharArrayAccess(const anArray: PPRegExprChar; const anIdx: Integer): PRegExprChar;
begin
result := PPRegExprChar(Integer(anArray) + (anIdx * SizeOf(PRegExprChar)))^;
end;

procedure AssignPRegExprCharArray(const anArray: PPRegExprChar; const anIdx: Integer; const aValue: PRegExprChar);
var ArrayMember: PPRegExprChar;
begin
ArrayMember := PPRegExprChar(Integer(anArray) + (anIdx * SizeOf(PRegExprChar)));
ArrayMember^ := aValue;
end;
{$ENDIF}

function TRegExpr.MatchPrim(prog: PRegExprChar): Boolean;
// recursively matching routine
// Conceptually the strategy is simple: check to see whether the current
Expand Down Expand Up @@ -5720,10 +5741,18 @@ function TRegExpr.MatchPrim(prog: PRegExprChar): Boolean;
no := PReGroupIndex((scan + REOpSz + RENextOffSz))^;
if no < 0 then
Exit;
{$IFDEF HASPOINTERARRAYACCESS}
opnd := CurrentGrpBounds.GrpStart[no];
{$ELSE}
opnd := PRegExprCharArrayAccess(CurrentGrpBounds.GrpStart, no);
{$ENDIF}
if opnd = nil then
Exit;
{$IFDEF HASPOINTERARRAYACCESS}
save := CurrentGrpBounds.GrpEnd[no];
{$ELSE}
save := PRegExprCharArrayAccess(CurrentGrpBounds.GrpEnd, no);
{$ENDIF}
if save = nil then
Exit;
no := save - opnd;
Expand All @@ -5747,10 +5776,18 @@ function TRegExpr.MatchPrim(prog: PRegExprChar): Boolean;
no := PReGroupIndex((scan + REOpSz + RENextOffSz))^;
if no < 0 then
Exit;
{$IFDEF HASPOINTERARRAYACCESS}
opnd := CurrentGrpBounds.GrpStart[no];
{$ELSE}
opnd := PRegExprCharArrayAccess(CurrentGrpBounds.GrpStart, no);
{$ENDIF}
if opnd = nil then
Exit;
{$IFDEF HASPOINTERARRAYACCESS}
save := CurrentGrpBounds.GrpEnd[no];
{$ELSE}
save := PRegExprCharArrayAccess(CurrentGrpBounds.GrpEnd, no);
{$ENDIF}
if save = nil then
Exit;
no := save - opnd;
Expand Down Expand Up @@ -5827,10 +5864,19 @@ function TRegExpr.MatchPrim(prog: PRegExprChar): Boolean;
OP_OPEN:
begin
no := PReGroupIndex((scan + REOpSz + RENextOffSz))^;
{$IFDEF HASPOINTERARRAYACCESS}
save := CurrentGrpBounds.TmpStart[no];
CurrentGrpBounds.TmpStart[no] := regInput;
{$ELSE}
save := PRegExprCharArrayAccess(CurrentGrpBounds.TmpStart, no);
AssignPRegExprCharArray(CurrentGrpBounds.TmpStart, no, regInput);
{$ENDIF}
Result := MatchPrim(next);
{$IFDEF HASPOINTERARRAYACCESS}
CurrentGrpBounds.TmpStart[no] := save;
{$ELSE}
AssignPRegExprCharArray(CurrentGrpBounds.TmpStart, no, save);
{$ENDIF}
exit;
end;

Expand All @@ -5847,11 +5893,17 @@ function TRegExpr.MatchPrim(prog: PRegExprChar): Boolean;
OP_CLOSE:
begin
no := PReGroupIndex((scan + REOpSz + RENextOffSz))^;
{$IFDEF HASPOINTERARRAYACCESS}
save := CurrentGrpBounds.GrpStart[no];
opnd := CurrentGrpBounds.GrpEnd[no]; // save2
CurrentGrpBounds.GrpStart[no] := CurrentGrpBounds.TmpStart[no];
CurrentGrpBounds.GrpEnd[no] := regInput;

{$ELSE}
save := PRegExprCharArrayAccess(CurrentGrpBounds.GrpStart, no);
opnd := PRegExprCharArrayAccess(CurrentGrpBounds.GrpEnd, no); // save2
AssignPRegExprCharArray(CurrentGrpBounds.GrpStart, no, PRegExprCharArrayAccess(CurrentGrpBounds.TmpStart, no));
AssignPRegExprCharArray(CurrentGrpBounds.GrpEnd, no, regInput);
{$ENDIF}
// if we are in OP_SUBCALL* call, it called OP_OPEN*, so we must return
// in OP_CLOSE, without going to next opcode
if CurrentSubCalled = no then
Expand All @@ -5862,8 +5914,13 @@ function TRegExpr.MatchPrim(prog: PRegExprChar): Boolean;

Result := MatchPrim(next);
if not Result then begin
{$IFDEF HASPOINTERARRAYACCESS}
CurrentGrpBounds.GrpStart[no] := save;
CurrentGrpBounds.GrpEnd[no] := opnd;
{$ELSE}
AssignPRegExprCharArray(CurrentGrpBounds.GrpStart, no, save);
AssignPRegExprCharArray(CurrentGrpBounds.GrpEnd, no, opnd);
{$ENDIF}
end;

Exit;
Expand Down Expand Up @@ -6430,7 +6487,11 @@ function TRegExpr.MatchPrim(prog: PRegExprChar): Boolean;
CurrentGrpBounds.TmpStart := @GrpBounds[regRecursion].TmpStart[0];
CurrentGrpBounds.GrpStart := @GrpBounds[regRecursion].GrpStart[0];
CurrentGrpBounds.GrpEnd := @GrpBounds[regRecursion].GrpEnd[0];
{$IFDEF HASPOINTERARRAYACCESS}
FillChar(CurrentGrpBounds.GrpStart[0], SizeOf(CurrentGrpBounds.GrpStart[0])*regNumBrackets, 0);
{$ELSE}
FillChar(CurrentGrpBounds.GrpStart^, SizeOf(CurrentGrpBounds.GrpStart^)*regNumBrackets, 0);
{$ENDIF}
end;
Result := MatchPrim(regCodeWork);
Dec(regRecursion);
Expand Down Expand Up @@ -6462,7 +6523,11 @@ function TRegExpr.MatchPrim(prog: PRegExprChar): Boolean;
CurrentGrpBounds.TmpStart := @GrpBounds[regRecursion].TmpStart[0];
CurrentGrpBounds.GrpStart := @GrpBounds[regRecursion].GrpStart[0];
CurrentGrpBounds.GrpEnd := @GrpBounds[regRecursion].GrpEnd[0];
{$IFDEF HASPOINTERARRAYACCESS}
FillChar(CurrentGrpBounds.GrpStart[0], SizeOf(CurrentGrpBounds.GrpStart[0])*regNumBrackets, 0);
{$ELSE}
FillChar(CurrentGrpBounds.GrpStart^, SizeOf(CurrentGrpBounds.GrpStart^)*regNumBrackets, 0);
{$ENDIF}
end;
Result := MatchPrim(save);
Dec(regRecursion);
Expand Down Expand Up @@ -6645,11 +6710,19 @@ procedure TRegExpr.InitInternalGroupData;
SetLength(GrpBounds[0].TmpStart, BndLen);
SetLength(GrpBounds[0].GrpStart, BndLen);
SetLength(GrpBounds[0].GrpEnd, BndLen);
{$IF NOT DEFINED(D8) AND NOT DEFINED(FPC)}
for i := low(GrpBounds) + 1 to high(GrpBounds) do begin
SetLength(GrpBounds[i].TmpStart, 0);
SetLength(GrpBounds[i].GrpStart, 0);
SetLength(GrpBounds[i].GrpEnd, 0);
end;
{$ELSE}
for i := low(GrpBounds) + 1 to high(GrpBounds) do begin
GrpBounds[i].TmpStart := nil;
GrpBounds[i].GrpStart := nil;
GrpBounds[i].GrpEnd := nil;
end;
{$IFEND}
end;

SetLength(GrpOpCodes, GroupDataArraySize(regNumBrackets, Length(GrpOpCodes)));
Expand Down
28 changes: 28 additions & 0 deletions test/test_delphid7.dpr
View file
Original file line number Diff line number Diff line change
@@ -0,0 +1,28 @@
program test_delphid7;

uses
FastMM4 in '..\..\..\fastMM\FastMM4.pas',
SysUtils,
TestFramework,
TestExtensions,
Forms,
GUITestRunner,
TextTestRunner,
GUITesting,
tests in 'tests.pas',
regexpr in '..\..\Regexpr.pas';

{$R *.res}


begin
if FindCmdLineSwitch('text-mode', ['-','/'], true) then
TextTestRunner.RunRegisteredTests(rxbHaltOnFailures)
else
begin
Application.Initialize;
Application.Title := 'DUnit Tests';
// RunRegisteredTests class methods are recommended
TGUITestRunner.RunRegisteredTests;
end;
end.
43 changes: 36 additions & 7 deletions test/tests.pas
View file
Original file line number Diff line number Diff line change
Expand Up @@ -6,11 +6,23 @@

{ $DEFINE DUMPTESTS} //define this to dump results to console

{$IFDEF VER130} {$DEFINE D5} {$DEFINE D4} {$DEFINE D3} {$DEFINE D2} {$ENDIF} // D5
{$IFDEF VER140} {$DEFINE D6} {$DEFINE D5} {$DEFINE D4} {$DEFINE D3} {$DEFINE D2} {$ENDIF} // D6
{$IFDEF VER150} {$DEFINE D7} {$DEFINE D6} {$DEFINE D5} {$DEFINE D4} {$DEFINE D3} {$DEFINE D2} {$ENDIF} // D7
{$IFDEF VER130} {$DEFINE NOTUSINGDUNITX} {$DEFINE D5} {$DEFINE D4} {$DEFINE D3} {$DEFINE D2} {$ENDIF} // D5
{$IFDEF VER140} {$DEFINE NOTUSINGDUNITX} {$DEFINE D6} {$DEFINE D5} {$DEFINE D4} {$DEFINE D3} {$DEFINE D2} {$ENDIF} // D6
{$IFDEF VER150} {$DEFINE NOTUSINGDUNITX} {$DEFINE D7} {$DEFINE D6} {$DEFINE D5} {$DEFINE D4} {$DEFINE D3} {$DEFINE D2} {$ENDIF} // D7
{$IFDEF VER160} {$DEFINE NOTUSINGDUNITX} {$DEFINE D8} {$DEFINE D7} {$DEFINE D6} {$DEFINE D5} {$DEFINE D4} {$DEFINE D3} {$DEFINE D2} {$ENDIF} // D7
{$IFDEF VER170} {$DEFINE NOTUSINGDUNITX} {$DEFINE D2005} {$DEFINE D8} {$DEFINE D7} {$DEFINE D6} {$DEFINE D5} {$DEFINE D4} {$DEFINE D3} {$DEFINE D2} {$ENDIF} // D7
{$IFDEF VER180} {$DEFINE NOTUSINGDUNITX} {$DEFINE D2006} {$DEFINE D2005} {$DEFINE D8} {$DEFINE D7} {$DEFINE D6} {$DEFINE D5} {$DEFINE D4} {$DEFINE D3} {$DEFINE D2} {$ENDIF} // D7
{$IFDEF VER185} {$DEFINE NOTUSINGDUNITX} {$DEFINE D2006} {$DEFINE D2005} {$DEFINE D8} {$DEFINE D7} {$DEFINE D6} {$DEFINE D5} {$DEFINE D4} {$DEFINE D3} {$DEFINE D2} {$ENDIF} // D7
{$IFDEF VER190} {$DEFINE NOTUSINGDUNITX} {$DEFINE D2007} {$DEFINE D2006} {$DEFINE D2005} {$DEFINE D8} {$DEFINE D7} {$DEFINE D6} {$DEFINE D5} {$DEFINE D4} {$DEFINE D3} {$DEFINE D2} {$ENDIF} // D7
{$IFDEF VER200} {$DEFINE NOTUSINGDUNITX} {$DEFINE D2009} {$DEFINE D2007} {$DEFINE D2006} {$DEFINE D2005} {$DEFINE D8} {$DEFINE D7} {$DEFINE D6} {$DEFINE D5} {$DEFINE D4} {$DEFINE D3} {$DEFINE D2} {$ENDIF} // D7

{$IFDEF D5} {$DEFINE OverMeth} {$ENDIF}
{$IFDEF FPC} {$DEFINE OverMeth} {$ENDIF}
{$IFDEF D7}
{$UNDEF FastUnicodeData}
{$ELSE}
{$DEFINE FastUnicodeData}
{$ENDIF}

{$DEFINE UnicodeRE}

Expand Down Expand Up @@ -147,10 +159,12 @@ TTestRegexpr= class(TTestCase)
procedure RunTest50;
procedure TestGroups;
{$IFDEF UnicodeRE}
{$IFDEF FastUnicodeData}
procedure RunTest51unicode;
procedure RunTest52unicode;
procedure RunTest70russian;
{$ENDIF}
{$ENDIF}
procedure RunTest53;
procedure RunTest54;
procedure RunTest55;
Expand Down Expand Up @@ -865,7 +879,11 @@ procedure TTestRegexpr.IsMatching(AErrorMessage: String; ARegEx,
AOffset: integer; AMustMatchBefore: integer);
var
i: Integer;
{$IF DEFINED(SizeInt)}
L: SizeInt;
{$ELSE}
L: Integer;
{$IFEND}
begin
CompileRE(ARegEx);
RE.InputString:= AInput;
Expand Down Expand Up @@ -953,7 +971,7 @@ procedure TTestRegexpr.TestReplaceOverload;
begin
CompileRE('A\r(\n)'); // just to print compiled re - it will be recompiled below
act:=ReplaceRegExpr('A\r(\n)', 'a'#$d#$a, '\n', [rroModifierI, rroUseSubstitution]);
AssertEquals('Replace failed', PrintableString(#$a), PrintableString(Act))
AreEqual('Replace failed', PrintableString(#$a), PrintableString(Act))
end;
{$ENDIF}

Expand Down Expand Up @@ -1034,9 +1052,9 @@ procedure TTestRegexpr.TestModifiers;
procedure TTestRegexpr.TestContinueAnchor;
procedure AssertMatch(AName: String; AStart, ALen: Integer);
begin
AreEqual(AName + 'MatchCount', 1, RE.SubExprMatchCount);
AreEqual(AName + 'MatchPos[1]', AStart, RE.MatchPos[1]);
AreEqual(AName + 'MatchLen[1]', ALen, RE.MatchLen[1]);
AreEqual(AName + ' MatchCount', 1, RE.SubExprMatchCount);
AreEqual(AName + ' MatchPos[1]', AStart, RE.MatchPos[1]);
AreEqual(AName + ' MatchLen[1]', ALen, RE.MatchLen[1]);
end;
begin
// Without \G MatchNext will skip
Expand Down Expand Up @@ -2154,7 +2172,9 @@ procedure TTestRegexpr.TestIsFixedLength;
HasVarLenLookBehind('', '()A(?<=.(?<=(?1)))');
HasVarLenLookBehind('', '()()()()A(?<=.(?<=(?4)))');
HasVarLenLookBehind('', '()A(?<=.(?<=(?R)))');
{$IFDEF FastUnicodeData}
HasFixedLookBehind ('', '()A(?<=.(?<=\p{Lu}))');
{$ENDIF}
HasFixedLookBehind ('', '()A(?<=.(?<=[a-x]))');

end;
Expand Down Expand Up @@ -3259,6 +3279,7 @@ procedure TTestRegexpr.RunTest50;
end;

{$IFDEF UnicodeRE}
{$IFDEF FastUnicodeData}
procedure TTestRegexpr.RunTest51unicode;
begin
RunRETest(51);
Expand Down Expand Up @@ -3286,6 +3307,7 @@ procedure TTestRegexpr.RunTest70russian;
AreEqual('Matched text', PrintableString(T.ExpectedResult), PrintableString(RE.Match[0]));
end;
{$ENDIF}
{$ENDIF}

procedure TTestRegexpr.RunTest53;
begin
Expand Down Expand Up @@ -3414,6 +3436,9 @@ procedure TTestRegexpr.TestGroups;
end;

procedure TTestRegexpr.CompileRE(const AExpression: RegExprString);
{$IF NOT DEFINED(LineEnding)}
const LineEnding = #13#10;
{$IFEND}
begin
FErrorInfo := LineEnding + AExpression;
if (RE = Nil) then
Expand Down Expand Up @@ -3504,5 +3529,9 @@ initialization
{$IFDEF FPC}
RegisterTest(TTestRegexpr);
{$ENDIF}
{$IFDEF NOTUSINGDUNITX}
RegisterTest(TTestRegexpr.Suite);
{$ENDIF}

end.

0 comments on commit b2fe07d

Please sign in to comment.