Quellcode durchsuchen

* Delphi-compatible Record-based Regex API

Michaël Van Canneyt vor 1 Jahr
Ursprung
Commit
09397bd542

+ 2 - 0
packages/vcl-compat/fpmake.pp

@@ -66,6 +66,8 @@ begin
     T.ResourceStrings := True;
     T:=P.Targets.AddUnit('system.regularexpressionscore.pp',[Win64,Linux,darwin]);
     T.Dependencies.AddUnit('system.regularexpressionsconsts',[Win64,Linux,darwin]);
+    T:=P.Targets.AddUnit('system.regularexpressions.pp',[Win64,Linux,darwin]);
+    T.Dependencies.AddUnit('system.regularexpressionscore',[Win64,Linux,darwin]);
 
 
 {$ifndef ALLPACKAGES}

+ 851 - 0
packages/vcl-compat/src/system.regularexpressions.pp

@@ -0,0 +1,851 @@
+{
+    This file is part of the Free Component Library (FCL)
+    Copyright (c) 2023 The Free Pascal team
+
+    Delphi-compatible Record based Regular expressions API unit.
+
+    See the file COPYING.FPC, included in this distribution,
+    for details about the copyright.
+
+    This program is distributed in the hope that it will be useful,
+    but WITHOUT ANY WARRANTY; without even the implied warranty of
+    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
+
+ **********************************************************************}
+unit System.RegularExpressions;
+
+{$mode objfpc}
+{$modeswitch advancedrecords}
+
+interface
+
+uses
+{$IFDEF FPC_DOTTEDUNITS}
+  System.SysUtils, System.RegularExpressionsCore;
+{$ELSE}
+  SysUtils, System.RegularExpressionsCore;
+{$ENDIF}
+
+const
+  MatchGrowDelta = 32;
+
+type
+  TRegExOption = (roNone, roIgnoreCase, roMultiLine, roExplicitCapture,
+                  roCompiled, roSingleLine, roIgnorePatternSpace, roNotEmpty);
+  TRegExOptions = set of TRegExOption;
+  TREStringDynArray = Array of TREString;
+
+  IObjectReference = Interface ['{69E6C6D3-764F-4A6F-BC3D-5F4E32A2E4F4}']
+    Function GetObject : TObject;
+  end;
+
+  { TObjectReference }
+
+  TObjectReference = Class(TInterfacedObject,IObjectReference)
+  Private
+    FObject : TObject;
+  Protected
+    Function GetObject : TObject;
+  Public
+    Constructor Create(aObject : TObject);
+    Destructor Destroy; override;
+    Property Obj : TObject Read GetObject;
+  end;
+
+
+  { TGroup }
+
+  TGroup = record
+  private
+    FIndex: Integer;
+    FLength: Integer;
+    FName: TREString;
+    FSuccess: Boolean;
+    FValue: TREString;
+  public
+    constructor Create(const aValue,aName: TREString; aIndex, aLength: Integer; aSuccess: Boolean);
+    property Index: Integer read FIndex;
+    property Length: Integer read FLength;
+    property Success: Boolean read FSuccess;
+    property Value: TREString read FValue;
+    property Name: TREString read FName;
+  end;
+  TGroupArray = Array of TGroup;
+
+  TGroupCollectionEnumerator = class;
+
+  { TGroupCollection }
+
+  TGroupCollection = record
+  private
+    FGroups : TGroupArray;
+    function GetCount: Integer;
+    function GetItem(const aIndex: Variant): TGroup;
+    function IndexOfName(const aName : TREString): Integer;
+  public
+    constructor Create(const aGroups : TGroupArray);
+    function GetEnumerator: TGroupCollectionEnumerator;
+    property Count: Integer read GetCount;
+    property Item[const Index: Variant]: TGroup read GetItem; default;
+  end;
+
+  { TGroupCollectionEnumerator }
+
+  TGroupCollectionEnumerator = class
+  private
+    FGroups: TGroupCollection;
+    FCurrent: Integer;
+  public
+    constructor Create(const aGroups: TGroupCollection);
+    function GetCurrent: TGroup;
+    function MoveNext: Boolean;
+    property Current: TGroup read GetCurrent;
+  end;
+
+  { TMatch }
+
+  PMatch = ^TMatch;
+  TMatch = record
+  private
+    FGroup: TGroup;
+    FGroups: TGroupCollection;
+    FRegex : IObjectReference;
+    FNext: PMatch;
+    function GetIndex: Integer;
+    function GetLength: Integer;
+    function GetSuccess: Boolean;
+    function GetValue: TREString;
+    procedure SetNext(const aNext: PMatch);
+  public
+    constructor Create(const aRegex: IObjectReference; const aValue: TREString; aIndex, aLength: Integer; aSuccess: Boolean);
+    function NextMatch: TMatch;
+    function Result_(const Pattern: TREString): TREString;
+    property Groups: TGroupCollection read FGroups;
+    property Index: Integer read GetIndex;
+    property Length: Integer read GetLength;
+    property Success: Boolean read GetSuccess;
+    property Value: TREString read GetValue;
+  end;
+  TMatchArray = array of TMatch;
+
+  TMatchCollectionEnumerator = class;
+
+  { TMatchCollection }
+
+  TMatchCollection = record
+  private
+    FMatches: TMatchArray;
+    function GetCount: Integer;
+    function GetItem(Index: Integer): TMatch;
+  public
+    constructor Create(const aRegex : IObjectReference; const aInput: TREString; aOptions: TRegExOptions; aStartPos: Integer);
+    function GetEnumerator: TMatchCollectionEnumerator;
+    property Count: Integer read GetCount;
+    property Item[Index: Integer]: TMatch read GetItem; default;
+  end;
+
+  { TMatchCollectionEnumerator }
+
+  TMatchCollectionEnumerator = class
+  private
+    FCollection: TMatchCollection;
+    FCurrent: Integer;
+  public
+    constructor Create(const aCollection: TMatchCollection);
+    function GetCurrent: TMatch;
+    function MoveNext: Boolean;
+    property Current: TMatch read GetCurrent;
+  end;
+
+  TMatchEvaluator = function(const Match: TMatch): TREString of object;
+
+  { TRegEx }
+
+
+  TRegEx = record
+  private
+    FOptions: TRegExOptions;
+    FRef: IObjectReference;
+    FRegEx: TPerlRegEx;
+  public
+    constructor Create(const aPattern: TREString; aOptions: TRegExOptions = [roNotEmpty]);
+    function IsMatch(const aInput: TREString): Boolean; overload;
+    function IsMatch(const aInput: TREString; aStartPos: Integer): Boolean; overload;
+    class function IsMatch(const aInput, aPattern: TREString): Boolean;overload; static;
+    class function IsMatch(const aInput, aPattern: TREString; aOptions: TRegExOptions): Boolean; overload; static;
+
+    class function Escape(const aString: TREString; aUseWildCards: Boolean = False): TREString; static;
+
+    function Match(const aInput: TREString): TMatch; overload;
+    function Match(const aInput: TREString; aStartPos: Integer): TMatch; overload;
+    function Match(const aInput: TREString; aStartPos, aLength: Integer): TMatch; overload;
+    class function Match(const aInput, aPattern: TREString): TMatch; overload; static;
+    class function Match(const aInput, aPattern: TREString; aOptions: TRegExOptions): TMatch; overload; static;
+
+    function Matches(const aInput: TREString): TMatchCollection; overload;
+    function Matches(const aInput: TREString; aStartPos: Integer): TMatchCollection; overload;
+    class function Matches(const aInput, aPattern: TREString): TMatchCollection; overload; static;
+    class function Matches(const aInput, aPattern: TREString; aOptions: TRegExOptions): TMatchCollection; overload; static;
+
+    function Replace(const aInput, aReplacement: TREString): TREString; overload;
+    function Replace(const aInput: TREString; aEvaluator: TMatchEvaluator): TREString; overload;
+    function Replace(const aInput, aReplacement: TREString; aCount: Integer): TREString; overload;
+    function Replace(const aInput: TREString; aEvaluator: TMatchEvaluator; aCount: Integer): TREString; overload;
+    class function Replace(const aInput, aPattern, aReplacement: TREString): TREString; overload; static;
+    class function Replace(const aInput, aPattern: TREString; aEvaluator: TMatchEvaluator): TREString; overload; static;
+    class function Replace(const aInput, aPattern, aReplacement: TREString; aOptions: TRegExOptions): TREString; overload; static;
+    class function Replace(const aInput, aPattern: TREString; aEvaluator: TMatchEvaluator; aOptions: TRegExOptions): TREString; overload; static;
+
+    function Split(const aInput: TREString): TREStringDynArray; overload; inline;
+    function Split(const aInput: TREString; aCount: Integer): TREStringDynArray; overload; inline;
+    function Split(const aInput: TREString; aCount, aStartPos: Integer): TREStringDynArray; overload;
+    class function Split(const aInput, aPattern: TREString): TREStringDynArray; overload; static;
+    class function Split(const aInput, aPattern: TREString; aOptions: TRegExOptions): TREStringDynArray; overload; static;
+  end;
+
+                                                                     
+  { TRegExHelper }
+
+  TRegExHelper = record helper for TRegEx
+  public
+    procedure Study(Options: TRegExStudyOptions = []);
+    procedure AddRawOptions(const Value: Integer);
+  end;
+
+function RegExOptionsToPCREOptions(Value: TRegExOptions): TPerlRegExOptions;
+
+implementation
+
+uses
+{$IFDEF FPC_DOTTEDUNITS}
+  System.Classes, System.Variants, System.RegularExpressionsConsts;
+{$ELSE}
+  Classes, Variants, System.RegularExpressionsConsts;
+{$ENDIF}
+
+Type
+
+  { TMatcher }
+
+  TMatcher = Class(TObject)
+    FMatchEvaluator: TMatchEvaluator;
+    FRef: IObjectReference;
+    Constructor Create(AMatchEvaluator: TMatchEvaluator; aRef: IObjectReference);
+    procedure ReplaceEvent(Sender: TObject; var ReplaceWith: TREString);
+  end;
+
+Function GetRegEx(aRef : IObjectReference) : TPerlRegEx; inline;
+
+begin
+  Result:=aRef.GetObject as TPerlRegex;
+end;
+
+function RegExOptionsToPCREOptions(Value: TRegExOptions): TPerlRegExOptions;
+
+ Procedure Add(aFlag : TRegExOption; aOpt : TPerlRegExOption);
+
+ begin
+   if aFlag in Value then
+     Include(Result,aOpt);
+ end;
+
+begin
+  Result := [];
+  Add(roIgnoreCase,preCaseLess);
+  Add(roMultiLine,preMultiLine);
+  Add(roExplicitCapture,preNoAutoCapture);
+  Add(roSingleLine,preSingleLine);
+  Add(roIgnorePatternSpace,preExtended);
+end;
+
+{ TMatcher }
+
+constructor TMatcher.Create(AMatchEvaluator: TMatchEvaluator; aRef: IObjectReference);
+begin
+  FMatchEvaluator:=AMatchEvaluator;
+  FRef:=aRef;
+end;
+
+procedure TMatcher.ReplaceEvent(Sender: TObject; var ReplaceWith: TREString);
+
+var
+  M: TMatch;
+  RE : TPerlRegEx;
+
+begin
+  if Assigned(FMatchEvaluator) then
+    begin
+    RE:=Sender as TPerlRegEx;
+    M:=TMatch.Create(FRef,RE.MatchedText,RE.MatchedOffset,Re.MatchedLength,True);
+    ReplaceWith:=FMatchEvaluator(M);
+    end;
+end;
+
+{ TObjectReference }
+
+function TObjectReference.GetObject: TObject;
+begin
+  Result:=FObject;
+end;
+
+constructor TObjectReference.Create(aObject: TObject);
+begin
+  FObject:=aObject;
+end;
+
+destructor TObjectReference.Destroy;
+begin
+  FreeAndNil(FObject);
+  inherited Destroy;
+end;
+
+
+
+{ TGroup }
+
+constructor TGroup.Create(const aValue, aName: TREString; aIndex, aLength: Integer; aSuccess: Boolean);
+begin
+  FValue:=aValue;
+  FIndex:=aIndex;
+  FLength:=aLength;
+  FSuccess:=aSuccess;
+  FName:=aName;
+end;
+
+{ TGroupCollectionEnumerator }
+
+constructor TGroupCollectionEnumerator.Create(const aGroups: TGroupCollection);
+begin
+  FGroups:=aGroups;
+  FCurrent:=-1;
+end;
+
+function TGroupCollectionEnumerator.GetCurrent: TGroup;
+begin
+  Result:=FGroups.FGroups[FCurrent];
+end;
+
+function TGroupCollectionEnumerator.MoveNext: Boolean;
+begin
+  Result:=FCurrent<Length(FGroups.FGroups)-1;
+  if Result then
+    Inc(FCurrent);
+end;
+
+{ TMatch }
+
+function TMatch.GetIndex: Integer;
+begin
+  Result:=FGroup.Index;
+end;
+
+
+function TMatch.GetLength: Integer;
+begin
+  Result:=FGroup.Length;
+end;
+
+function TMatch.GetSuccess: Boolean;
+begin
+  Result:=FGroup.Success;
+end;
+
+function TMatch.GetValue: TREString;
+begin
+  Result:=FGRoup.Value;
+end;
+
+procedure TMatch.SetNext(const aNext: PMatch);
+begin
+  FRegex:=Nil;
+  FNext:=aNext;
+end;
+
+constructor TMatch.Create(const aRegex: IObjectReference; const aValue: TREString; aIndex, aLength: Integer; aSuccess: Boolean);
+
+var
+  N : TREStringDynArray;
+  G : TGroupArray;
+  RE : TPerlRegEx;
+  i,idx : Integer;
+  GN : TREString;
+
+begin
+  G:=Default(TGroupArray);
+  N:=Default(TREStringDynArray);
+  FRegex:=aRegex;
+  FGroup:=TGroup.Create(aValue,'',aIndex,aLength,aSuccess);
+  if Success then
+    begin
+    RE:=GetRegEx(FRegEx);
+    SetLength(N,RE.GroupCount+1);
+    For I:=0 to RE.NameCount-1 do
+      begin
+      GN:=RE.Names[i];
+      Idx:=RE.NamedGroup(GN);
+      if Idx<>-1 then
+        N[Idx]:=GN;
+      end;
+    SetLength(G,RE.GroupCount+1);
+    For I:=0 to RE.GroupCount do
+      G[i]:=TGroup.Create(RE.Groups[I],N[i],RE.GroupOffsets[i],RE.GroupLengths[I],aSuccess);
+    end;
+  FGroups:=TGroupCollection.Create(G);
+end;
+
+function TMatch.NextMatch: TMatch;
+
+var
+  RE : TPerlRegEx;
+
+begin
+  if Assigned(FRegex) then
+    begin
+    RE:=GetRegEx(FRegex);
+    if RE.MatchAgain then
+      Result:=TMatch.Create(FRegex,RE.MatchedText,RE.MatchedOffset,RE.MatchedLength,True)
+    else
+      Result:=TMatch.Create(FRegex,'',0,0,False);
+    end
+  else if Assigned(FNext) then
+    Result:=FNext^
+  else
+    Result:=TMatch.Create(FRegex,'',0,0,False);
+end;
+
+function TMatch.Result_(const Pattern: TREString): TREString;
+
+var
+  RE: TPerlRegEx;
+
+begin
+  RE:=GetRegEx(FRegex);
+  RE.Replacement:=Pattern;
+  Result:=RE.ComputeReplacement;
+end;
+
+{ TMatchCollection }
+
+constructor TMatchCollection.Create(const aRegex: IObjectReference; const aInput: TREString; aOptions: TRegExOptions;
+  aStartPos: Integer);
+
+var
+  Found: Boolean;
+  Len : Integer;
+  RE: TPerlRegEx;
+begin
+  RE:=GetRegEx(aRegex);
+  RE.Subject:=aInput;
+  RE.Options:=RegExOptionsToPCREOptions(AOptions);
+  RE.Start:=aStartPos;
+  Len:=0;
+  SetLength(FMatches,0);
+  Found:=RE.Match;
+  while Found do
+    begin
+    if Len>=Length(FMatches) then
+      SetLength(FMatches,Length(FMatches)+MatchGrowDelta);
+    FMatches[Len]:=TMatch.Create(aRegex,RE.MatchedText,RE.MatchedOffset,RE.MatchedLength,Found);
+    if Len>0 then
+      FMatches[Len-1].SetNext(@FMatches[Len]);
+    Found:=RE.MatchAgain;
+    Inc(Len);
+    end;
+  FMatches[Len-1].SetNext(Nil);
+  if Len<Length(FMatches) then
+    SetLength(FMatches,Len);
+end;
+
+function TMatchCollection.GetCount: Integer;
+begin
+  Result:=Length(FMatches);
+end;
+
+function TMatchCollection.GetItem(Index: Integer): TMatch;
+begin
+  Result:=FMatches[Index];
+end;
+
+function TMatchCollection.GetEnumerator: TMatchCollectionEnumerator;
+begin
+  Result:=TMatchCollectionEnumerator.Create(Self);
+end;
+
+{ TMatchCollectionEnumerator }
+
+constructor TMatchCollectionEnumerator.Create(const aCollection: TMatchCollection);
+begin
+  FCollection:=aCollection;
+  FCurrent:=-1;
+end;
+
+function TMatchCollectionEnumerator.GetCurrent: TMatch;
+begin
+  Result:=FCollection.FMatches[FCurrent];
+end;
+
+function TMatchCollectionEnumerator.MoveNext: Boolean;
+begin
+  Result:=FCurrent<Length(FCollection.FMatches)-1;
+  If Result then
+    Inc(FCurrent);
+end;
+
+{ TRegEx }
+
+constructor TRegEx.Create(const aPattern: TREString; aOptions: TRegExOptions);
+begin
+  FRegEx:=TPerlRegEx.Create;
+  Foptions:=aOPtions;
+  FRegex.Options:=RegExOptionsToPCREOptions(aOptions);
+  FRegex.RegEx:=aPattern;
+  FRef:=TObjectReference.Create(FRegex);
+end;
+
+function TRegEx.IsMatch(const aInput: TREString): Boolean;
+begin
+  Result:=IsMatch(aInput,1);
+end;
+
+function TRegEx.IsMatch(const aInput: TREString; aStartPos: Integer): Boolean;
+begin
+  FRegex.Subject:=aInput;
+  FRegex.Start:=aStartPos;
+  Result:=FRegex.Match;
+end;
+
+class function TRegEx.IsMatch(const aInput, aPattern: TREString): Boolean;
+
+begin
+  Result:=IsMatch(aInput,aPattern,[roNotEmpty]);
+end;
+
+class function TRegEx.IsMatch(const aInput, aPattern: TREString; aOptions: TRegExOptions): Boolean;
+
+var
+  RE : TRegEx;
+begin
+  RE:=TRegex.Create(aPattern,aOptions);
+  Result:=RE.IsMatch(aInput);
+end;
+
+class function TRegEx.Escape(const aString: TREString; aUseWildCards: Boolean): TREString;
+
+  function esc(const s : TREString; c : char; rep : string) : string;
+  begin
+    Result:=StringReplace(s,'\'+c,rep,[rfReplaceAll]);
+    Result:=StringReplace(Result,Rep+rep,'\'+c,[rfReplaceAll]);
+  end;
+
+begin
+  Result:=TPerlRegEx.EscapeRegExChars(aString);
+  Result:=StringReplace(Result,#13#10,'\r\n',[rfReplaceAll]);
+  if Not aUseWildCards then
+    exit;
+  Result:=Esc(Result,'?','(.)');
+  Result:=Esc(Result,'*','(.*)');
+end;
+
+function TRegEx.Match(const aInput: TREString): TMatch;
+begin
+  Result:=Match(aInput,1,Length(aInput));
+end;
+
+function TRegEx.Match(const aInput: TREString; aStartPos: Integer): TMatch;
+begin
+  Result:=Match(aInput,aStartPos,Length(aInput));
+end;
+
+function TRegEx.Match(const aInput: TREString; aStartPos, aLength: Integer): TMatch;
+var
+  Found: Boolean;
+  L,O : Integer;
+  S : TREString;
+
+begin
+  L:=0;
+  O:=0;
+  S:='';
+  With FRegEx do
+    begin
+    Subject:=aInput;
+    FRegex.Start:=aStartPos;
+    FRegex.Stop:=aStartPos+aLength-1;
+    Found:=Match;
+    if Found then
+      begin
+      S:=MatchedText;
+      O:=MatchedOffset;
+      L:=MatchedLength;
+      end;
+    end;
+  Result:=TMatch.Create(FRef,S,O,L,Found);
+end;
+
+class function TRegEx.Match(const aInput, aPattern: TREString): TMatch;
+
+var
+  RE : TRegEx;
+begin
+  RE:=TRegex.Create(aPattern);
+  Result:=RE.Match(aInput);
+end;
+
+class function TRegEx.Match(const aInput, aPattern: TREString; aOptions: TRegExOptions): TMatch;
+
+var
+  RE : TRegEx;
+
+begin
+  RE:=TRegex.Create(aPattern,aOptions);
+  Result:=RE.Match(aInput);
+end;
+
+function TRegEx.Matches(const aInput: TREString): TMatchCollection;
+
+begin
+  Result:=TMatchCollection.Create(FRef,aInput,FOptions,1);
+end;
+
+function TRegEx.Matches(const aInput: TREString; aStartPos: Integer): TMatchCollection;
+begin
+  Result:=TMatchCollection.Create(FRef,aInput,FOptions,aStartPos);
+end;
+
+class function TRegEx.Matches(const aInput, aPattern: TREString): TMatchCollection;
+
+var
+  RE: TRegEx;
+
+begin
+  RE:=TRegEx.Create(aPattern);
+  Result:=RE.Matches(aInput);
+end;
+
+class function TRegEx.Matches(const aInput, aPattern: TREString; aOptions: TRegExOptions): TMatchCollection;
+var
+  RE: TRegEx;
+
+begin
+  RE:=TRegEx.Create(aPattern,aOptions);
+  Result:=RE.Matches(aInput);
+end;
+
+function TRegEx.Replace(const aInput, aReplacement: TREString): TREString;
+begin
+  FRegEx.Subject:=aInput;
+  FRegEx.Replacement:=aReplacement;
+  FRegEx.ReplaceAll;
+  Result:=FRegEx.Subject;
+end;
+
+function TRegEx.Replace(const aInput: TREString; aEvaluator: TMatchEvaluator): TREString;
+
+var
+  M : TMatcher;
+
+begin
+  FRegEx.Subject:=aInput;
+  M:=TMatcher.Create(aEvaluator,FRef);
+  try
+    FRegEx.OnReplace:[email protected];
+    FRegEx.ReplaceAll;
+    Result := FRegEx.Subject;
+  finally
+    M.Free;
+  end;
+end;
+
+function TRegEx.Replace(const aInput, aReplacement: TREString; aCount: Integer): TREString;
+
+var
+  I: Integer;
+
+begin
+  if aCount<0 then
+    Exit(Replace(aInput,aReplacement));
+  I:=0;
+  FRegEx.Subject:=aInput;
+  FRegEx.Replacement:=aReplacement;
+  if FRegEx.Match then
+    repeat
+      Inc(I);
+      FRegEx.Replace;
+    until (not FRegEx.MatchAgain) or (I>=aCount);
+  Result:=FRegEx.Subject;
+end;
+
+function TRegEx.Replace(const aInput: TREString; aEvaluator: TMatchEvaluator; aCount: Integer): TREString;
+
+var
+  M : TMatcher;
+  I : integer;
+
+begin
+  FRegEx.Subject:=aInput;
+  M:=TMatcher.Create(aEvaluator,FRef);
+  try
+    I:=0;
+    FRegEx.Subject:=aInput;
+    FRegEx.OnReplace:[email protected];
+    if FRegEx.Match then
+      repeat
+        Inc(I);
+        FRegEx.Replace;
+      until (not FRegEx.MatchAgain) or (I>=aCount);
+    Result:=FRegEx.Subject;
+  finally
+    M.Free;
+  end;
+end;
+
+class function TRegEx.Replace(const aInput, aPattern, aReplacement: TREString): TREString;
+
+var
+  RE : TRegex;
+
+begin
+  RE:=TRegex.Create(aPattern);
+  Result:=RE.Replace(aInput,aReplacement);
+end;
+
+class function TRegEx.Replace(const aInput, aPattern: TREString; aEvaluator: TMatchEvaluator): TREString;
+begin
+  Result:=Replace(aInput,aPattern,aEvaluator,[roNotEmpty]);
+end;
+
+class function TRegEx.Replace(const aInput, aPattern, aReplacement: TREString; aOptions: TRegExOptions): TREString;
+var
+  RE : TRegex;
+
+begin
+  RE:=TRegex.Create(aPattern,aOptions);
+  Result:=RE.Replace(aInput,aReplacement);
+end;
+
+class function TRegEx.Replace(const aInput, aPattern: TREString; aEvaluator: TMatchEvaluator; aOptions: TRegExOptions): TREString;
+
+var
+  RE: TRegEx;
+
+begin
+  RE:=TRegEx.Create(aPattern,aOptions);
+  Result:=RE.Replace(aInput,aEvaluator);
+end;
+
+function TRegEx.Split(const aInput: TREString): TREStringDynArray;
+begin
+  Result:=Split(aInput,0,1);
+end;
+
+function TRegEx.Split(const aInput: TREString; aCount: Integer): TREStringDynArray;
+begin
+  Result:=Split(aInput,aCount,1);
+end;
+
+function TRegEx.Split(const aInput: TREString; aCount, aStartPos: Integer): TREStringDynArray;
+
+var
+  L: TStrings;
+
+begin
+  Result:=Default(TREStringDynArray);
+  if aInput='' then
+    exit;
+  FRegEx.Subject:=aInput;
+  Result:=FRegEx.SplitCapture(aCount,aStartPos);
+end;
+
+class function TRegEx.Split(const aInput, aPattern: TREString): TREStringDynArray;
+
+var
+  RE: TRegEx;
+
+begin
+  RE:=TRegEx.Create(aPattern);
+  Result:= RE.Split(aInput);
+end;
+
+class function TRegEx.Split(const aInput, aPattern: TREString; aOptions: TRegExOptions): TREStringDynArray;
+var
+  RE: TRegEx;
+
+begin
+  RE:=TRegEx.Create(aPattern,aOptions);
+  Result:=RE.Split(aInput);
+end;
+
+{ TRegExHelper }
+
+procedure TRegExHelper.Study(Options: TRegExStudyOptions);
+begin
+
+end;
+
+procedure TRegExHelper.AddRawOptions(const Value: Integer);
+begin
+
+end;
+
+
+function TGroupCollection.GetCount: Integer;
+begin
+  Result:=Length(FGroups);
+end;
+
+function TGroupCollection.GetItem(const aIndex: Variant): TGroup;
+
+var
+  Idx: Integer;
+  IdxIsName : Boolean;
+begin
+  IdxIsName:=False;
+  Idx:=-1;
+  case VarType(aIndex) of
+    varByte,
+    varWord,
+    varLongWord,
+    varQWord,
+    varSmallint,
+    varShortInt,
+    varInteger,
+    varInt64:
+      Idx:=aIndex;
+    varString,
+    varUString,
+    varOleStr:
+      begin
+      Idx:=IndexOfName(TREString(aIndex));
+      idxIsName:=True;
+      end
+  else
+    raise ERegularExpressionError.Create(SRegExInvalidIndexType);
+  end;
+
+  if (Idx>=0) and (Idx<Length(FGroups)) then
+    Result:=FGroups[Idx]
+  else if (Idx=-1) and (IdxIsName) then
+    raise ERegularExpressionError.CreateFmt(SRegExInvalidGroupName,[TREString(aIndex)])
+  else
+    raise ERegularExpressionError.CreateFmt(SRegExIndexOutOfBounds,[Idx]);
+end;
+
+function TGroupCollection.IndexOfName(const aName: TREString): Integer;
+begin
+  Result:=Length(FGroups)-1;
+  While (Result>=0) and (FGroups[Result].Name<>'') and Not SameText(aName,FGroups[Result].Name) do
+    Dec(Result);
+end;
+
+constructor TGroupCollection.Create(const aGroups: TGroupArray);
+
+begin
+  FGroups:=aGroups;
+end;
+
+function TGroupCollection.GetEnumerator: TGroupCollectionEnumerator;
+begin
+  Result:=TGroupCollectionEnumerator.Create(Self);
+end;
+
+end.

+ 12 - 11
packages/vcl-compat/src/system.regularexpressionsconsts.pp

@@ -3,18 +3,19 @@ unit System.RegularExpressionsConsts;
 interface
 
 resourcestring
-  SRegExExpressionError   = 'Error in regular expression at offset %d: %s';
-  SRegExIndexOutOfBounds  = 'Index out of bounds (%d)';
-  SRegExInvalidGroupName  = 'Invalid group name (%s)';
-  SRegExInvalidIndexType  = 'Invalid index type';
-  SRegExMatchRequired     = 'Successful match required';
-  SRegExMatchError        = 'Error matching the regex: %s';
-  SRegExMissingExpression = 'A regular expression specified in RegEx is required';
-  SRegExStringsRequired   = 'Strings parameter cannot be nil';
-  SRegExStudyError        = 'Error studying the regex: %s';
+  SRegExExpressionError    = 'Error in regular expression at offset %d: %s';
+  SRegExIndexOutOfBounds   = 'Index out of bounds (%d)';
+  SRegExInvalidGroupName   = 'Invalid group name (%s)';
+  SRegExInvalidIndexType   = 'Invalid index type';
+  SRegExMatchRequired      = 'Successful match required';
+  SRegExMatchError         = 'Error matching the regex: %s';
+  SRegExMissingExpression  = 'A regular expression specified in RegEx is required';
+  SRegExStringsRequired    = 'Strings parameter cannot be nil';
+  SRegExStudyError         = 'Error studying the regex: %s';
   SErrRegexOvectorTooSmall = 'output vector was not big enough for all the captured substrings';
-  SRegExMatcStartAfterEnd = '\K was used in an assertion to set the match start after its end.'+sLineBreak+
-                            'From end to start the match was: %s';
+  SRegExMatcStartAfterEnd  = '\K was used in an assertion to set the match start after its end.'+sLineBreak+
+                             'From end to start the match was: %s';
+  SErrInvalidNameIndex     = 'Invalid group name index: %d, valid range = [0..%d[';
 
 implementation
 

+ 98 - 15
packages/vcl-compat/src/system.regularexpressionscore.pp

@@ -51,6 +51,7 @@ type
   {$ElSE}
   TREString = AnsiString;
   {$ENDIF}
+  TREStringDynArray = Array of TREString;
 
   TPerlRegExOption = (preCaseLess,preMultiLine,preSingleLine,preExtended,preAnchored,preUnGreedy,preNoAutoCapture,
                       preAllowEmptyClass, preAltBSUX, preAltCircumFlex, preAltVerbNames,
@@ -71,7 +72,7 @@ type
   Private
     Type
       TTransformation = (tNone,tLowerCase,tUpperCase,tFirstCap,tInitialCap);
-
+      TMatchResult = (mrFound,mrNotFound,mrAfterStop);
     class function TransForm(aTransform: TTransformation; const S: TREString): TREString;
   private
   {$IFDEF USEWIDESTRING}
@@ -102,7 +103,7 @@ type
     FCrLFIsNewLine,
     FIsUtf : Boolean;
     Procedure CheckMatch; inline;
-    function DoMatch(Opts: CUInt32): Boolean;
+    function DoMatch(Opts: CUInt32): TMatchResult;
     function GetBackRefIndex(const Ref: TREString; var I: Integer): Integer;
     function GetCompiled: Boolean;
     function GetFoundMatch: Boolean; inline;
@@ -116,6 +117,7 @@ type
     function GetModifiedSubject: TREString;
     function GetNamedGroup(const aName : TREString): TREString;
     procedure GetNamedGroupInfo;
+    function GetNames(aIndex : Integer): TREString;
     function GetPCREErrorMsg(ErrorNr: Integer): TREString;
     function GetResultString(aIndex: Integer): TREString;
     function GetStart: Integer;
@@ -161,12 +163,16 @@ type
     // Index in groups of name.
     function NamedGroup(const aName: TREString): Integer;
     // Split subject TREString based on regex. aStrings will contain everything outside the matches.
-    procedure Split(const aStrings: TStrings; aLimit: Integer);
+    procedure Split(const aStrings: TStrings; aLimit: Integer = 0);
+    // Split subject TREString based on regex. Result will contain everything outside the matches.
+    function Split(aLimit: Integer = 0) : TREStringDynArray;
     // Split subject TREString based on regex, but include matches in result.
     procedure SplitCapture(const aStrings: TStrings; aLimit: Integer); overload;
     // Split subject TREString based on regex, but include matches in result.
     // if aoffset is > 1 then everything till offset is put in the first TREString.
     procedure SplitCapture(const aStrings: TStrings; aLimit: Integer; aOffset : Integer); overload;
+    // Same with result in array
+    function SplitCapture(aLimit: Integer; aOffset : Integer) : TREStringDynArray; overload;
     // Was the regex compiled ?
     property Compiled: Boolean read GetCompiled;
     // Match found ?
@@ -191,6 +197,9 @@ type
     property GroupOffsets[aIndex: Integer]: Integer read GetGroupOffsets;
     // Named access to groups.
     property NamedGroups[aName : TREString] : TREString Read GetNamedGroup;
+    // Names available in current match.
+    Property NameCount : Cardinal Read FNameCount;
+    Property Names[aIndex : Integer] : TREString Read GetNames;
     // Subject TREString. Will be modified by replace !
     property Subject: TREString read GetModifiedSubject write SetSubject;
     // Original subject TREString. Not modified by replace !
@@ -415,6 +424,7 @@ begin
   Result:=FModifiedSubject;
 end;
 
+
 function TPerlRegEx.GetNamedGroup(const aName: TREString): TREString;
 
 var
@@ -491,6 +501,8 @@ begin
   FSubjectLength:=Length(FSubject);
   FModifiedSubject:=aValue;
   CleanUp;
+  FStart:=0;
+  FStop:=Length(FSubject);
 end;
 
 procedure TPerlRegEx.CleanUp;
@@ -500,8 +512,6 @@ begin
   ClearStoredGroups;
   FResultCount:=0;
   FResultVector:=Nil;
-  FStart:=0;
-  FStop:=Length(FSubject);
   FLastModifiedEnd:=0;
 end;
 
@@ -692,6 +702,27 @@ begin
     @FNameEntrySize);
 end;
 
+function TPerlRegEx.GetNames(aIndex : Integer): TREString;
+var
+  Ptr : PCRE2_SPTR;
+  N,I : Integer;
+  tblName : TREString;
+
+begin
+  Ptr:=FNameTable;
+  if (aIndex<0) or (aIndex>FNameCount) then
+    Raise ERegularExpressionError.CreateFmt(SErrInvalidNameIndex,[aIndex,FNameCount]);
+  for i:=0 to aIndex-1 do
+    Inc(Ptr,FNameEntrySize);
+{$IFDEF USEWIDESTRING}
+  n:=ord(ptr[0]);
+  Result:=GetStrLen((Ptr+1),FNameEntrySize-2);
+{$ELSE}
+  n:=(ord(ptr[0]) shl 8) or ord(ptr[1]);
+  Result:=GetStrLen((Ptr+2),FNameEntrySize-3);
+{$ENDIF}
+end;
+
 function TPerlRegEx.Match: Boolean;
 
 var
@@ -703,8 +734,8 @@ begin
   if not Compiled then
     Compile;
   FMatchData:=pcre2_match_data_create_from_pattern(FCode,Nil);
-  Result:=DoMatch(0);
-  if Result then
+  Result:=DoMatch(0)=mrFound;
+  if Result  then
     begin
     pcre2_pattern_info(FCode,PCRE2_INFO_ALLOPTIONS, @option_bits);
     FIsUtf:=((option_bits and PCRE2_UTF) <> 0);
@@ -716,14 +747,14 @@ begin
 end;
 
 
-function TPerlRegEx.DoMatch(Opts : CUInt32): Boolean;
+function TPerlRegEx.DoMatch(Opts : CUInt32): TMatchResult;
 
 var
   len,rc : cInt;
   S : TREString;
 
 begin
-  Result:=False;
+  Result:=mrNotFound;
 {$IF SIZEOF(CHAR)=2}
   rc:=pcre2_match_w(
 {$ELSE}
@@ -741,15 +772,17 @@ begin
     FreeMatchData;
     FreeCodeData;
     if (rc=PCRE2_ERROR_NOMATCH) then
-      Exit(False)
+      Exit(mrNotFound)
     else if (rc = 0) then
       raise ERegularExpressionError.CreateFmt(SRegExMatchError,[SErrRegexOvectorTooSmall])
     else
       raise ERegularExpressionError.CreateFmt(SRegExMatchError,[GetPCREErrorMsg(rc)]);
     end;
-  Result:=True;
+  Result:=mrFound;
   FResultCount:=rc;
   FResultVector:=pcre2_get_ovector_pointer(FMatchData);
+  if FResultVector[0]>FStop then
+    Exit(mrAfterStop);
   {For i:=0 to FResultCount-1 do
     Writeln(I,': ',FResultVector[2*I],' - ',FResultVector[2*I+1]);}
   if (FResultVector[0]>FResultVector[1]) then
@@ -804,7 +837,12 @@ begin
         end;
       end;
     end;
-  Result:=DoMatch(Opts);
+  // If we're behind stop, exit at once.
+  Case DoMatch(Opts) of
+    mrAfterStop : Exit(False);
+    mrNotFound : Result:=False;
+    mrFound: Result:=True;
+  end;
   (*
     This time, a result of NOMATCH isn't an error. If the value in 'options'
     is zero, it just means we have found all possible matches, so the loop ends.
@@ -838,7 +876,15 @@ begin
         inc(FResultVector[1]);
         end;
       end;
-    Result:=DoMatch(Opts);
+    Case DoMatch(Opts) of
+      mrAfterStop :
+        begin
+        Result:=False;
+        Break;
+        end;
+      mrNotFound : Result:=False;
+      mrFound: Result:=True;
+    end;
     end;
 end;
 
@@ -901,7 +947,7 @@ end;
   On return, I is the index of the next character to process.
 }
 
-Function TPerlRegEx.GetBackRefIndex(const Ref : TREString; var I : Integer) : Integer;
+function TPerlRegEx.GetBackRefIndex(const Ref: TREString; var I: Integer): Integer;
 
 var
   Len,P,N,Group : Integer;
@@ -988,7 +1034,7 @@ begin
   Result:=Group;
 end;
 
-Class function TPerlRegEx.TransForm(aTransform : TTransformation; const S : TREString): TREString;
+class function TPerlRegEx.TransForm(aTransform: TTransformation; const S: TREString): TREString;
 
 begin
   Case aTransform of
@@ -1183,6 +1229,24 @@ begin
   aStrings.Add(TREString(Copy(FSubject,LastEnd+1,FSubjectLength -LastEnd)));
 end;
 
+function TPerlRegEx.Split(aLimit: Integer): TREStringDynArray;
+var
+  L: TStrings;
+  I : integer;
+
+begin
+  L:=TStringList.Create;
+  try
+    Split(L,aLimit);
+    // We cannot use L.ToStringArray, because the string type may differ :/
+    SetLength(Result,L.Count);
+    For I:=0 to L.Count-1 do
+      Result[I]:=L[I];
+  finally
+    L.Free;
+  end;
+end;
+
 procedure TPerlRegEx.SplitCapture(const aStrings: TStrings; aLimit: Integer);
 
 begin
@@ -1223,6 +1287,25 @@ begin
   aStrings.Add(TREString(Copy(FSubject,LastEnd+1,FSubjectLength-LastEnd)));
 end;
 
+function TPerlRegEx.SplitCapture(aLimit: Integer; aOffset: Integer): TREStringDynArray;
+
+var
+  L: TStrings;
+  I : integer;
+
+begin
+  L:=TStringList.Create;
+  try
+    SplitCapture(L,aLimit,aOffset);
+    // We cannot use L.ToStringArray, because the string type may differ :/
+    SetLength(Result,L.Count);
+    For I:=0 to L.Count-1 do
+      Result[I]:=L[I];
+  finally
+    L.Free;
+  end;
+end;
+
 { TPerlRegExList }
 
 function TPerlRegExList.GetCount: Integer;

+ 4 - 0
packages/vcl-compat/tests/testcompat.lpi

@@ -72,6 +72,10 @@
         <Filename Value="utregex.pas"/>
         <IsPartOfProject Value="True"/>
       </Unit>
+      <Unit>
+        <Filename Value="utregexapi.pas"/>
+        <IsPartOfProject Value="True"/>
+      </Unit>
     </Units>
   </ProjectOptions>
   <CompilerOptions>

+ 1 - 1
packages/vcl-compat/tests/testcompat.lpr

@@ -6,7 +6,7 @@ uses
   {$IFDEF UNIX}cwstring,{$ENDIF}
   Classes, consoletestrunner, tcnetencoding, tciotuils, 
   utmessagemanager, utcdevices, utcanalytics, utcimagelist, 
-  utcnotifications, utcjson, utcpush, utchash, utcregex;
+  utcnotifications, utcjson, utcpush, utchash, utcregex, utcregexapi;
 
 type
 

+ 52 - 16
packages/vcl-compat/tests/utcregex.pas

@@ -27,6 +27,8 @@ type
   published
     Procedure TestHookup;
     procedure TestMatch;
+    procedure TestMatchStart;
+    procedure TestMatchStop;
     procedure TestNamedGroups;
     procedure TestReplace;
     procedure TestReplaceAll;
@@ -48,11 +50,16 @@ type
 
 implementation
 
-procedure TTestRegExpCore.AssertMatch(Const Msg,aMatch : TREString; aPos,aLength : Integer; Groups : Array of TREString);
+Const
+  TestStr = 'xyz abba abbba abbbba zyx';
+  TestExpr = 'a(b*)a';
+
+procedure TTestRegExpCore.AssertMatch(const Msg, aMatch: TREString; aPos, aLength: Integer; Groups: array of TREString);
 
 var
   I : Integer;
 begin
+  AssertTrue(Msg+': Found match',Regex.FoundMatch);
   AssertEquals(Msg+': matched text',aMatch,Regex.MatchedText);
   AssertEquals(Msg+': offset',aPos,Regex.MatchedOffset);
   AssertEquals(Msg+': length',aLength,Regex.MatchedLength);
@@ -69,8 +76,8 @@ end;
 procedure TTestRegExpCore.TestMatch;
 
 begin
-  Regex.subject:='xyz abba abbba abbbba zyx';
-  Regex.RegEx:='a(b*)a';
+  Regex.subject:=TestStr;
+  Regex.RegEx:=TestExpr;
   AssertTrue('First match found',Regex.Match);
   AssertEquals('Match event called',1,FMatchEventCount);
   AssertMatch('Match 1','abba',5,4,['bb']);
@@ -84,6 +91,35 @@ begin
   AssertEquals('Match event called',3,FMatchEventCount);
 end;
 
+procedure TTestRegExpCore.TestMatchStart;
+
+begin
+  Regex.subject:=TestStr;
+  Regex.RegEx:=TestExpr;
+  Regex.Start:=Pos('abbba',TestStr);
+  AssertTrue('First match found',Regex.Match);
+  AssertMatch('Match 1','abbba',10,5,['bbb']);
+
+  AssertTrue('Second match found',Regex.MatchAgain);
+  AssertMatch('Match 3','abbbba',16,6,['bbbb']);
+  AssertFalse('No more matches',Regex.MatchAgain);
+
+end;
+
+procedure TTestRegExpCore.TestMatchStop;
+begin
+  Regex.subject:=TestStr;
+  Regex.RegEx:=TestExpr;
+  Regex.Stop:=4;
+  AssertFalse('No match found',Regex.Match);
+  Regex.Stop:=9;
+  AssertTrue('First match found',Regex.Match);
+  AssertEquals('Match event called',1,FMatchEventCount);
+  AssertMatch('Match 1','abba',5,4,['bb']);
+  AssertFalse('No more matches',Regex.MatchAgain);
+  AssertEquals('Match event not called again',1,FMatchEventCount);
+end;
+
 procedure TTestRegExpCore.TestNamedGroups;
 
 Const
@@ -106,8 +142,8 @@ end;
 
 procedure TTestRegExpCore.TestReplace;
 begin
-  Regex.subject:='xyz abba abbba abbbba zyx';
-  Regex.RegEx:='a(b*)a';
+  Regex.subject:=TestStr;
+  Regex.RegEx:=TestExpr;
   Regex.Replacement:='c';
   AssertTrue('First match found',Regex.Match);
   AssertEquals('Replace','c',Regex.Replace);
@@ -123,8 +159,8 @@ end;
 
 procedure TTestRegExpCore.TestReplaceAll;
 begin
-  Regex.subject:='xyz abba abbba abbbba zyx';
-  Regex.RegEx:='a(b*)a';
+  Regex.subject:=TestStr;
+  Regex.RegEx:=TestExpr;
   Regex.Replacement:='c';
   AssertTrue('Replacements done',Regex.ReplaceAll);
   AssertEquals('ReplaceAll result','xyz c c c zyx',Regex.Subject);
@@ -135,7 +171,7 @@ procedure TTestRegExpCore.TestReplaceGroupBackslash;
 // \n
 begin
   Regex.subject:='*abba*';
-  Regex.RegEx:='a(b*)a';
+  Regex.RegEx:=TestExpr;
   Regex.Replacement:='\1';
   AssertTrue('Match',Regex.Match);
   AssertEquals('ReplaceText','bb',Regex.Replace);
@@ -146,7 +182,7 @@ procedure TTestRegExpCore.TestReplaceGroupDollar;
 // $N
 begin
   Regex.subject:='*abba*';
-  Regex.RegEx:='a(b*)a';
+  Regex.RegEx:=TestExpr;
   Regex.Replacement:='$1';
   AssertTrue('Match',Regex.Match);
   AssertEquals('ReplaceText','bb',Regex.Replace);
@@ -157,7 +193,7 @@ procedure TTestRegExpCore.TestReplaceGroupQuoted;
 // \{N}
 begin
   Regex.subject:='*abba*';
-  Regex.RegEx:='a(b*)a';
+  Regex.RegEx:=TestExpr;
   Regex.Replacement:='\{1}';
   AssertTrue('Match',Regex.Match);
   AssertEquals('ReplaceText','bb',Regex.Replace);
@@ -201,7 +237,7 @@ end;
 procedure TTestRegExpCore.TestReplaceWholeSubject;
 begin
   Regex.subject:='*abba*';
-  Regex.RegEx:='a(b*)a';
+  Regex.RegEx:=TestExpr;
   Regex.Replacement:='<\_>';
   AssertTrue('Match',Regex.Match);
   AssertEquals('ReplaceText','<*abba*>',Regex.Replace);
@@ -212,7 +248,7 @@ procedure TTestRegExpCore.TestReplaceLeftOfMatch;
 // \`
 begin
   Regex.subject:='x*abba*';
-  Regex.RegEx:='a(b*)a';
+  Regex.RegEx:=TestExpr;
   Regex.Replacement:='<\`>';
   AssertTrue('Match',Regex.Match);
   AssertEquals('ReplaceText','<x*>',Regex.Replace);
@@ -223,7 +259,7 @@ procedure TTestRegExpCore.TestReplaceRightOfMatch;
 // \'
 begin
   Regex.subject:='*abba*x';
-  Regex.RegEx:='a(b*)a';
+  Regex.RegEx:=TestExpr;
   Regex.Replacement:='<\''>';
   AssertTrue('Match',Regex.Match);
   AssertEquals('ReplaceText','<*x>',Regex.Replace);
@@ -234,7 +270,7 @@ procedure TTestRegExpCore.TestReplaceWholeMatch;
 // \&
 begin
   Regex.subject:='*abba*';
-  Regex.RegEx:='a(b*)a';
+  Regex.RegEx:=TestExpr;
   Regex.Replacement:='<\&>';
   AssertTrue('Match',Regex.Match);
   AssertEquals('ReplaceText','<abba>',Regex.Replace);
@@ -255,7 +291,7 @@ end;
 
 procedure TTestRegExpCore.TestSplitAll;
 begin
-  Regex.subject:='xyz abba abbba abbbba zyx';
+  Regex.subject:=TestStr;
   Regex.RegEx:='\s';
   Regex.Split(SplitSubject,0);
   AssertEquals('Count',5,SplitSubject.Count);
@@ -269,7 +305,7 @@ end;
 procedure TTestRegExpCore.TestSplitLimit;
 
 begin
-  Regex.subject:='xyz abba abbba abbbba zyx';
+  Regex.subject:=TestStr;
   Regex.RegEx:='\s';
   Regex.Split(SplitSubject,2);
   AssertEquals('Count',2,SplitSubject.Count);

+ 422 - 0
packages/vcl-compat/tests/utcregexapi.pas

@@ -0,0 +1,422 @@
+unit utcregexapi;
+
+{$mode objfpc}{$H+}
+{ $DEFINE USEWIDESTRING}
+
+interface
+
+uses
+  Classes, SysUtils, fpcunit, testutils, testregistry, system.regularexpressionscore, system.regularexpressions;
+
+type
+
+  { TTestRegExpCore }
+
+  TTestRegExp = class(TTestCase)
+  private
+    FRegex: TRegEx;
+    function DoReplacer(const Match: TMatch): TREString;
+  Protected
+    Property Regex : TRegEx Read FRegex Write FRegex;
+  Public
+    Procedure SetUp; override;
+    Procedure TearDown; override;
+  Published
+    Procedure TestIsMatch;
+    Procedure TestIsMatchStartPos;
+    Procedure TestClassIsMatch;
+    Procedure TestClassIsMatchOptions;
+    Procedure TestEscape;
+    Procedure TestMatch;
+    Procedure TestMatchNoMatch;
+    Procedure TestMatchStartPos;
+    Procedure TestMatchStartPosLength;
+    Procedure TestClassMatch;
+    Procedure TestClassMatchOptions;
+    Procedure TestMatches;
+    Procedure TestMatchesStartPos;
+    Procedure TestClassMatches;
+    Procedure TestClassMatchesOptions;
+    Procedure TestReplace;
+    Procedure TestReplaceEval;
+    Procedure TestReplaceCount;
+    Procedure TestReplaceEvalCount;
+    Procedure TestClassReplace;
+    Procedure TestClassReplaceEval;
+    Procedure TestClassReplaceOptions;
+    Procedure TestClassReplaceEvalOptions;
+{
+
+
+    function Split(const aInput: TREString): TREStringDynArray; overload; inline;
+    function Split(const aInput: TREString; aCount: Integer): TREStringDynArray; overload; inline;
+    function Split(const aInput: TREString; aCount, aStartPos: Integer): TREStringDynArray; overload;
+    class function Split(const aInput, aPattern: TREString): TREStringDynArray; overload; static;
+    class function Split(const aInput, aPattern: TREString; aOptions: TRegExOptions): TREStringDynArray; overload; static;
+}
+  end;
+
+implementation
+
+Const
+  TestStr = 'xyz abba abbba abbbba zyx';
+  TestExpr = 'a(b*)a';
+
+{ TTestRegExpr}
+
+procedure TTestRegExp.SetUp;
+begin
+  inherited SetUp;
+  FRegex:=Default(TRegex);
+end;
+
+procedure TTestRegExp.TearDown;
+begin
+  FRegex:=Default(TRegex);
+  inherited TearDown;
+end;
+
+procedure TTestRegExp.TestIsMatch;
+begin
+ // function IsMatch(const aInput: TREString): Boolean; overload;
+  Regex:=TRegex.Create(TestExpr);
+  AssertTrue('Correct match',Regex.IsMatch(TestStr));
+end;
+
+procedure TTestRegExp.TestIsMatchStartPos;
+begin
+//  function IsMatch(const aInput: TREString; aStartPos: Integer): Boolean; overload;
+  Regex:=TRegex.Create(TestExpr);
+  AssertTrue('Correct match',Regex.IsMatch(TestStr,Pos('abbba',TestStr)));
+  AssertFalse('No match match at pos',Regex.IsMatch(TestStr,Pos('zyx',TestStr)));
+end;
+
+procedure TTestRegExp.TestClassIsMatch;
+begin
+//  class function IsMatch(const aInput, aPattern: TREString): Boolean;overload; static;
+  AssertTrue('Correct match',TRegex.IsMatch(TestStr,TestExpr));
+  AssertFalse('No match',TRegex.IsMatch(TestStr,TestExpr+'xyz'));
+
+end;
+
+procedure TTestRegExp.TestClassIsMatchOptions;
+begin
+//  class function IsMatch(const aInput, aPattern: TREString; aOptions: TRegExOptions): Boolean; overload; static;
+  AssertTrue('Correct match',TRegex.IsMatch(UpperCase(TestStr),TestExpr,[roIgnoreCase]));
+  AssertFalse('No match',TRegex.IsMatch(UpperCase(TestStr),TestExpr+'xyz',[roIgnoreCase]));
+end;
+
+procedure TTestRegExp.TestEscape;
+begin
+//  class function Escape(const aString: TREString; aUseWildCards: Boolean = False): TREString; static;
+  AssertEquals('Wildcard ?','(.)',TRegex.Escape('?',True));
+  AssertEquals('Wildcard ?','\?',TRegex.Escape('??',True));
+  AssertEquals('Wildcard *','(.*)',TRegex.Escape('*',True));
+  AssertEquals('Wildcard ?','\*',TRegex.Escape('**',True));
+  AssertEquals('CRLF','\r\n',TRegex.Escape(#13#10,True));
+end;
+
+Procedure DumpMatch(M : TMatch);
+
+var
+  I : Integer;
+
+begin
+  Writeln('Match value: ',M.Value);
+  Writeln('Match index: ',M.Index);
+  Writeln('Match length: ',M.Length);
+  Writeln('Match group count: ',M.Groups.Count);
+  for I:=0 to M.Groups.Count-1 do
+    begin
+    Writeln('Group ',I);
+    Writeln(Format('Match group %d value: ',[i]),M.Groups[i].Value);
+    Writeln(Format('Match group %d index: ',[i]),M.Groups[i].Index);
+    Writeln(Format('Match group %d length: ',[i]),M.Groups[i].Length);
+    end;
+end;
+
+procedure TTestRegExp.TestMatch;
+
+var
+  M : TMatch;
+
+begin
+//  function Match(const aInput: TREString): TMatch; overload;
+  RegEx:=TRegex.Create(TestExpr);
+  M:=RegEx.Match(TestStr);
+  AssertTrue('Match 0 result: ',M.Success);
+  AssertEquals('Match 0 value: ','abba',M.Value);
+  AssertEquals('Match 0 index: ',5,M.Index);
+  AssertEquals('Match 0 length: ',4,M.Length);
+  AssertEquals('Match 0 group count: ',2,M.Groups.Count);
+  AssertEquals('Match 0 group 0 value: ','abba',M.Groups[0].Value);
+  AssertEquals('Match 0 group 0 index: ',5,M.Groups[0].Index);
+  AssertEquals('Match 0 group 0 length: ',4,M.Groups[0].Length);
+  AssertEquals('Match 0 group 1 value: ','bb',M.Groups[1].Value);
+  AssertEquals('Match 0 group 1 index: ',6,M.Groups[1].Index);
+  AssertEquals('Match 0 group 1 length: ',2,M.Groups[1].Length);
+  M:=M.NextMatch;
+  AssertTrue('Match 1 result: ',M.Success);
+  AssertEquals('Match 1 value: ','abbba',M.Value);
+  AssertEquals('Match 1 index: ',10,M.Index);
+  AssertEquals('Match 1 length: ',5,M.Length);
+  M:=M.NextMatch;
+  AssertTrue('Match 2 result: ',M.Success);
+  AssertEquals('Match 2 value: ','abbbba',M.Value);
+  AssertEquals('Match 2 index: ',16,M.Index);
+  AssertEquals('Match 2 length: ',6,M.Length);
+  M:=M.NextMatch;
+  AssertFalse('Match 3 value: ',M.Success);
+end;
+
+procedure TTestRegExp.TestMatchNoMatch;
+
+var
+  M : TMatch;
+
+begin
+  RegEx:=TRegex.Create(TestExpr+'xyz');
+  M:=RegEx.Match(TestStr);
+  AssertFalse('Success',M.Success);
+  AssertEquals('No match value','',M.Value);
+  AssertEquals('No match Index',0,M.Index);
+  AssertEquals('No match legth',0,M.Length);
+end;
+
+procedure TTestRegExp.TestMatchStartPos;
+
+var
+  M : TMatch;
+  P : Integer;
+
+begin
+//  function Match(const aInput: TREString): TMatch; overload;
+  RegEx:=TRegex.Create(TestExpr);
+  P:=Pos('abbba',TestStr);
+  M:=RegEx.Match(TestStr,P);
+  //  DumpMatch(M);
+  AssertTrue('Match value: ',M.Success);
+  AssertEquals('Match value: ','abbba',M.Value);
+  AssertEquals('Match index: ',10,M.Index);
+  AssertEquals('Match length: ',5,M.Length);
+  AssertEquals('Match group count: ',2,M.Groups.Count);
+  AssertEquals('Match group 0 value: ','abbba',M.Groups[0].Value);
+  AssertEquals('Match group 0 index: ',10,M.Groups[0].Index);
+  AssertEquals('Match group 0 length: ',5,M.Groups[0].Length);
+  AssertEquals('Match group 1 value: ','bbb',M.Groups[1].Value);
+  AssertEquals('Match group 1 index: ',11,M.Groups[1].Index);
+  AssertEquals('Match group 1 length: ',3,M.Groups[1].Length);
+  M:=M.NextMatch;
+  AssertTrue('Match value: ',M.Success);
+end;
+
+procedure TTestRegExp.TestMatchStartPosLength;
+var
+  M : TMatch;
+  P : Integer;
+
+begin
+//  function Match(const aInput: TREString): TMatch; overload;
+  RegEx:=TRegex.Create(TestExpr);
+  P:=Pos('abbba',TestStr);
+  M:=RegEx.Match(TestStr,P,5);
+  //  DumpMatch(M);
+  AssertTrue('Match value: ',M.Success);
+  AssertEquals('Match value: ','abbba',M.Value);
+  AssertEquals('Match index: ',10,M.Index);
+  AssertEquals('Match length: ',5,M.Length);
+  M:=M.NextMatch;
+  AssertFalse('No more matches: ',M.Success);
+end;
+
+procedure TTestRegExp.TestClassMatch;
+
+var
+  M : TMatch;
+
+begin
+//    class function Match(const aInput, aPattern: TREString): TMatch; overload; static;
+  M:=TRegex.Match(TestStr,TestExpr);
+  AssertTrue('Match result: ',M.Success);
+  AssertEquals('Match value: ','abba',M.Value);
+
+end;
+
+procedure TTestRegExp.TestClassMatchOptions;
+
+//  class function Match(const aInput, aPattern: TREString; aOptions: TRegExOptions): TMatch; overload; static;
+var
+  M : TMatch;
+
+begin
+//    class function Match(const aInput, aPattern: TREString): TMatch; overload; static;
+  M:=TRegex.Match(UpperCase(TestStr),TestExpr,[roIgnoreCase]);
+  AssertTrue('Match result: ',M.Success);
+  AssertEquals('Match value: ','ABBA',M.Value);
+end;
+
+procedure TTestRegExp.TestMatches;
+
+var
+  MS : TMatchCollection;
+  M,M2 : TMatch;
+
+begin
+//  function Matches(const aInput: TREString): TMatchCollection; overload;
+  RegEx:=TRegex.Create(TestExpr);
+  MS:=RegEx.Matches(TestStr);
+  AssertEquals('Match count',3,MS.Count);
+  M:=MS[0];
+  AssertTrue('Match 0 result: ',M.Success);
+  AssertEquals('Match 0 value: ','abba',M.Value);
+  AssertEquals('Match 0 index: ',5,M.Index);
+  AssertEquals('Match 0 length: ',4,M.Length);
+  AssertEquals('Match 0 group count: ',2,M.Groups.Count);
+  AssertEquals('Match 0 group 0 value: ','abba',M.Groups[0].Value);
+  AssertEquals('Match 0 group 0 index: ',5,M.Groups[0].Index);
+  AssertEquals('Match 0 group 0 length: ',4,M.Groups[0].Length);
+  AssertEquals('Match 0 group 1 value: ','bb',M.Groups[1].Value);
+  AssertEquals('Match 0 group 1 index: ',6,M.Groups[1].Index);
+  AssertEquals('Match 0 group 1 length: ',2,M.Groups[1].Length);
+  M2:=M.NextMatch;
+  M:=MS[1];
+  AssertTrue('Match 1 resul: ',M.Success);
+  AssertEquals('Match 1 value: ','abbba',M.Value);
+  AssertEquals('NextMatch value: ','abbba',M2.Value);
+  AssertEquals('Match 1 index: ',10,M.Index);
+  AssertEquals('Match 1 length: ',5,M.Length);
+  M:=MS[2];
+  AssertTrue('Match 2 result: ',M.Success);
+  AssertEquals('Match 2 value: ','abbbba',M.Value);
+  AssertEquals('Match 2 index: ',16,M.Index);
+  AssertEquals('Match 2 length: ',6,M.Length);
+  M:=M.NextMatch;
+  AssertFalse('Match value: ',M.Success);
+end;
+
+procedure TTestRegExp.TestMatchesStartPos;
+var
+  MS : TMatchCollection;
+  M : TMatch;
+
+begin
+//  function Matches(const aInput: TREString; aStartPos: Integer): TMatchCollection; overload;
+  RegEx:=TRegex.Create(TestExpr);
+  MS:=RegEx.Matches(TestStr,9);
+  AssertEquals('Match count',2,MS.Count);
+  M:=MS[0];
+  AssertTrue('Match 1 resul: ',M.Success);
+  AssertEquals('Match 1 value: ','abbba',M.Value);
+  M:=MS[1];
+  AssertTrue('Match 1 resul: ',M.Success);
+  AssertEquals('Match 1 value: ','abbbba',M.Value);
+
+end;
+
+procedure TTestRegExp.TestClassMatches;
+var
+  MS : TMatchCollection;
+  M : TMatch;
+begin
+//  class function Matches(const aInput, aPattern: TREString): TMatchCollection; overload; static;
+  MS:=TRegEx.Matches(TestStr,TestExpr);
+  AssertEquals('Match count',3,MS.Count);
+  M:=MS[0];
+  AssertTrue('Match 0 result: ',M.Success);
+  AssertEquals('Match 0 value: ','abba',M.Value);
+  M:=MS[1];
+  AssertTrue('Match 0 result: ',M.Success);
+  AssertEquals('Match 0 value: ','abbba',M.Value);
+  M:=MS[2];
+  AssertTrue('Match 0 result: ',M.Success);
+  AssertEquals('Match 0 value: ','abbbba',M.Value);
+
+end;
+
+procedure TTestRegExp.TestClassMatchesOptions;
+
+
+var
+  MS : TMatchCollection;
+  M : TMatch;
+begin
+  //  class function Matches(const aInput, aPattern: TREString; aOptions: TRegExOptions): TMatchCollection; overload; static;
+  MS:=TRegEx.Matches(TestStr,UpperCase(TestExpr),[roIgnoreCase]);
+  AssertEquals('Match count',3,MS.Count);
+  M:=MS[0];
+  AssertTrue('Match 0 result: ',M.Success);
+  AssertEquals('Match 0 value: ','abba',M.Value);
+  M:=MS[1];
+  AssertTrue('Match 0 result: ',M.Success);
+  AssertEquals('Match 0 value: ','abbba',M.Value);
+  M:=MS[2];
+  AssertTrue('Match 0 result: ',M.Success);
+  AssertEquals('Match 0 value: ','abbbba',M.Value);
+end;
+
+procedure TTestRegExp.TestReplace;
+begin
+  //  function Replace(const aInput, aReplacement: TREString): TREString; overload;
+  RegEx:=TRegex.Create(TestExpr);
+  AssertEquals('Result','xyz c c c zyx',RegEx.Replace(TestStr,'c'));
+end;
+
+function TTestRegExp.DoReplacer(const Match: TMatch): TREString;
+
+begin
+  Result:='<'+Match.Value+'>';
+//  Writeln('Replace "',Match.Value,'" -> "',Result,'"')
+end;
+
+procedure TTestRegExp.TestReplaceEval;
+begin
+//  function Replace(const aInput: TREString; aEvaluator: TMatchEvaluator): TREString; overload;
+  RegEx:=TRegex.Create(TestExpr);
+  AssertEquals('Result','xyz <abba> <abbba> <abbbba> zyx',RegEx.Replace(TestStr,@DoReplacer));
+end;
+
+procedure TTestRegExp.TestReplaceCount;
+begin
+//  function Replace(const aInput, aReplacement: TREString; aCount: Integer): TREString; overload;
+  RegEx:=TRegex.Create(TestExpr);
+  AssertEquals('Result','xyz c c abbbba zyx',RegEx.Replace(TestStr,'c',2));
+end;
+
+procedure TTestRegExp.TestReplaceEvalCount;
+begin
+//  function Replace(const aInput: TREString; aEvaluator: TMatchEvaluator; aCount: Integer): TREString; overload;
+  RegEx:=TRegex.Create(TestExpr);
+  AssertEquals('Result','xyz <abba> <abbba> abbbba zyx',RegEx.Replace(TestStr,@DoReplacer,2));
+
+end;
+
+procedure TTestRegExp.TestClassReplace;
+begin
+//  class function Replace(const aInput, aPattern, aReplacement: TREString): TREString; overload; static;
+  AssertEquals('Result','xyz c c c zyx',TRegEx.Replace(TestStr,TestExpr,'c'));
+
+end;
+
+procedure TTestRegExp.TestClassReplaceEval;
+begin
+//  class function Replace(const aInput, aPattern: TREString; aEvaluator: TMatchEvaluator): TREString; overload; static;
+  AssertEquals('Result','xyz <abba> <abbba> <abbbba> zyx',TRegEx.Replace(TestStr,TestExpr,@DoReplacer));
+end;
+
+procedure TTestRegExp.TestClassReplaceOptions;
+begin
+//  class function Replace(const aInput, aPattern, aReplacement: TREString; aOptions: TRegExOptions): TREString; overload; static;
+  AssertEquals('Result','xyz c c c zyx',TRegEx.Replace(TestStr,UpperCase(TestExpr),'c',[roIgnoreCase]));
+end;
+
+procedure TTestRegExp.TestClassReplaceEvalOptions;
+begin
+//  class function Replace(const aInput, aPattern: TREString; aEvaluator: TMatchEvaluator; aOptions: TRegExOptions): TREString; overload; static;
+  AssertEquals('Result','xyz <abba> <abbba> <abbbba> zyx',TRegEx.Replace(TestStr,UpperCase(TestExpr),@DoReplacer,[roIgnoreCase]));
+
+end;
+
+initialization
+  RegisterTest(TTestRegExp);
+end.
+