# revisions: 31464,31467,31468,33055,33056,33057,33058

git-svn-id: branches/fixes_3_0@33837 -

rtl/inc/astrings.inc

@@ -915,18 +915,18 @@ end;
 
 {$ifndef FPC_HAS_POS_SHORTSTR_ANSISTR}
 {$define FPC_HAS_POS_SHORTSTR_ANSISTR}
-Function Pos(Const Substr : ShortString; Const Source : RawByteString) : SizeInt;
+Function Pos(Const Substr : ShortString; Const Source : RawByteString; Offset : Sizeint = 1) : SizeInt;
 
 var
   i,MaxLen : SizeInt;
   pc : PAnsiChar;
 begin
   Pos:=0;
-  if Length(SubStr)>0 then
+  if (Length(SubStr)>0) and (Offset>0) and (Offset<=Length(Source)) then
    begin
      MaxLen:=Length(source)-Length(SubStr);
-     i:=0;
-     pc:=@source[1];
+     i:=Offset-1;
+     pc:=@source[Offset];
      while (i<=MaxLen) do
       begin
         inc(i);
@@ -945,17 +945,17 @@ end;
 
 {$ifndef FPC_HAS_POS_ANSISTR_ANSISTR}
 {$define FPC_HAS_POS_ANSISTR_ANSISTR}
-Function Pos(Const Substr : RawByteString; Const Source : RawByteString) : SizeInt;
+Function Pos(Const Substr : RawByteString; Const Source : RawByteString; Offset : Sizeint = 1) : SizeInt;
 var
   i,MaxLen : SizeInt;
   pc : PAnsiChar;
 begin
   Pos:=0;
-  if Length(SubStr)>0 then
+  if (Length(SubStr)>0) and (Offset>0) and (Offset<=Length(Source)) then
    begin
      MaxLen:=Length(source)-Length(SubStr);
-     i:=0;
-     pc:=@source[1];
+     i:=Offset-1;
+     pc:=@source[Offset];
      while (i<=MaxLen) do
       begin
         inc(i);
@@ -978,13 +978,16 @@ end;
 { pos(c: char; const s: shortstring) also exists, so otherwise   }
 { using pos(char,pchar) will always call the shortstring version }
 { (exact match for first argument), also with $h+ (JM)           }
-Function Pos(c : AnsiChar; Const s : RawByteString) : SizeInt;
+Function Pos(c : AnsiChar; Const s : RawByteString; Offset : Sizeint = 1) : SizeInt;
 var
   i: SizeInt;
   pc : PAnsiChar;
 begin
-  pc:=@s[1];
-  for i:=1 to length(s) do
+  Pos:=0;
+  If (Offset<1) or (Offset>Length(S)) then 
+    exit;
+  pc:=@s[OffSet];
+  for i:=Offset to length(s) do
    begin
      if pc^=c then
       begin

rtl/inc/sstrings.inc

@@ -125,17 +125,17 @@ end;
 
 {$ifndef FPC_HAS_SHORTSTR_POS_SHORTSTR}
 {$define FPC_HAS_SHORTSTR_POS_SHORTSTR}
-function pos(const substr : shortstring;const s : shortstring):SizeInt;
+function pos(const substr : shortstring;const s : shortstring; Offset : Sizeint = 1):SizeInt;
 var
   i,MaxLen : SizeInt;
   pc : pchar;
 begin
   Pos:=0;
-  if Length(SubStr)>0 then
+  if (Length(SubStr)>0) and (Offset>0) and (Offset<=Length(S)) then
    begin
      MaxLen:=sizeint(Length(s))-Length(SubStr);
-     i:=0;
-     pc:=@s[1];
+     i:=Offset-1;
+     pc:=@s[Offset];
      while (i<=MaxLen) do
       begin
         inc(i);
@@ -155,13 +155,16 @@ end;
 {$ifndef FPC_HAS_SHORTSTR_POS_CHAR}
 {$define FPC_HAS_SHORTSTR_POS_CHAR}
 {Faster when looking for a single char...}
-function pos(c:char;const s:shortstring):SizeInt;
+function pos(c:char;const s:shortstring; Offset : Sizeint = 1 ):SizeInt;
 var
   i : SizeInt;
   pc : pchar;
 begin
-  pc:=@s[1];
-  for i:=1 to length(s) do
+  Pos:=0;
+  if (Offset<1) or (Offset>Length(S)) then
+    exit;
+  pc:=@s[Offset];
+  for i:=Offset to length(s) do
    begin
      if pc^=c then
       begin
@@ -183,9 +186,9 @@ begin
    fpc_char_Copy:='';
 end;
 
-function pos(const substr : shortstring;c:char): SizeInt;
+function pos(const substr : shortstring;c:char;  Offset : Sizeint = 1): SizeInt;
 begin
-  if (length(substr)=1) and (substr[1]=c) then
+  if (length(substr)=1) and (substr[1]=c) and (Offset=1) then
    Pos:=1
   else
    Pos:=0;

rtl/inc/systemh.inc

@@ -1082,10 +1082,10 @@ function Utf8CodePointLen(P: PAnsiChar; MaxLookAhead: SizeInt; IncludeCombiningD
 Procedure Delete(var s:shortstring;index:SizeInt;count:SizeInt);
 Procedure Insert(const source:shortstring;var s:shortstring;index:SizeInt);
 Procedure Insert(source:Char;var s:shortstring;index:SizeInt);
-Function  Pos(const substr:shortstring;const s:shortstring):SizeInt;
-Function  Pos(C:Char;const s:shortstring):SizeInt;
+Function  Pos(const substr:shortstring;const s:shortstring; Offset: Sizeint = 1):SizeInt;
+Function  Pos(C:Char;const s:shortstring; Offset: Sizeint = 1):SizeInt;
 {$ifdef FPC_HAS_FEATURE_ANSISTRINGS}
-Function  Pos(const Substr : ShortString; const Source : RawByteString) : SizeInt;
+Function  Pos(const Substr : ShortString; const Source : RawByteString; Offset: Sizeint = 1) : SizeInt;
 
 {$ifdef FPC_HAS_CPSTRING}
 Procedure fpc_setstring_ansistr_pansichar(out S : RawByteString; Buf : PAnsiChar; Len : SizeInt; cp: TSystemCodePage); rtlproc; compilerproc;
@@ -1121,7 +1121,7 @@ Function  hexStr(Val:Pointer):shortstring;
 Function chr(b : byte) : Char;      [INTERNPROC: fpc_in_chr_byte];
 Function  upCase(c:Char):Char;
 Function  lowerCase(c:Char):Char; overload;
-function  pos(const substr : shortstring;c:char): SizeInt;
+function  pos(const substr : shortstring;c:char; Offset: Sizeint = 1): SizeInt;
 
 
 {****************************************************************************
@@ -1130,8 +1130,8 @@ function  pos(const substr : shortstring;c:char): SizeInt;
 
 {$ifdef FPC_HAS_FEATURE_ANSISTRINGS}
 Procedure UniqueString(var S : RawByteString);{$ifdef FPC_HAS_CPSTRING}rtlproc;{$endif FPC_HAS_CPSTRING}external name 'FPC_ANSISTR_UNIQUE';
-Function  Pos (const Substr : RawByteString; const Source : RawByteString) : SizeInt;
-Function  Pos (c : AnsiChar; const s : RawByteString) : SizeInt;
+Function  Pos (const Substr : RawByteString; const Source : RawByteString; Offset: Sizeint = 1) : SizeInt;
+Function  Pos (c : AnsiChar; const s : RawByteString; Offset: Sizeint = 1) : SizeInt;
 Procedure Insert (const Source : RawByteString; var S : RawByteString; Index : SizeInt);{$ifdef FPC_HAS_CPSTRING}rtlproc;{$endif FPC_HAS_CPSTRING}
 Procedure Delete (var S : RawByteString; Index,Size: SizeInt);{$ifdef FPC_HAS_CPSTRING}rtlproc;{$endif FPC_HAS_CPSTRING}
 Function  StringOfChar(c : Ansichar;l : SizeInt) : AnsiString;

rtl/inc/ustringh.inc

@@ -16,12 +16,12 @@
 
 
 Procedure UniqueString (Var S : UnicodeString);external name 'FPC_UNICODESTR_UNIQUE';
-Function Pos (Const Substr : UnicodeString; Const Source : UnicodeString) : SizeInt;
-Function Pos (c : Char; Const s : UnicodeString) : SizeInt;
-Function Pos (c : UnicodeChar; Const s : UnicodeString) : SizeInt;
-Function Pos (const c : RawByteString; Const s : UnicodeString) : SizeInt;
-Function Pos (const c : UnicodeString; Const s : RawByteString) : SizeInt;
-Function Pos (const c : ShortString; Const s : UnicodeString) : SizeInt;
+Function Pos (Const Substr : UnicodeString; Const Source : UnicodeString; Offset: Sizeint = 1) : SizeInt;
+Function Pos (c : Char; Const s : UnicodeString; Offset: Sizeint = 1) : SizeInt;
+Function Pos (c : UnicodeChar; Const s : UnicodeString; Offset: Sizeint = 1) : SizeInt;
+Function Pos (const c : RawByteString; Const s : UnicodeString; Offset: Sizeint = 1) : SizeInt;
+Function Pos (const c : UnicodeString; Const s : RawByteString; Offset: Sizeint = 1) : SizeInt;
+Function Pos (const c : ShortString; Const s : UnicodeString; Offset: Sizeint = 1) : SizeInt;
 
 Function UpCase(const s : UnicodeString) : UnicodeString;
 Function  UpCase(c:UnicodeChar):UnicodeChar;

rtl/inc/ustrings.inc

@@ -1160,7 +1160,7 @@ end;
 
 {$ifndef FPC_HAS_POS_UNICODESTR_UNICODESTR}
 {$define FPC_HAS_POS_UNICODESTR_UNICODESTR}
-Function Pos (Const Substr : UnicodeString; Const Source : UnicodeString) : SizeInt;
+Function Pos (Const Substr : UnicodeString; Const Source : UnicodeString; Offset: Sizeint = 1) : SizeInt;
 var
   i,MaxLen : SizeInt;
   pc : punicodechar;
@@ -1168,9 +1168,9 @@ begin
   Pos:=0;
   if Length(SubStr)>0 then
    begin
-     MaxLen:=Length(source)-Length(SubStr);
+     MaxLen:=Length(source)-Length(SubStr)-(OffSet-1);
      i:=0;
-     pc:=@source[1];
+     pc:=@source[OffSet];
      while (i<=MaxLen) do
       begin
         inc(i);
@@ -1190,13 +1190,13 @@ end;
 {$ifndef FPC_HAS_POS_UNICODECHAR_UNICODESTR}
 {$define FPC_HAS_POS_UNICODECHAR_UNICODESTR}
 { Faster version for a unicodechar alone }
-Function Pos (c : UnicodeChar; Const s : UnicodeString) : SizeInt;
+Function Pos (c : UnicodeChar; Const s : UnicodeString; Offset: Sizeint = 1) : SizeInt;
 var
   i: SizeInt;
   pc : punicodechar;
 begin
-  pc:=@s[1];
-  for i:=1 to length(s) do
+  pc:=@s[OffSet];
+  for i:=OffSet to length(s) do
    begin
      if pc^=c then
       begin
@@ -1212,21 +1212,21 @@ end;
 
 { DO NOT inline these! Inlining a managed typecast creates an implicit try..finally
   block, which is significant bloat without any sensible speed improvement. }
-Function Pos (const c : RawByteString; Const s : UnicodeString) : SizeInt;
+Function Pos (const c : RawByteString; Const s : UnicodeString; Offset: Sizeint = 1) : SizeInt;
   begin
-    result:=Pos(UnicodeString(c),s);
+    result:=Pos(UnicodeString(c),s,offset);
   end;
 
 
-Function Pos (const c : ShortString; Const s : UnicodeString) : SizeInt;
+Function Pos (const c : ShortString; Const s : UnicodeString; Offset: Sizeint = 1) : SizeInt;
   begin
-    result:=Pos(UnicodeString(c),s);
+    result:=Pos(UnicodeString(c),s,OffSet);
   end;
 
 
-Function Pos (const c : UnicodeString; Const s : RawByteString) : SizeInt;
+Function Pos (const c : UnicodeString; Const s : RawByteString; Offset: Sizeint = 1) : SizeInt;
   begin
-    result:=Pos(c,UnicodeString(s));
+    result:=Pos(c,UnicodeString(s),OffSet);
   end;
 
 {$ifndef FPC_HAS_POS_CHAR_UNICODESTR}
@@ -1235,15 +1235,15 @@ Function Pos (const c : UnicodeString; Const s : RawByteString) : SizeInt;
 { pos(c: char; const s: shortstring) also exists, so otherwise   }
 { using pos(char,pchar) will always call the shortstring version }
 { (exact match for first argument), also with $h+ (JM)           }
-Function Pos (c : Char; Const s : UnicodeString) : SizeInt;
+Function Pos (c : Char; Const s : UnicodeString; Offset: Sizeint = 1) : SizeInt;
 var
   i: SizeInt;
   wc : unicodechar;
   pc : punicodechar;
 begin
   wc:=c;
-  pc:=@s[1];
-  for i:=1 to length(s) do
+  pc:=@s[OffSet];
+  for i:=OffSet to length(s) do
    begin
      if pc^=wc then
       begin

rtl/inc/wstringh.inc

@@ -16,13 +16,13 @@
 
 
 Procedure UniqueString (Var S : WideString);external name 'FPC_WIDESTR_UNIQUE';
-Function Pos (Const Substr : WideString; Const Source : WideString) : SizeInt;
-Function Pos (c : Char; Const s : WideString) : SizeInt;
-Function Pos (c : WideChar; Const s : WideString) : SizeInt;
-Function Pos (c : WideChar; Const s : RawByteString) : SizeInt;
-Function Pos (const c : RawByteString; Const s : WideString) : SizeInt;
-Function Pos (const c : WideString; Const s : RawByteString) : SizeInt;
-Function Pos (const c : ShortString; Const s : WideString) : SizeInt;
+Function Pos (Const Substr : WideString; Const Source : WideString; Offset : SizeInt = 1) : SizeInt;
+Function Pos (c : Char; Const s : WideString; Offset : SizeInt = 1) : SizeInt;
+Function Pos (c : WideChar; Const s : WideString; Offset : SizeInt = 1) : SizeInt;
+Function Pos (c : WideChar; Const s : RawByteString; Offset : SizeInt = 1) : SizeInt;
+Function Pos (const c : RawByteString; Const s : WideString; Offset : SizeInt = 1) : SizeInt;
+Function Pos (const c : WideString; Const s : RawByteString; Offset : SizeInt = 1) : SizeInt;
+Function Pos (const c : ShortString; Const s : WideString; Offset : SizeInt = 1) : SizeInt;
 
 Function UpCase(const s : WideString) : WideString;
 

rtl/inc/wstrings.inc

@@ -578,17 +578,17 @@ begin
 end;
 
 
-Function Pos (Const Substr : WideString; Const Source : WideString) : SizeInt;
+Function Pos (Const Substr : WideString; Const Source : WideString; Offset : SizeInt = 1) : SizeInt;
 var
   i,MaxLen : SizeInt;
   pc : pwidechar;
 begin
   Pos:=0;
-  if Length(SubStr)>0 then
+  if (Length(SubStr)>0) and (Offset>0) and (Offset<Length(Source)) then
    begin
-     MaxLen:=Length(source)-Length(SubStr);
-     i:=0;
-     pc:=@source[1];
+     MaxLen:=Length(source)-Length(SubStr)-(OffSet-1);
+     i:=Offset-1;
+     pc:=@source[Offset];
      while (i<=MaxLen) do
       begin
         inc(i);
@@ -605,13 +605,15 @@ end;
 
 
 { Faster version for a widechar alone }
-Function Pos (c : WideChar; Const s : WideString) : SizeInt;
+Function Pos (c : WideChar; Const s : WideString; Offset : Sizeint = 1) : SizeInt;
 var
   i: SizeInt;
   pc : pwidechar;
 begin
-  pc:=@s[1];
-  for i:=1 to length(s) do
+  pos:=0;
+  if (Offset<1) or (Offset>Length(s)) then exit;
+  pc:=@s[Offset];
+  for i:=Offset to length(s) do
    begin
      if pc^=c then
       begin
@@ -620,47 +622,50 @@ begin
       end;
      inc(pc);
    end;
-  pos:=0;
 end;
 
 { DO NOT inline these! Inlining a managed typecast creates an implicit try..finally
   block, which is significant bloat without any sensible speed improvement. }
-Function Pos (c : WideChar; Const s : RawByteString) : SizeInt;
+Function Pos (c : WideChar; Const s : RawByteString; Offset : SizeInt = 1) : SizeInt;
   begin
-    result:=Pos(c,WideString(s));
+    result:=Pos(c,WideString(s),Offset);
   end;
 
 
-Function Pos (const c : RawByteString; Const s : WideString) : SizeInt;
+Function Pos (const c : RawByteString; Const s : WideString;Offset : SizeInt = 1) : SizeInt;
   begin
-    result:=Pos(WideString(c),s);
+    result:=Pos(WideString(c),s,Offset);
   end;
 
 
-Function Pos (const c : ShortString; Const s : WideString) : SizeInt;
+Function Pos (const c : ShortString; Const s : WideString;Offset : SizeInt = 1) : SizeInt;
   begin
-    result:=Pos(WideString(c),s);
+    result:=Pos(WideString(c),s,Offset);
   end;
 
 
-Function Pos (const c : WideString; Const s : RawByteString) : SizeInt;
+Function Pos (const c : WideString; Const s : RawByteString;Offset : SizeInt = 1) : SizeInt;
   begin
-    result:=Pos(c,WideString(s));
+    result:=Pos(c,WideString(s),Offset);
   end;
 
 { Faster version for a char alone. Must be implemented because   }
 { pos(c: char; const s: shortstring) also exists, so otherwise   }
 { using pos(char,pchar) will always call the shortstring version }
 { (exact match for first argument), also with $h+ (JM)           }
-Function Pos (c : Char; Const s : WideString) : SizeInt;
+Function Pos (c : Char; Const s : WideString;Offset : SizeInt = 1) : SizeInt;
 var
   i: SizeInt;
   wc : widechar;
   pc : pwidechar;
 begin
+  Pos:=0;
+  if (Offset<1) or (OffSet>Length(S)) then 
+    exit;
   wc:=c;
-  pc:=@s[1];
-  for i:=1 to length(s) do
+  
+  pc:=@s[offset];
+  for i:=Offset to length(s) do
    begin
      if pc^=wc then
       begin

rtl/java/jsystemh.inc

@@ -500,7 +500,7 @@ Function  hexStr(Val:Pointer):shortstring;
 Function chr(b : byte) : Char;      [INTERNPROC: fpc_in_chr_byte];
 Function  upCase(c:Char):Char;
 Function  lowerCase(c:Char):Char; overload;
-function  pos(const substr : shortstring;c:char): SizeInt;
+function  pos(const substr : shortstring;c:char; Offset : Sizeint=1): SizeInt;
 
 
 {****************************************************************************

rtl/objpas/sysutils/syssr.inc

@@ -1,3 +1,82 @@
+var
+  OldPat,Srch: SRstring; // 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;
+*)

rtl/objpas/sysutils/sysstr.inc

@@ -2660,6 +2660,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}
@@ -2667,6 +2669,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;
 

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}

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}