Browse Source

# revisions: 32540,32818,32939,33299,33305,33328,33329,33339,33342,33344,33700,33829

git-svn-id: branches/fixes_3_0@33839 -
marco 9 years ago
parent
commit
874a86309f

+ 248 - 114
packages/rtl-objpas/src/inc/strutils.pp

@@ -44,6 +44,8 @@ Function AnsiEndsStr(const ASubText, AText: string): Boolean;
 Function AnsiReplaceStr(const AText, AFromText, AToText: string): string;inline;
 Function AnsiMatchStr(const AText: string; const AValues: array of string): Boolean;inline;
 Function AnsiIndexStr(const AText: string; const AValues: array of string): Integer;
+Function MatchStr(const AText: UnicodeString; const AValues: array of UnicodeString): Boolean;
+Function IndexStr(const AText: UnicodeString; const AValues: array of UnicodeString): Integer;
 
 { ---------------------------------------------------------------------
     Miscellaneous
@@ -62,18 +64,18 @@ function NaturalCompareText(const Str1, Str2: string; const ADecSeparator, AThou
     VB emulations.
   ---------------------------------------------------------------------}
 
-Function LeftStr(const AText: AnsiString; const ACount: Integer): AnsiString;inline;
-Function RightStr(const AText: AnsiString; const ACount: Integer): AnsiString;
-Function MidStr(const AText: AnsiString; const AStart, ACount: Integer): AnsiString;inline;
-Function RightBStr(const AText: AnsiString; const AByteCount: Integer): AnsiString;inline;
-Function MidBStr(const AText: AnsiString; const AByteStart, AByteCount: Integer): AnsiString;inline;
-Function AnsiLeftStr(const AText: AnsiString; const ACount: Integer): AnsiString;inline;
-Function AnsiRightStr(const AText: AnsiString; const ACount: Integer): AnsiString;inline;
-Function AnsiMidStr(const AText: AnsiString; const AStart, ACount: Integer): AnsiString;inline;
-Function LeftBStr(const AText: AnsiString; const AByteCount: Integer): AnsiString;inline;
-Function LeftStr(const AText: WideString; const ACount: Integer): WideString;inline;
-Function RightStr(const AText: WideString; const ACount: Integer): WideString;
-Function MidStr(const AText: WideString; const AStart, ACount: Integer): WideString;inline;
+Function LeftStr(const AText: AnsiString; const ACount: SizeInt): AnsiString;inline;
+Function RightStr(const AText: AnsiString; const ACount: SizeInt): AnsiString;
+Function MidStr(const AText: AnsiString; const AStart, ACount: SizeInt): AnsiString;inline;
+Function RightBStr(const AText: AnsiString; const AByteCount: SizeInt): AnsiString;inline;
+Function MidBStr(const AText: AnsiString; const AByteStart, AByteCount: SizeInt): AnsiString;inline;
+Function AnsiLeftStr(const AText: AnsiString; const ACount: SizeInt): AnsiString;inline;
+Function AnsiRightStr(const AText: AnsiString; const ACount: SizeInt): AnsiString;inline;
+Function AnsiMidStr(const AText: AnsiString; const AStart, ACount: SizeInt): AnsiString;inline;
+Function LeftBStr(const AText: AnsiString; const AByteCount: SizeInt): AnsiString;inline;
+Function LeftStr(const AText: WideString; const ACount: SizeInt): WideString;inline;
+Function RightStr(const AText: WideString; const ACount: SizeInt): WideString;
+Function MidStr(const AText: WideString; const AStart, ACount: SizeInt): WideString;inline;
 
 { ---------------------------------------------------------------------
     Extended search and replace
@@ -91,11 +93,14 @@ type
   TStringSearchOptions = set of TStringSearchOption;
   TStringSeachOption = TStringSearchOption;
 
-Function SearchBuf(Buf: PChar; BufLen: Integer; SelStart, SelLength: Integer; SearchString: String; Options: TStringSearchOptions): PChar;
-Function SearchBuf(Buf: PChar; BufLen: Integer; SelStart, SelLength: Integer; SearchString: String): PChar;inline; // ; Options: TStringSearchOptions = [soDown]
-Function PosEx(const SubStr, S: string; Offset: Cardinal): Integer;
-Function PosEx(const SubStr, S: string): Integer;inline; // Offset: Cardinal = 1
-Function PosEx(c:char; const S: string; Offset: Cardinal): Integer;
+Function SearchBuf(Buf: PChar; BufLen: SizeInt; SelStart, SelLength: SizeInt; SearchString: String; Options: TStringSearchOptions): PChar;
+Function SearchBuf(Buf: PChar; BufLen: SizeInt; SelStart, SelLength: SizeInt; SearchString: String): PChar;inline; // ; Options: TStringSearchOptions = [soDown]
+Function PosEx(const SubStr, S: string; Offset: SizeUint): SizeInt;
+Function PosEx(const SubStr, S: string): SizeInt;inline; // Offset: Cardinal = 1
+Function PosEx(c:char; const S: string; Offset: SizeUint): SizeInt;
+Function PosEx(const SubStr, S: UnicodeString; Offset: SizeUint): SizeInt;
+Function PosEx(c: WideChar; const S: UnicodeString; Offset: SizeUint): SizeInt;
+Function PosEx(const SubStr, S: UnicodeString): Sizeint;inline; // Offset: Cardinal = 1
 function StringsReplace(const S: string; OldPattern, NewPattern: array of string;  Flags: TReplaceFlags): string;
 
 { ---------------------------------------------------------------------
@@ -149,29 +154,35 @@ function DelSpace(const S: string): string;
 function DelChars(const S: string; Chr: Char): string;
 function DelSpace1(const S: string): string;
 function Tab2Space(const S: string; Numb: Byte): string;
-function NPos(const C: string; S: string; N: Integer): Integer;
-Function RPosEX(C:char;const S : AnsiString;offs:cardinal):Integer; overload;
-Function RPosex (Const Substr : AnsiString; Const Source : AnsiString;offs:cardinal) : Integer; overload;
-Function RPos(c:char;const S : AnsiString):Integer; overload;
-Function RPos (Const Substr : AnsiString; Const Source : AnsiString) : Integer; overload;
+function NPos(const C: string; S: string; N: Integer): SizeInt;
+Function RPosEX(C:char;const S : AnsiString;offs:cardinal):SizeInt; overload;
+Function RPosex (Const Substr : AnsiString; Const Source : AnsiString;offs:cardinal) : SizeInt; overload;
+Function RPos(c:char;const S : AnsiString):SizeInt; overload;
+Function RPos (Const Substr : AnsiString; Const Source : AnsiString) : SizeInt; overload;
 function AddChar(C: Char; const S: string; N: Integer): string;
 function AddCharR(C: Char; const S: string; N: Integer): string;
 function PadLeft(const S: string; N: Integer): string;inline;
 function PadRight(const S: string; N: Integer): string;inline;
-function PadCenter(const S: string; Len: Integer): string;
+function PadCenter(const S: string; Len: SizeInt): string;
 function Copy2Symb(const S: string; Symb: Char): string;
 function Copy2SymbDel(var S: string; Symb: Char): string;
 function Copy2Space(const S: string): string;inline;
 function Copy2SpaceDel(var S: string): string;inline;
 function AnsiProperCase(const S: string; const WordDelims: TSysCharSet): string;
-function WordCount(const S: string; const WordDelims: TSysCharSet): Integer;
-function WordPosition(const N: Integer; const S: string; const WordDelims: TSysCharSet): Integer;
+function WordCount(const S: string; const WordDelims: TSysCharSet): SizeInt;
+function WordPosition(const N: Integer; const S: string; const WordDelims: TSysCharSet): SizeInt;
 function ExtractWord(N: Integer; const S: string;  const WordDelims: TSysCharSet): string;inline;
-function ExtractWordPos(N: Integer; const S: string; const WordDelims: TSysCharSet; var Pos: Integer): string;
+{$IF SIZEOF(SIZEINT)<>SIZEOF(INTEGER)}
+function ExtractWordPos(N: Integer; const S: string; const WordDelims: TSysCharSet; out Pos: SizeInt): string;
+{$ENDIF}
+function ExtractWordPos(N: Integer; const S: string; const WordDelims: TSysCharSet; out Pos: Integer): string;
 function ExtractDelimited(N: Integer; const S: string;  const Delims: TSysCharSet): string;
+{$IF SIZEOF(SIZEINT)<>SIZEOF(INTEGER)}
+function ExtractSubstr(const S: string; var Pos: SizeInt;  const Delims: TSysCharSet): string;
+{$ENDIF}
 function ExtractSubstr(const S: string; var Pos: Integer;  const Delims: TSysCharSet): string;
 function IsWordPresent(const W, S: string; const WordDelims: TSysCharSet): Boolean;
-function FindPart(const HelpWilds, InputStr: string): Integer;
+function FindPart(const HelpWilds, InputStr: string): SizeInt;
 function IsWild(InputStr, Wilds: string; IgnoreCase: Boolean): Boolean;
 function XorString(const Key, Src: ShortString): ShortString;
 function XorEncode(const Key, Source: string): string;
@@ -197,10 +208,10 @@ const
   StdWordDelims = [#0..' ',',','.',';','/','\',':','''','"','`'] + Brackets;
   StdSwitchChars = ['-','/'];
 
-function PosSet (const c:TSysCharSet;const s : ansistring ):Integer;
-function PosSet (const c:string;const s : ansistring ):Integer;
-function PosSetEx (const c:TSysCharSet;const s : ansistring;count:Integer ):Integer;
-function PosSetEx (const c:string;const s : ansistring;count:Integer ):Integer;
+function PosSet (const c:TSysCharSet;const s : ansistring ):SizeInt;
+function PosSet (const c:string;const s : ansistring ):SizeInt;
+function PosSetEx (const c:TSysCharSet;const s : ansistring;count:Integer ):SizeInt;
+function PosSetEx (const c:string;const s : ansistring;count:Integer ):SizeInt;
 
 Procedure Removeleadingchars(VAR S : AnsiString; Const CSet:TSysCharset);
 Procedure RemoveTrailingChars(VAR S : AnsiString;Const CSet:TSysCharset);
@@ -804,7 +815,7 @@ end;
 procedure FindMatchesBoyerMooreCaseSensitive(const S,OldPattern: String; out aMatches: SizeIntArray; const aMatchAll: Boolean); 
 
 Var
-  I : Integer;
+  I : SizeInt;
 
 begin
   FindMatchesBoyerMooreCaseSensitive(PChar(S),Pchar(OldPattern),Length(S),Length(OldPattern),aMatches,aMatchAll);
@@ -815,7 +826,7 @@ end;
 procedure FindMatchesBoyerMooreCaseInSensitive(const S, OldPattern: String; out aMatches: SizeIntArray; const aMatchAll: Boolean);
 
 Var
-  I : Integer;
+  I : SizeInt;
 
 begin
   FindMatchesBoyerMooreCaseInSensitive(PChar(S),Pchar(OldPattern),Length(S),Length(OldPattern),aMatches,aMatchAll);
@@ -902,11 +913,12 @@ end;
 
 Function AnsiIndexText(const AText: string; const AValues: array of string): Integer;
 
-var i : longint;
+var
+  i : Integer;
 
 begin
-  result:=-1;
-  if high(AValues)=-1 Then
+  Result:=-1;
+  if (high(AValues)=-1) or (High(AValues)>MaxInt) Then
     Exit;
   for i:=low(AValues) to High(Avalues) do
      if CompareText(avalues[i],atext)=0 Then
@@ -960,7 +972,7 @@ var
   i : longint;
 begin
   result:=-1;
-  if high(AValues)=-1 Then
+  if (high(AValues)=-1) or (High(AValues)>MaxInt) Then
     Exit;
   for i:=low(AValues) to High(Avalues) do
      if (avalues[i]=AText) Then
@@ -968,13 +980,31 @@ begin
 end;
 
 
+Function MatchStr(const AText: UnicodeString; const AValues: array of UnicodeString): Boolean;
+begin
+  Result := IndexStr(AText,AValues) <> -1;
+end;
+
+
+Function IndexStr(const AText: UnicodeString; const AValues: array of UnicodeString): Integer;
+var
+  i: longint;
+begin
+  Result := -1;
+  if (high(AValues) = -1) or (High(AValues) > MaxInt) Then
+    Exit;
+  for i := low(AValues) to High(Avalues) do
+     if (avalues[i] = AText) Then
+       exit(i);                                 // make sure it is the first val.
+end;
+
 { ---------------------------------------------------------------------
     Playthingies
   ---------------------------------------------------------------------}
 
 Function DupeString(const AText: string; ACount: Integer): string;
 
-var i,l : integer;
+var i,l : SizeInt;
 
 begin
  result:='';
@@ -990,7 +1020,7 @@ end;
 Function ReverseString(const AText: string): string;
 
 var
-    i,j:longint;
+  i,j : SizeInt;
 
 begin
   setlength(result,length(atext));
@@ -1067,14 +1097,14 @@ function NaturalCompareText(const Str1, Str2: string; const ADecSeparator, AThou
 var
   Num1, Num2: double;
   pStr1, pStr2: PChar;
-  Len1, Len2: integer;
-  TextLen1, TextLen2: integer;
+  Len1, Len2: SizeInt;
+  TextLen1, TextLen2: SizeInt;
   TextStr1: string = '';
   TextStr2: string = '';
-  i: integer;
-  j: integer;
+  i: SizeInt;
+  j: SizeInt;
   
-  function Sign(const AValue: Integer): integer;inline;
+  function Sign(const AValue: sizeint): integer;inline;
 
   begin
     If Avalue<0 then
@@ -1090,7 +1120,7 @@ var
     Result := ch in ['0'..'9'];
   end;
 
-  function GetInteger(var pch: PChar; var Len: integer): double;
+  function GetInteger(var pch: PChar; var Len: sizeint): double;
   begin
     Result := 0;
     while (pch^ <> #0) and IsNumber(pch^) do
@@ -1203,15 +1233,15 @@ end;
     VB emulations.
   ---------------------------------------------------------------------}
 
-Function LeftStr(const AText: AnsiString; const ACount: Integer): AnsiString;inline;
+Function LeftStr(const AText: AnsiString; const ACount: SizeInt): AnsiString;inline;
 
 begin
   Result:=Copy(AText,1,ACount);
 end;
 
-Function RightStr(const AText: AnsiString; const ACount: Integer): AnsiString;
+Function RightStr(const AText: AnsiString; const ACount: SizeInt): AnsiString;
 
-var j,l:integer;
+var j,l:SizeInt;
 
 begin
   l:=length(atext);
@@ -1220,7 +1250,7 @@ begin
   Result:=Copy(AText,l-j+1,j);
 end;
 
-Function MidStr(const AText: AnsiString; const AStart, ACount: Integer): AnsiString;inline;
+Function MidStr(const AText: AnsiString; const AStart, ACount: SizeInt): AnsiString;inline;
 
 begin
   if (ACount=0) or (AStart>length(atext)) then
@@ -1230,52 +1260,52 @@ end;
 
 
 
-Function LeftBStr(const AText: AnsiString; const AByteCount: Integer): AnsiString;inline;
+Function LeftBStr(const AText: AnsiString; const AByteCount: SizeInt): AnsiString;inline;
 
 begin
   Result:=LeftStr(AText,AByteCount);
 end;
 
 
-Function RightBStr(const AText: AnsiString; const AByteCount: Integer): AnsiString;inline;
+Function RightBStr(const AText: AnsiString; const AByteCount: SizeInt): AnsiString;inline;
 begin
   Result:=RightStr(Atext,AByteCount);
 end;
 
 
-Function MidBStr(const AText: AnsiString; const AByteStart, AByteCount: Integer): AnsiString;inline;
+Function MidBStr(const AText: AnsiString; const AByteStart, AByteCount: SizeInt): AnsiString;inline;
 begin
   Result:=MidStr(AText,AByteStart,AByteCount);
 end;
 
 
-Function AnsiLeftStr(const AText: AnsiString; const ACount: Integer): AnsiString;inline;
+Function AnsiLeftStr(const AText: AnsiString; const ACount: SizeInt): AnsiString;inline;
 begin
   Result := copy(AText,1,ACount);
 end;
 
 
-Function AnsiRightStr(const AText: AnsiString; const ACount: Integer): AnsiString;inline;
+Function AnsiRightStr(const AText: AnsiString; const ACount: SizeInt): AnsiString;inline;
 begin
   Result := copy(AText,length(AText)-ACount+1,ACount);
 end;
 
 
-Function AnsiMidStr(const AText: AnsiString; const AStart, ACount: Integer): AnsiString;inline;
+Function AnsiMidStr(const AText: AnsiString; const AStart, ACount: SizeInt): AnsiString;inline;
 begin
   Result:=Copy(AText,AStart,ACount);
 end;
 
 
-Function LeftStr(const AText: WideString; const ACount: Integer): WideString;inline;
+Function LeftStr(const AText: WideString; const ACount: SizeInt): WideString;inline;
 begin
   Result:=Copy(AText,1,ACount);
 end;
 
 
-Function RightStr(const AText: WideString; const ACount: Integer): WideString;
+Function RightStr(const AText: WideString; const ACount: SizeInt): WideString;
 var
-  j,l:integer;
+  j,l:SizeInt;
 begin
   l:=length(atext);
   j:=ACount;
@@ -1284,7 +1314,7 @@ begin
 end;
 
 
-Function MidStr(const AText: WideString; const AStart, ACount: Integer): WideString;inline;
+Function MidStr(const AText: WideString; const AStart, ACount: SizeInt): WideString;inline;
 begin
   Result:=Copy(AText,AStart,ACount);
 end;
@@ -1387,7 +1417,7 @@ begin
 end;
 
 //function SearchDown(buf,aStart,endchar:pchar; SearchString:string; equal : TEqualFunction; WholeWords:boolean) : pchar;
-function SearchBuf(Buf: PChar;BufLen: Integer;SelStart: Integer;SelLength: Integer;
+function SearchBuf(Buf: PChar;BufLen: SizeInt;SelStart: SizeInt;SelLength: SizeInt;
     SearchString: String;Options: TStringSearchOptions):PChar;
 var
   equal : TEqualFunction;
@@ -1409,12 +1439,12 @@ begin
 end;
 
 
-Function SearchBuf(Buf: PChar; BufLen: Integer; SelStart, SelLength: Integer; SearchString: String): PChar;inline; // ; Options: TStringSearchOptions = [soDown]
+Function SearchBuf(Buf: PChar; BufLen: SizeInt; SelStart, SelLength: SizeInt; SearchString: String): PChar;inline; // ; Options: TStringSearchOptions = [soDown]
 begin
   Result:=SearchBuf(Buf,BufLen,SelStart,SelLength,SearchString,[soDown]);
 end;
 
-Function PosEx(const SubStr, S: string; Offset: Cardinal): Integer;
+Function PosEx(const SubStr, S: string; Offset: SizeUint): SizeInt;
 
 var
   i,MaxLen, SubLen : SizeInt;
@@ -1444,11 +1474,11 @@ begin
   end;
 end;
 
-Function PosEx(c:char; const S: string; Offset: Cardinal): Integer;
+Function PosEx(c:char; const S: string; Offset: SizeUint): SizeInt;
 
 var
-  Len : longint;
-  p: SizeInt;
+  p,Len : SizeInt;
+
 begin
   Len := length(S);
   if (Offset < 1) or (Offset > SizeUInt(Length(S))) then exit(0);
@@ -1460,11 +1490,62 @@ begin
     PosEx := p + sizeint(Offset);
 end; 
 
-Function PosEx(const SubStr, S: string): Integer;inline; // Offset: Cardinal = 1
+Function PosEx(const SubStr, S: string): SizeInt;inline; // Offset: Cardinal = 1
 begin
   posex:=posex(substr,s,1);
 end;
 
+Function PosEx(const SubStr, S: UnicodeString; Offset: SizeUint): SizeInt;
+
+var
+  i,MaxLen, SubLen : SizeInt;
+  SubFirst: WideChar;
+  pc : pwidechar;
+begin
+  PosEx:=0;
+  SubLen := Length(SubStr);
+  if (SubLen > 0) and (Offset > 0) and (Offset <= Cardinal(Length(S))) then
+   begin
+    MaxLen := Length(S)- SubLen;
+    SubFirst := SubStr[1];
+    i := indexword(S[Offset],Length(S) - Offset + 1, Word(SubFirst));
+    while (i >= 0) and ((i + sizeint(Offset) - 1) <= MaxLen) do
+    begin
+      pc := @S[i+SizeInt(Offset)];
+      //we know now that pc^ = SubFirst, because indexbyte returned a value > -1
+      if (CompareWord(Substr[1],pc^,SubLen) = 0) then
+      begin
+        PosEx := i + SizeInt(Offset);
+        Exit;
+      end;
+      //point Offset to next char in S
+      Offset := sizeuint(i) + Offset + 1;
+      i := indexword(S[Offset],Length(S) - Offset + 1, Word(SubFirst));
+    end;
+  end;
+end;
+
+Function PosEx(c: WideChar; const S: UnicodeString; Offset: SizeUint): SizeInt;
+var
+  Len,p : SizeInt;
+
+begin
+  Len := length(S);
+  if (Offset < 1) or (Offset > SizeUInt(Length(S))) then exit(0);
+  Len := length(S);
+  p := indexword(S[Offset],Len-offset+1,Word(c));
+  if (p < 0) then
+    PosEx := 0
+  else
+    PosEx := p + sizeint(Offset);
+end;
+
+Function PosEx(const SubStr, S: UnicodeString): SizeInt;inline; // Offset: Cardinal = 1
+begin
+  PosEx:=PosEx(SubStr,S,1);
+end;
+
+
 function StringsReplace(const S: string; OldPattern, NewPattern: array of string;  Flags: TReplaceFlags): string;
 
 var pc,pcc,lastpc : pchar;
@@ -1472,7 +1553,7 @@ var pc,pcc,lastpc : pchar;
     ResStr,
     CompStr       : string;
     Found         : Boolean;
-    sc            : integer;
+    sc            : sizeint;
 
 begin
   sc := length(OldPattern);
@@ -1560,7 +1641,7 @@ Function Soundex(const AText: string; ALength: TSoundexLength): string;
 
 Var
   S,PS : Char;
-  I,L : integer;
+  I,L : SizeInt;
 
 begin
   Result:='';
@@ -1601,7 +1682,7 @@ Function SoundexInt(const AText: string; ALength: TSoundexIntLength): Integer;
 
 var
   SE: string;
-  I: Integer;
+  I: SizeInt;
 
 begin
   Result:=-1;
@@ -1712,7 +1793,7 @@ end;
 function IsEmptyStr(const S: string; const EmptyChars: TSysCharSet): Boolean;
 
 var
-  i,l: Integer;
+  i,l: SizeInt;
 
 begin
   l:=Length(S);
@@ -1734,7 +1815,7 @@ end;
 function DelChars(const S: string; Chr: Char): string;
 
 var
-  I,J: Integer;
+  I,J: SizeInt;
 
 begin
   Result:=S;
@@ -1756,7 +1837,7 @@ end;
 function DelSpace1(const S: string): string;
 
 var
-  i: Integer;
+  I : SizeInt;
 
 begin
   Result:=S;
@@ -1768,7 +1849,7 @@ end;
 function Tab2Space(const S: string; Numb: Byte): string;
 
 var
-  I: Integer;
+  I: SizeInt;
 
 begin
   I:=1;
@@ -1785,10 +1866,10 @@ begin
       end;
 end;
 
-function NPos(const C: string; S: string; N: Integer): Integer;
+function NPos(const C: string; S: string; N: Integer): SizeInt;
 
 var
-  i,p,k: Integer;
+  i,p,k: SizeInt;
 
 begin
   Result:=0;
@@ -1810,7 +1891,7 @@ end;
 function AddChar(C: Char; const S: string; N: Integer): string;
 
 Var
-  l : Integer;
+  l : SizeInt;
 
 begin
   Result:=S;
@@ -1822,7 +1903,7 @@ end;
 function AddCharR(C: Char; const S: string; N: Integer): string;
 
 Var
-  l : Integer;
+  l : SizeInt;
 
 begin
   Result:=S;
@@ -1847,7 +1928,7 @@ end;
 function Copy2Symb(const S: string; Symb: Char): string;
 
 var
-  p: Integer;
+  p: SizeInt;
 
 begin
   p:=Pos(Symb,S);
@@ -1859,7 +1940,7 @@ end;
 function Copy2SymbDel(var S: string; Symb: Char): string;
 
 var
-  p: Integer;
+  p: SizeInt;
 
 begin
   p:=Pos(Symb,S);
@@ -1888,7 +1969,6 @@ end;
 function AnsiProperCase(const S: string; const WordDelims: TSysCharSet): string;
 
 var
-//  l :  Integer;
   P,PE : PChar;
 
 begin
@@ -1906,7 +1986,7 @@ begin
     end;
 end;
 
-function WordCount(const S: string; const WordDelims: TSysCharSet): Integer;
+function WordCount(const S: string; const WordDelims: TSysCharSet): SizeInt;
 
 var
   P,PE : PChar;
@@ -1926,7 +2006,7 @@ begin
     end;
 end;
 
-function WordPosition(const N: Integer; const S: string; const WordDelims: TSysCharSet): Integer;
+function WordPosition(const N: Integer; const S: string; const WordDelims: TSysCharSet): SizeInt;
 
 var
   PS,P,PE : PChar;
@@ -1955,15 +2035,44 @@ end;
 
 function ExtractWord(N: Integer; const S: string; const WordDelims: TSysCharSet): string;inline;
 var
-  i: Integer;
+  i: SizeInt;
 begin
   Result:=ExtractWordPos(N,S,WordDelims,i);
 end;
 
 
-function ExtractWordPos(N: Integer; const S: string; const WordDelims: TSysCharSet; var Pos: Integer): string;
+function ExtractWordPos(N: Integer; const S: string; const WordDelims: TSysCharSet; out Pos: Integer): string;
+
+var
+  i,j,l: SizeInt;
+
+begin
+  j:=0;
+  i:=WordPosition(N, S, WordDelims);
+  if (I>High(Integer)) then
+    begin
+    Result:='';
+    Pos:=-1;
+    Exit;
+    end;
+  Pos:=i;
+  if (i<>0) then
+    begin
+    j:=i;
+    l:=Length(S);
+    while (j<=L) and not (S[j] in WordDelims) do
+      inc(j);
+    end;
+  SetLength(Result,j-i);
+  If ((j-i)>0) then
+    Move(S[i],Result[1],j-i);
+end;
+
+{$IF SIZEOF(SIZEINT)<>SIZEOF(INTEGER)}
+function ExtractWordPos(N: Integer; const S: string; const WordDelims: TSysCharSet; Out Pos: SizeInt): string;
 var
-  i,j,l: Integer;
+  i,j,l: SizeInt;
+
 begin
   j:=0;
   i:=WordPosition(N, S, WordDelims);
@@ -1979,10 +2088,11 @@ begin
   If ((j-i)>0) then
     Move(S[i],Result[1],j-i);
 end;
+{$ENDIF}
 
 function ExtractDelimited(N: Integer; const S: string; const Delims: TSysCharSet): string;
 var
-  w,i,l,len: Integer;
+  w,i,l,len: SizeInt;
 begin
   w:=0;
   i:=1;
@@ -2006,10 +2116,11 @@ begin
     end;
 end;
 
-function ExtractSubstr(const S: string; var Pos: Integer; const Delims: TSysCharSet): string;
+{$IF SIZEOF(SIZEINT)<>SIZEOF(INTEGER)}
+function ExtractSubstr(const S: string; var Pos: SizeInt; const Delims: TSysCharSet): string;
 
 var
-  i,l: Integer;
+  i,l: SizeInt;
 
 begin
   i:=Pos;
@@ -2021,11 +2132,31 @@ begin
     inc(i);
   Pos:=i;
 end;
+{$ENDIF}
+
+function ExtractSubstr(const S: string; var Pos: Integer; const Delims: TSysCharSet): string;
+
+var
+  i,l: SizeInt;
+
+begin
+  i:=Pos;
+  l:=Length(S);
+  while (i<=l) and not (S[i] in Delims) do
+    inc(i);
+  Result:=Copy(S,Pos,i-Pos);
+  while (i<=l) and (S[i] in Delims) do
+    inc(i);
+  if I>MaxInt then
+    Pos:=MaxInt
+  else
+    Pos:=i;
+end;
 
 function isWordPresent(const W, S: string; const WordDelims: TSysCharSet): Boolean;
 
 var
-  i,Count : Integer;
+  i,Count : SizeInt;
 
 begin
   Result:=False;
@@ -2056,7 +2187,7 @@ begin
   end;
 end;
 
-function PadCenter(const S: string; Len: Integer): string;
+function PadCenter(const S: string; Len: SizeInt): string;
 begin
   if Length(S)<Len then
     begin
@@ -2099,7 +2230,7 @@ end;
 function Numb2Dec(S: string; Base: Byte): Longint;
 
 var
-  i, P: Longint;
+  i, P: sizeint;
 
 begin
   i:=Length(S);
@@ -2128,7 +2259,7 @@ const
 
 var
   index, Next: Char;
-  i,l: Integer;
+  i,l: SizeInt;
   Negative: Boolean;
 
 begin
@@ -2204,10 +2335,13 @@ end;
       * invalid input will return false
       // for backwards comatibility: it supports rather ludicrous input like '-IIIMIII' -> -(2+(1000-1)+3)=-1004
 }
+
 function TryRomanToInt(S: String; out N: LongInt; Strictness: TRomanConversionStrictness = rcsRelaxed): Boolean;
+
 var
-  i, Len: Integer;
+  i, Len: SizeInt;
   Terminated: Boolean;
+
 begin
   Result := (False);
   S := UpperCase(S);  //don't use AnsiUpperCase please
@@ -2509,10 +2643,10 @@ begin
 end;
 
 
-function FindPart(const HelpWilds, inputStr: string): Integer;
+function FindPart(const HelpWilds, inputStr: string): SizeInt;
 var
-  i, J: Integer;
-  Diff: Integer;
+  Diff, i, J: SizeInt;
+
 begin
   Result:=0;
   i:=Pos('?',HelpWilds);
@@ -2538,7 +2672,7 @@ begin
     end;
 end;
 
-Function isMatch(level : integer;inputstr,wilds : string; CWild, CinputWord: integer;MaxInputword,maxwilds : word; Out EOS : Boolean) : Boolean;
+Function isMatch(level : integer;inputstr,wilds : string; CWild, CinputWord: SizeInt;MaxInputword,maxwilds : SizeInt; Out EOS : Boolean) : Boolean;
 
 begin
   EOS:=False;
@@ -2598,8 +2732,8 @@ end;
 function isWild(inputStr, Wilds: string; ignoreCase: boolean): boolean;
 
 var
-  i: integer;
-  MaxinputWord, MaxWilds: integer; { Length of inputStr and Wilds }
+  i: SizeInt;
+  MaxinputWord, MaxWilds: SizeInt; { Length of inputStr and Wilds }
   eos : Boolean;
 
 begin
@@ -2633,7 +2767,7 @@ end;
 
 function XorString(const Key, Src: ShortString): ShortString;
 var
-  i: Integer;
+  i: SizeInt;
 begin
   Result:=Src;
   if Length(Key) > 0 then
@@ -2695,7 +2829,7 @@ begin
     end;
 end;
 
-Function RPosEX(C:char;const S : AnsiString;offs:cardinal):Integer; overload;
+Function RPosEX(C:char;const S : AnsiString;offs:cardinal):SizeInt; overload;
 
 var I   : SizeUInt;
     p,p2: pChar;
@@ -2713,9 +2847,9 @@ Begin
     RPosEX:=0;
 End;
 
-Function RPos(c:char;const S : AnsiString):Integer; overload;
+Function RPos(c:char;const S : AnsiString):SizeInt; overload;
 
-var I   : Integer;
+var I   : SizeInt;
     p,p2: pChar;
 
 Begin
@@ -2730,9 +2864,9 @@ Begin
   RPos:=i;
 End;
 
-Function RPos (Const Substr : AnsiString; Const Source : AnsiString) : Integer; overload;
+Function RPos (Const Substr : AnsiString; Const Source : AnsiString) : SizeInt; overload;
 var
-  MaxLen,llen : Integer;
+  MaxLen,llen : SizeInt;
   c : char;
   pc,pc2 : pchar;
 begin
@@ -2758,9 +2892,9 @@ begin
    end;
 end;
 
-Function RPosex (Const Substr : AnsiString; Const Source : AnsiString;offs:cardinal) : Integer; overload;
+Function RPosex (Const Substr : AnsiString; Const Source : AnsiString;offs:cardinal) : SizeInt; overload;
 var
-  MaxLen,llen : Integer;
+  MaxLen,llen : SizeInt;
   c : char;
   pc,pc2 : pchar;
 begin
@@ -2840,9 +2974,9 @@ begin
   result:=binbufsize-i;
 end;
 
-function possetex (const c:TSysCharSet;const s : ansistring;count:Integer ):Integer;
+function possetex (const c:TSysCharSet;const s : ansistring;count:Integer ):SizeInt;
 
-var i,j:Integer;
+var i,j:SizeInt;
 
 begin
  if pchar(pointer(s))=nil then
@@ -2863,16 +2997,16 @@ begin
  result:=j;
 end;
 
-function posset (const c:TSysCharSet;const s : ansistring ):Integer;
+function posset (const c:TSysCharSet;const s : ansistring ):SizeInt;
 
 begin
   result:=possetex(c,s,1);
 end;
 
-function possetex (const c:string;const s : ansistring;count:Integer ):Integer;
+function possetex (const c:string;const s : ansistring;count:Integer ):SizeInt;
 
 var cset : TSysCharSet;
-    i    : integer;
+    i    : SizeInt;
 begin
   cset:=[];
   if length(c)>0 then
@@ -2881,10 +3015,10 @@ begin
   result:=possetex(cset,s,count);
 end;
 
-function posset (const c:string;const s : ansistring ):Integer;
+function posset (const c:string;const s : ansistring ):SizeInt;
 
 var cset : TSysCharSet;
-    i    : integer;
+    i    : SizeInt;
 begin
   cset:=[];
   if length(c)>0 then

+ 2 - 2
rtl/inc/resh.inc

@@ -65,8 +65,8 @@ Function LockResource(ResData: TFPResourceHGLOBAL): Pointer;
 Function UnlockResource(ResData: TFPResourceHGLOBAL): LongBool;
 Function FreeResource(ResData: TFPResourceHGLOBAL): LongBool;
 {$ifdef FPC_HAS_FEATURE_ANSISTRINGS}
-Function FindResource(ModuleHandle: TFPResourceHMODULE; ResourceName, ResourceType: AnsiString): TFPResourceHandle;
-Function FindResourceEx(ModuleHandle: TFPResourceHMODULE; ResourceType, ResourceName: AnsiString; Language : word): TFPResourceHandle;
+Function FindResource(ModuleHandle: TFPResourceHMODULE; const ResourceName, ResourceType: AnsiString): TFPResourceHandle;
+Function FindResourceEx(ModuleHandle: TFPResourceHMODULE; const ResourceType, ResourceName: AnsiString; Language : word): TFPResourceHandle;
 {$endif}
 
 type

+ 22 - 15
rtl/inc/sstrings.inc

@@ -1948,9 +1948,8 @@ function fpc_val_enum_shortstr(str2ordindex:pointer;const s:shortstring;out code
 
 function fpc_Val_Currency_ShortStr(const s : shortstring; out Code : ValSInt): currency; [public, alias:'FPC_VAL_CURRENCY_SHORTSTR']; compilerproc;
 const
-  MaxInt64 : Int64  = $7FFFFFFFFFFFFFFF;
-  Int64Edge : Int64 = ($7FFFFFFFFFFFFFFF - 10) div 10;
-  Int64Edge2 : Int64 = $7FFFFFFFFFFFFFFF div 10;
+  MinInt64 : Int64  =-$8000000000000000;
+  MinInt64Edge : Int64 = (-$8000000000000000 + 10) div 10;
 var
   { to enable taking the address on the JVM target }
   res : array[0..0] of Int64;
@@ -1961,7 +1960,7 @@ begin
   res[0]:=0;
   len:=Length(s);
   Code:=1;
-  sign:=1;
+  sign:=-1;
   power:=0;
   while True do
     if Code > len then
@@ -1973,10 +1972,12 @@ begin
         break;
   { Read sign }
   case s[Code] of
-   '+' : Inc(Code);
+   '+' : begin
+           Inc(Code);
+         end;
    '-' : begin
-           sign:=-1;
-           inc(code);
+           sign:=+1;
+           Inc(Code);
          end;
   end;
   { Read digits }
@@ -1989,9 +1990,9 @@ begin
           begin
             j:=Ord(s[code])-Ord('0');
             { check overflow }
-            if (res[0] <= Int64Edge) or (res[0] <= (MaxInt64 - j) div 10) then
+            if (res[0] >= MinInt64Edge) or (res[0] >= (MinInt64 + j) div 10) then
               begin
-                res[0]:=res[0]*10 + j;
+                res[0]:=res[0]*10 - j;
                 Inc(i);
               end
             else
@@ -2000,9 +2001,9 @@ begin
                 exit
               else
                 begin
-                  if not FracOverflow and (j >= 5) and (res[0] < MaxInt64) then
+                  if not FracOverflow and (j >= 5) and (res[0] > MinInt64) then
                     { round if first digit of fractional part overflow }
-                    Inc(res[0]);
+                    Dec(res[0]);
                   FracOverflow:=True;
                 end;
           end;
@@ -2063,7 +2064,7 @@ begin
   if power > 0 then
     begin
       for i:=1 to power do
-        if res[0] <= Int64Edge2 then
+        if res[0] >= MinInt64 div 10 then
           res[0]:=res[0]*10
         else
           exit;
@@ -2071,11 +2072,17 @@ begin
   else
     for i:=1 to -power do
       begin
-        if res[0] <= MaxInt64 - 5 then
-          Inc(res[0], 5);
+        if res[0] >= MinInt64 + 5 then
+          Dec(res[0], 5);
         res[0]:=res[0] div 10;
       end;
-  res[0]:=res[0]*sign;
+
+  if sign <> 1 then
+    if res[0] > MinInt64 then
+      res[0]:=res[0]*sign
+    else
+      exit;
+
   fpc_Val_Currency_ShortStr:=PCurrency(@res[0])^;
   Code:=0;
 end;

+ 2 - 2
rtl/inc/sysres.inc

@@ -32,13 +32,13 @@ end;
 *****************************************************************************)
 
 {$ifdef FPC_HAS_FEATURE_ANSISTRINGS}
-Function FindResource(ModuleHandle: TFPResourceHMODULE; ResourceName, ResourceType: AnsiString): TFPResourceHandle;
+Function FindResource(ModuleHandle: TFPResourceHMODULE; const ResourceName, ResourceType: AnsiString): TFPResourceHandle;
 
 begin
   Result:=FindResource(ModuleHandle,PChar(ResourceName),PChar(ResourceType));
 end;
 
-Function FindResourceEx(ModuleHandle: TFPResourceHMODULE; ResourceType, ResourceName: AnsiString; Language : word): TFPResourceHandle;
+Function FindResourceEx(ModuleHandle: TFPResourceHMODULE; const ResourceType, ResourceName: AnsiString; Language : word): TFPResourceHandle;
 
 begin
   Result:=FindResourceEx(ModuleHandle,PChar(ResourceType),PChar(ResourceName),Language);

+ 8 - 2
rtl/objpas/classes/classesh.inc

@@ -729,6 +729,9 @@ type
   PStringItemList = ^TStringItemList;
   TStringItemList = array[0..MaxListSize] of TStringItem;
 
+  TStringsSortStyle = (sslNone,sslUser,sslAuto);
+  TStringsSortStyles = Set of TStringsSortStyle;
+
   TStringList = class(TStrings)
   private
     FList: PStringItemList;
@@ -738,15 +741,17 @@ type
     FOnChanging: TNotifyEvent;
     FDuplicates: TDuplicates;
     FCaseSensitive : Boolean;
-    FSorted: Boolean;
     FForceSort : Boolean;
     FOwnsObjects : Boolean;
+    FSortStyle: TStringsSortStyle;
     procedure ExchangeItemsInt(Index1, Index2: Integer); inline;
+    function GetSorted: Boolean;
     procedure Grow;
     procedure InternalClear(FromIndex : Integer = 0; ClearOnly : Boolean = False);
     procedure QuickSort(L, R: Integer; CompareFn: TStringListSortCompare);
     procedure SetSorted(Value: Boolean);
     procedure SetCaseSensitive(b : boolean);
+    procedure SetSortStyle(AValue: TStringsSortStyle);
   protected
     procedure ExchangeItems(Index1, Index2: Integer); virtual;
     procedure Changed; virtual;
@@ -776,11 +781,12 @@ type
     procedure Sort; virtual;
     procedure CustomSort(CompareFn: TStringListSortCompare); virtual;
     property Duplicates: TDuplicates read FDuplicates write FDuplicates;
-    property Sorted: Boolean read FSorted write SetSorted;
+    property Sorted: Boolean read GetSorted write SetSorted;
     property CaseSensitive: Boolean read FCaseSensitive write SetCaseSensitive;
     property OnChange: TNotifyEvent read FOnChange write FOnChange;
     property OnChanging: TNotifyEvent read FOnChanging write FOnChanging;
     property OwnsObjects : boolean read FOwnsObjects write FOwnsObjects;
+    Property SortStyle : TStringsSortStyle Read FSortStyle Write SetSortStyle;
   end;
 
 {$else}

+ 64 - 47
rtl/objpas/classes/stringl.inc

@@ -1044,7 +1044,7 @@ end;
 
 {$if not defined(FPC_TESTGENERICS)}
 
-Procedure TStringList.ExchangeItemsInt(Index1, Index2: Integer);
+procedure TStringList.ExchangeItemsInt(Index1, Index2: Integer);
 
 Var P1,P2 : Pointer;
 
@@ -1057,14 +1057,19 @@ begin
   Pointer(Flist^[Index2].FObject):=P2;
 end;
 
+function TStringList.GetSorted: Boolean;
+begin
+  Result:=FSortStyle in [sslUser,sslAuto];
+end;
+
 
-Procedure TStringList.ExchangeItems(Index1, Index2: Integer);
+procedure TStringList.ExchangeItems(Index1, Index2: Integer);
 begin
   ExchangeItemsInt(Index1, Index2);
 end;
 
 
-Procedure TStringList.Grow;
+procedure TStringList.Grow;
 
 Var
   NC : Integer;
@@ -1080,7 +1085,7 @@ begin
   SetCapacity(NC);
 end;
 
-Procedure TStringList.InternalClear(FromIndex : Integer = 0; ClearOnly : Boolean = False);
+procedure TStringList.InternalClear(FromIndex: Integer; ClearOnly: Boolean);
 
 Var
   I: Integer;
@@ -1107,7 +1112,8 @@ begin
     SetCapacity(0);
 end;
 
-Procedure TStringList.QuickSort(L, R: Integer; CompareFn: TStringListSortCompare);
+procedure TStringList.QuickSort(L, R: Integer; CompareFn: TStringListSortCompare
+  );
 var
   Pivot, vL, vR: Integer;
   ExchangeProc: procedure(Left, Right: Integer) of object;
@@ -1153,13 +1159,13 @@ begin
 end;
 
 
-Procedure TStringList.InsertItem(Index: Integer; const S: string);
+procedure TStringList.InsertItem(Index: Integer; const S: string);
 begin
   InsertItem(Index, S, nil);
 end;
 
 
-Procedure TStringList.InsertItem(Index: Integer; const S: string; O: TObject);
+procedure TStringList.InsertItem(Index: Integer; const S: string; O: TObject);
 begin
   Changing;
   If FCount=Fcapacity then Grow;
@@ -1174,19 +1180,18 @@ begin
 end;
 
 
-Procedure TStringList.SetSorted(Value: Boolean);
+procedure TStringList.SetSorted(Value: Boolean);
 
 begin
-  If FSorted<>Value then
-    begin
-    If Value then sort;
-    FSorted:=VAlue
-    end;
+  If Value then
+    SortStyle:=sslAuto
+  else
+    SortStyle:=sslNone
 end;
 
 
 
-Procedure TStringList.Changed;
+procedure TStringList.Changed;
 
 begin
   If (FUpdateCount=0) Then
@@ -1199,7 +1204,7 @@ end;
 
 
 
-Procedure TStringList.Changing;
+procedure TStringList.Changing;
 
 begin
   If FUpdateCount=0 then
@@ -1209,7 +1214,7 @@ end;
 
 
 
-Function TStringList.Get(Index: Integer): string;
+function TStringList.Get(Index: Integer): string;
 
 begin
   If (Index<0) or (INdex>=Fcount)  then
@@ -1219,7 +1224,7 @@ end;
 
 
 
-Function TStringList.GetCapacity: Integer;
+function TStringList.GetCapacity: Integer;
 
 begin
   Result:=FCapacity;
@@ -1227,7 +1232,7 @@ end;
 
 
 
-Function TStringList.GetCount: Integer;
+function TStringList.GetCount: Integer;
 
 begin
   Result:=FCount;
@@ -1235,7 +1240,7 @@ end;
 
 
 
-Function TStringList.GetObject(Index: Integer): TObject;
+function TStringList.GetObject(Index: Integer): TObject;
 
 begin
   If (Index<0) or (INdex>=Fcount)  then
@@ -1245,7 +1250,7 @@ end;
 
 
 
-Procedure TStringList.Put(Index: Integer; const S: string);
+procedure TStringList.Put(Index: Integer; const S: string);
 
 begin
   If Sorted then
@@ -1259,7 +1264,7 @@ end;
 
 
 
-Procedure TStringList.PutObject(Index: Integer; AObject: TObject);
+procedure TStringList.PutObject(Index: Integer; AObject: TObject);
 
 begin
   If (Index<0) or (INdex>=Fcount)  then
@@ -1271,7 +1276,7 @@ end;
 
 
 
-Procedure TStringList.SetCapacity(NewCapacity: Integer);
+procedure TStringList.SetCapacity(NewCapacity: Integer);
 
 Var NewList : Pointer;
     I,MSize : Longint;
@@ -1316,7 +1321,7 @@ end;
 
 
 
-Procedure TStringList.SetUpdateState(Updating: Boolean);
+procedure TStringList.SetUpdateState(Updating: Boolean);
 
 begin
   If Updating then
@@ -1336,10 +1341,10 @@ end;
 
 
 
-Function TStringList.Add(const S: string): Integer;
+function TStringList.Add(const S: string): Integer;
 
 begin
-  If Not Sorted then
+  If Not (SortStyle=sslAuto) then
     Result:=FCount
   else
     If Find (S,Result) then
@@ -1350,7 +1355,7 @@ begin
    InsertItem (Result,S);
 end;
 
-Procedure TStringList.Clear;
+procedure TStringList.Clear;
 
 begin
   if FCount = 0 then Exit;
@@ -1359,7 +1364,7 @@ begin
   Changed;
 end;
 
-Procedure TStringList.Delete(Index: Integer);
+procedure TStringList.Delete(Index: Integer);
 
 begin
   If (Index<0) or (Index>=FCount) then
@@ -1378,7 +1383,7 @@ end;
 
 
 
-Procedure TStringList.Exchange(Index1, Index2: Integer);
+procedure TStringList.Exchange(Index1, Index2: Integer);
 
 begin
   If (Index1<0) or (Index1>=FCount) then
@@ -1396,22 +1401,33 @@ begin
   if b=FCaseSensitive then
     Exit;
   FCaseSensitive:=b;
-  if FSorted then
+  if FSortStyle=sslAuto then
     begin
     FForceSort:=True;
-    sort;
-    FForceSort:=False;
+    try
+      Sort;
+    finally
+      FForceSort:=False;
     end;
+    end;
+end;
+
+procedure TStringList.SetSortStyle(AValue: TStringsSortStyle);
+begin
+  if FSortStyle=AValue then Exit;
+  if (AValue=sslAuto) then
+    Sort;
+  FSortStyle:=AValue;
 end;
 
 
-Function TStringList.DoCompareText(const s1,s2 : string) : PtrInt;
-  begin
-        if FCaseSensitive then
-          result:=AnsiCompareStr(s1,s2)
-        else
-          result:=AnsiCompareText(s1,s2);
-  end;
+function TStringList.DoCompareText(const s1, s2: string): PtrInt;
+begin
+  if FCaseSensitive then
+    result:=AnsiCompareStr(s1,s2)
+  else
+    result:=AnsiCompareText(s1,s2);
+end;
 
 
 function TStringList.CompareStrings(const s1,s2 : string) : Integer;
@@ -1420,15 +1436,16 @@ begin
 end;
 
 
-Function TStringList.Find(const S: string; Out Index: Integer): Boolean;
+function TStringList.Find(const S: string; out Index: Integer): Boolean;
 
 var
   L, R, I: Integer;
   CompareRes: PtrInt;
 begin
   Result := false;
-  if Not Sorted then 
-    exit;
+  Index:=-1;
+  if Not Sorted then
+    Raise EListError.Create(SErrFindNeedsSortedList);
   // Use binary search.
   L := 0;
   R := Count - 1;
@@ -1452,7 +1469,7 @@ end;
 
 
 
-Function TStringList.IndexOf(const S: string): Integer;
+function TStringList.IndexOf(const S: string): Integer;
 
 begin
   If Not Sorted then
@@ -1465,10 +1482,10 @@ end;
 
 
 
-Procedure TStringList.Insert(Index: Integer; const S: string);
+procedure TStringList.Insert(Index: Integer; const S: string);
 
 begin
-  If Sorted then
+  If SortStyle=sslAuto then
     Error (SSortedListError,0)
   else
     If (Index<0) or (Index>FCount) then
@@ -1478,10 +1495,10 @@ begin
 end;
 
 
-Procedure TStringList.CustomSort(CompareFn: TStringListSortCompare);
+procedure TStringList.CustomSort(CompareFn: TStringListSortCompare);
 
 begin
-  If (FForceSort or (Not Sorted)) and (FCount>1) then
+  If (FForceSort or (Not (FSortStyle=sslAuto))) and (FCount>1) then
     begin
     Changing;
     QuickSort(0,FCount-1, CompareFn);
@@ -1496,7 +1513,7 @@ begin
     List.FList^[Index].FString);
 end;
 
-Procedure TStringList.Sort;
+procedure TStringList.Sort;
 
 begin
   CustomSort(@StringListAnsiCompare);

+ 14 - 3
rtl/objpas/sysutils/sysstr.inc

@@ -2204,6 +2204,17 @@ Var
         End;
       If (J<>0) then
         Digits[1]:='-';
+      If (Digits[1]='-') then
+        Begin
+        I:=1;
+        While (I<=length(Digits)) And (Not (Digits[I] in ['1'..'9'])) Do
+          Inc(I);
+        If (I>length(Digits)) then
+          Begin
+          Digits:=Copy(Digits, 2, Length(Digits));
+          Dec(DecimalPoint);
+          End;
+        End;  
       Exp := 0;
       End
     Else
@@ -2843,7 +2854,7 @@ begin
           Inc(P,Blen)
         else
           begin
-          If (P>MaxCol) then
+          If (P>=MaxCol) then
             IBC:=C in BreakChars;
           Inc(P);
           end;
@@ -2851,10 +2862,10 @@ begin
 //      Writeln('"',C,'" : IBC : ',IBC,' HB  : ',HB,' LQ  : ',LQ,' P>MaxCol : ',P>MaxCol);
       end;
     Result:=Result+Copy(L,1,P-1);
-    If Not HB then
-      Result:=Result+BreakStr;
     Delete(L,1,P-1);
     Len:=Length(L);
+    If (Len>0) and Not HB then
+      Result:=Result+BreakStr;
     end;
 end;
 

+ 57 - 2
tests/test/units/fpcunit/tcstrutils.pp

@@ -1,6 +1,7 @@
 unit tcstrutils;
 
 {$mode objfpc}{$H+}
+{$codepage utf8}
 
 interface
 
@@ -9,8 +10,6 @@ uses
 
 type
 
-  { TTestSearchBuf }
-
   TTestSearchBuf= class(TTestCase)
   Private
     Procedure TestSearch(Sub:String; Start : Integer; O : TStringSearchOptions; Expected : Integer);
@@ -41,6 +40,14 @@ type
     Procedure TestDecodeSoundexInt;
   end;
 
+
+  TTestGeneral = class(TTestCase)
+  published
+    procedure TestIndexStr;
+    procedure TestMatchStr;
+  end;
+
+
 implementation
 
 Const
@@ -258,8 +265,56 @@ begin
   TestSearch('in',0,[soWholeWord,soDown],39);
 end;
 
+procedure TTestGeneral.TestIndexStr;
+var
+  s: UnicodeString;
+  a: array of UnicodeString;
+begin
+  s := 'Henry';
+  AssertTrue('Failed on 1', IndexStr(s, ['Brian', 'Jim', 'Henry']) = 2);
+  AssertTrue('Failed on 2', IndexStr(s, ['Brian', 'Jim', 'henry']) = -1);
+  AssertTrue('Failed on 3', IndexStr(s, ['BRIAN', 'JIM', 'HENRY']) = -1);
+  s := 'HENRY';
+  AssertTrue('Failed on 4', IndexStr(s, ['BRIAN', 'HENRY', 'JIM']) = 1);
+
+  SetLength(a, 3);
+  a[0] := 'Brian';
+  a[1] := 'Jim';
+  a[2] := 'Henry';
+  AssertTrue('Failed on 5', IndexStr(s, a) = -1);
+  s := 'Henry';
+  AssertTrue('Failed on 6', IndexStr(s, a) = 2);
+  a[2] := 'henry';
+  AssertTrue('Failed on 7', IndexStr(s, a) = -1);
+end;
+
+procedure TTestGeneral.TestMatchStr;
+var
+  s: UnicodeString;
+  a: array of UnicodeString;
+begin
+  s := 'Henry';
+  AssertEquals('Failed on 1', True, MatchStr(s, ['Brian', 'Jim', 'Henry']));
+  AssertEquals('Failed on 2', False, MatchStr(s, ['Brian', 'Jim', 'henry']));
+  AssertEquals('Failed on 3', False, MatchStr(s, ['BRIAN', 'JIM', 'HENRY']));
+  s := 'HENRY';
+  AssertEquals('Failed on 4', True, MatchStr(s, ['BRIAN', 'HENRY', 'JIM']));
+
+  SetLength(a, 3);
+  a[0] := 'Brian';
+  a[1] := 'Jim';
+  a[2] := 'Henry';
+  AssertEquals('Failed on 5', False, MatchStr(s, a));
+  s := 'Henry';
+  AssertEquals('Failed on 6', True, MatchStr(s, a));
+  a[2] := 'henry';
+  AssertEquals('Failed on 7', False, MatchStr(s, a));
+end;
+
+
 initialization
   RegisterTest(TTestSearchBuf);
+  RegisterTest(TTestGeneral);
   writeln ('Testing with ', WhichSearchbuf, ' implementation');
   writeln;
 end.

+ 28 - 111
tests/test/units/fpcunit/tstrutils.lpi

@@ -1,19 +1,24 @@
-<?xml version="1.0"?>
+<?xml version="1.0" encoding="UTF-8"?>
 <CONFIG>
   <ProjectOptions>
-    <PathDelim Value="/"/>
-    <Version Value="6"/>
+    <Version Value="9"/>
     <General>
+      <Flags>
+        <LRSInOutputDirectory Value="False"/>
+      </Flags>
+      <SessionStorage Value="InProjectDir"/>
       <MainUnit Value="0"/>
-      <IconPath Value="./"/>
-      <TargetFileExt Value=""/>
-      <ActiveEditorIndexAtStart Value="0"/>
+      <Title Value="FPCUnit Console test runner"/>
+      <ResourceType Value="res"/>
     </General>
     <VersionInfo>
-      <ProjectVersion Value=""/>
       <Language Value=""/>
       <CharSet Value=""/>
+      <StringTable ProductVersion=""/>
     </VersionInfo>
+    <BuildModes Count="1">
+      <Item1 Name="default" Default="True"/>
+    </BuildModes>
     <PublishOptions>
       <Version Value="2"/>
       <IgnoreBinaries Value="False"/>
@@ -27,131 +32,43 @@
         <LaunchingApplication PathPlusParams="/usr/X11R6/bin/xterm -T 'Lazarus Run Output' -e $(LazarusDir)/tools/runwait.sh $(TargetCmdLine)"/>
       </local>
     </RunParams>
-    <RequiredPackages Count="2">
+    <RequiredPackages Count="1">
       <Item1>
-        <PackageName Value="FCL"/>
-      </Item1>
-      <Item2>
         <PackageName Value="FPCUnitConsoleRunner"/>
-      </Item2>
+      </Item1>
     </RequiredPackages>
-    <Units Count="11">
+    <Units Count="4">
       <Unit0>
         <Filename Value="tstrutils.lpr"/>
         <IsPartOfProject Value="True"/>
-        <UnitName Value="tstrutils"/>
-        <CursorPos X="37" Y="6"/>
-        <TopLine Value="1"/>
-        <EditorIndex Value="6"/>
-        <UsageCount Value="44"/>
-        <Loaded Value="True"/>
       </Unit0>
       <Unit1>
         <Filename Value="tcstrutils.pp"/>
         <IsPartOfProject Value="True"/>
-        <UnitName Value="tcstrutils"/>
-        <CursorPos X="1" Y="163"/>
-        <TopLine Value="148"/>
-        <EditorIndex Value="0"/>
-        <UsageCount Value="44"/>
-        <Loaded Value="True"/>
       </Unit1>
       <Unit2>
         <Filename Value="tcstringlist.pp"/>
         <IsPartOfProject Value="True"/>
-        <UnitName Value="tcstringlist"/>
-        <CursorPos X="19" Y="47"/>
-        <TopLine Value="1"/>
-        <EditorIndex Value="2"/>
-        <UsageCount Value="44"/>
-        <Loaded Value="True"/>
       </Unit2>
       <Unit3>
-        <Filename Value="../../../../fpc/packages/fcl-fpcunit/src/fpcunit.pp"/>
-        <UnitName Value="fpcunit"/>
-        <CursorPos X="6" Y="554"/>
-        <TopLine Value="524"/>
-        <UsageCount Value="8"/>
-      </Unit3>
-      <Unit4>
-        <Filename Value="../../../../fpc/rtl/objpas/classes/classesh.inc"/>
-        <CursorPos X="1" Y="233"/>
-        <TopLine Value="212"/>
-        <EditorIndex Value="4"/>
-        <UsageCount Value="22"/>
-        <Loaded Value="True"/>
-      </Unit4>
-      <Unit5>
-        <Filename Value="searchbuf.inc"/>
-        <CursorPos X="47" Y="117"/>
-        <TopLine Value="65"/>
-        <UsageCount Value="8"/>
-      </Unit5>
-      <Unit6>
         <Filename Value="tclist.pp"/>
         <IsPartOfProject Value="True"/>
-        <UnitName Value="tclist"/>
-        <CursorPos X="66" Y="341"/>
-        <TopLine Value="346"/>
-        <EditorIndex Value="3"/>
-        <UsageCount Value="44"/>
-        <Loaded Value="True"/>
-      </Unit6>
-      <Unit7>
-        <Filename Value="../../../../fpc/rtl/objpas/classes/resreference.inc"/>
-        <CursorPos X="39" Y="345"/>
-        <TopLine Value="311"/>
-        <UsageCount Value="21"/>
-      </Unit7>
-      <Unit8>
-        <Filename Value="../../../../fpc/rtl/objpas/classes/lists.inc"/>
-        <CursorPos X="20" Y="271"/>
-        <TopLine Value="222"/>
-        <EditorIndex Value="5"/>
-        <UsageCount Value="21"/>
-        <Loaded Value="True"/>
-      </Unit8>
-      <Unit9>
-        <Filename Value="testll.pp"/>
-        <UnitName Value="Testll"/>
-        <CursorPos X="1" Y="1"/>
-        <TopLine Value="1"/>
-        <UsageCount Value="20"/>
-      </Unit9>
-      <Unit10>
-        <Filename Value="../../../../testsi.pp"/>
-        <UnitName Value="testsi"/>
-        <CursorPos X="1" Y="12"/>
-        <TopLine Value="1"/>
-        <EditorIndex Value="1"/>
-        <UsageCount Value="10"/>
-        <Loaded Value="True"/>
-      </Unit10>
+      </Unit3>
     </Units>
-    <JumpHistory Count="2" HistoryIndex="1">
-      <Position1>
-        <Filename Value="tcstrutils.pp"/>
-        <Caret Line="164" Column="5" TopLine="109"/>
-      </Position1>
-      <Position2>
-        <Filename Value="tcstrutils.pp"/>
-        <Caret Line="163" Column="1" TopLine="161"/>
-      </Position2>
-    </JumpHistory>
   </ProjectOptions>
   <CompilerOptions>
-    <Version Value="5"/>
-    <CodeGeneration>
-      <Generate Value="Faster"/>
-    </CodeGeneration>
-    <Linking>
-      <Debugging>
-        <GenerateDebugInfo Value="True"/>
-      </Debugging>
-    </Linking>
-    <Other>
-      <CompilerPath Value="$(CompPath)"/>
-    </Other>
+    <Version Value="11"/>
+    <Target>
+      <Filename Value="tstrutils"/>
+    </Target>
+    <SearchPaths>
+      <UnitOutputDirectory Value="units"/>
+    </SearchPaths>
+    <Parsing>
+      <SyntaxOptions>
+        <AllowLabel Value="False"/>
+      </SyntaxOptions>
+    </Parsing>
   </CompilerOptions>
   <Debugging>
     <Exceptions Count="2">

+ 1 - 0
tests/test/units/fpcunit/tstrutils.lpr

@@ -3,6 +3,7 @@ program tstrutils;
 {$mode objfpc}{$H+}
 
 uses
+  cwstring,
   Classes, consoletestrunner, tcstrutils, tcstringlist, tclist;
 
 type