From cf530f117ea79368fe6294a4ab151d9bc4277da1 Mon Sep 17 00:00:00 2001
From: michael <michael@freepascal.org>
Date: Sat, 6 Feb 2016 10:19:56 +0000
Subject: [PATCH] * Faster stringreplace (bug ID 26864)

git-svn-id: trunk@33055 -
---
 rtl/objpas/sysutils/syssr.inc   | 80 +++++++++++++++++++++++++++++++++
 rtl/objpas/sysutils/sysstr.inc  |  4 ++
 rtl/objpas/sysutils/sysuni.inc  |  5 +++
 rtl/objpas/sysutils/syswide.inc |  5 +++
 4 files changed, 94 insertions(+)

diff --git a/rtl/objpas/sysutils/syssr.inc b/rtl/objpas/sysutils/syssr.inc
index f18d173d21..d7a0f99eb3 100644
--- a/rtl/objpas/sysutils/syssr.inc
+++ b/rtl/objpas/sysutils/syssr.inc
@@ -1,3 +1,82 @@
+var
+  OldPat,Srch: string; // Srch and Oldp can contain uppercase versions of S,OldPattern
+  PatLength,NewPatLength,P,Cnt,PatCount,PrevP: Integer;
+  c,d: SRPChar ;
+  
+begin
+  PatLength:=Length(OldPattern);
+  if PatLength=0 then begin
+    Result:=S;
+    exit;
+  end;
+
+  if rfIgnoreCase in Flags then begin
+    Srch:=SRUpperCase(S);
+    OldPat:=SRUpperCase(OldPattern);
+  end else begin
+    Srch:=S;
+    OldPat:=OldPattern;
+  end;
+
+  PatLength:=Length(OldPat);
+  if Length(NewPattern)=PatLength then begin
+    //Result length will not change
+    Result:=S;
+    P:=1;
+    repeat
+      P:=Pos(OldPat,Srch,P);
+      if P>0 then begin
+        move(NewPattern[1],Result[P],PatLength);
+        if not (rfReplaceAll in Flags) then exit;
+        inc(P,PatLength);
+      end;
+    until p=0;
+  end else begin
+    //Different pattern length -> Result length will change
+    //To avoid creating a lot of temporary strings, we count how many
+    //replacements we're going to make.
+    P:=1; PatCount:=0;
+    repeat
+      P:=Pos(OldPat,Srch,P);
+      if P>0 then begin
+        inc(P,PatLength);
+        inc(PatCount);
+        if not (rfReplaceAll in Flags) then break;
+      end;
+    until p=0;
+    if PatCount=0 then begin
+      Result:=S;
+      exit;
+    end;
+    NewPatLength:=Length(NewPattern);
+    SetLength(Result,Length(S)+PatCount*(NewPatLength-PatLength)*SizeOf(SRChar));
+    P:=1; PrevP:=0;
+    c:=SRPChar(Result); d:=SRPChar(S);
+    repeat
+      P:=Pos(OldPat,Srch,P);
+      if P>0 then begin
+        Cnt:=P-PrevP-1;
+        if Cnt>0 then begin
+          Move(d^,c^,Cnt);
+          inc(c,Cnt);
+          inc(d,Cnt);
+        end;
+        if NewPatLength>0 then begin
+          Move(NewPattern[1],c^,NewPatLength);
+          inc(c,NewPatLength);
+        end;
+        inc(P,PatLength);
+        inc(d,PatLength);
+        PrevP:=P-1;
+        if not (rfReplaceAll in Flags) then break;
+      end;
+    until p=0;
+    Cnt:=Length(S)-PrevP;
+    if Cnt>0 then Move(d^,c^,Cnt);
+  end;
+end;
+
+(*
 var
   Srch,OldP,RemS: SRString; // Srch and Oldp can contain uppercase versions of S,OldPattern
   P : Integer;
@@ -34,3 +113,4 @@ begin
       end;
     end;
 end;
+*)
\ No newline at end of file
diff --git a/rtl/objpas/sysutils/sysstr.inc b/rtl/objpas/sysutils/sysstr.inc
index 07bcea5808..e72e15e378 100644
--- a/rtl/objpas/sysutils/sysstr.inc
+++ b/rtl/objpas/sysutils/sysstr.inc
@@ -2628,6 +2628,8 @@ end;
 {$define INSTRINGREPLACE}
 {$define SRString:=String}
 {$define SRUpperCase:=AnsiUppercase}
+{$define SRPCHAR:=PChar}
+{$define SRCHAR:=Char}
 
 Function StringReplace(const S, OldPattern, NewPattern: string;  Flags: TReplaceFlags): string;
 {$i syssr.inc}
@@ -2635,6 +2637,8 @@ Function StringReplace(const S, OldPattern, NewPattern: string;  Flags: TReplace
 {$undef INSTRINGREPLACE}
 {$undef SRString}
 {$undef SRUpperCase}
+{$undef SRPCHAR}
+{$undef SRCHAR}
 
 Function IsDelimiter(const Delimiters, S: string; Index: Integer): Boolean;
 
diff --git a/rtl/objpas/sysutils/sysuni.inc b/rtl/objpas/sysutils/sysuni.inc
index 70ccf2518d..5bba68fa4e 100644
--- a/rtl/objpas/sysutils/sysuni.inc
+++ b/rtl/objpas/sysutils/sysuni.inc
@@ -537,9 +537,14 @@ end;
 {$define INUNICODESTRINGREPLACE}
 {$define SRString:=UnicodeString}
 {$define SRUpperCase:=WideUppercase}
+{$define SRPCHAR:=PChar}
+{$define SRCHAR:=Char}
+
 function UnicodeStringReplace(const S, OldPattern, NewPattern: UnicodeString;  Flags: TReplaceFlags): UnicodeString;
 {$i syssr.inc}
 
 {$undef INUNICODESTRINGREPLACE}
 {$undef SRString}
 {$undef SRUpperCase}
+{$undef SRPCHAR}
+{$undef SRCHAR}
diff --git a/rtl/objpas/sysutils/syswide.inc b/rtl/objpas/sysutils/syswide.inc
index 319916a935..6135ece8e9 100644
--- a/rtl/objpas/sysutils/syswide.inc
+++ b/rtl/objpas/sysutils/syswide.inc
@@ -184,9 +184,14 @@ end;
 {$define INWIDESTRINGREPLACE}
 {$define SRString:=WideString}
 {$define SRUpperCase:=WideUppercase}
+{$define SRPChar:=PWideChar}
+{$define SRChar:=WideChar}
+
 function WideStringReplace(const S, OldPattern, NewPattern: WideString;  Flags: TReplaceFlags): WideString;
 {$i syssr.inc}
 
 {$undef INWIDESTRINGREPLACE}
 {$undef SRString}
 {$undef SRUpperCase}
+{$undef SRPChar}
+{$undef SRChar}
\ No newline at end of file