paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-08-28 19:20:17 +02:00
Code Issues Packages Projects Releases Wiki Activity

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

Browse Source 
git-svn-id: branches/fixes_3_0@33839 -
This commit is contained in:
marco 2016-05-28 13:35:24 +00:00
parent 38a19f9f32
commit 874a86309f
10 changed files with 446 additions and 298 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

362
packages/rtl-objpas/src/inc/strutils.pp
View File

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

4
rtl/inc/resh.inc
View File

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

37
rtl/inc/sstrings.inc
View File

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

4
rtl/inc/sysres.inc
View File

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

10
rtl/objpas/classes/classesh.inc
View File

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

109
rtl/objpas/classes/stringl.inc
View File

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

17
rtl/objpas/sysutils/sysstr.inc
View File

@ -2204,6 +2204,17 @@ Var
End; End;
If (J<>0) then If (J<>0) then
Digits[1]:='-'; 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; Exp := 0;
End End
Else Else
@ -2843,7 +2854,7 @@ begin
Inc(P,Blen) Inc(P,Blen)
else else
begin begin
If (P>MaxCol) then If (P>=MaxCol) then
IBC:=C in BreakChars; IBC:=C in BreakChars;
Inc(P); Inc(P);
end; end;
@ -2851,10 +2862,10 @@ begin
// Writeln('"',C,'" : IBC : ',IBC,' HB : ',HB,' LQ : ',LQ,' P>MaxCol : ',P>MaxCol); // Writeln('"',C,'" : IBC : ',IBC,' HB : ',HB,' LQ : ',LQ,' P>MaxCol : ',P>MaxCol);
end; end;
Result:=Result+Copy(L,1,P-1); Result:=Result+Copy(L,1,P-1);
If Not HB then
Result:=Result+BreakStr;
Delete(L,1,P-1); Delete(L,1,P-1);
Len:=Length(L); Len:=Length(L);
If (Len>0) and Not HB then
Result:=Result+BreakStr;
end; end;
end; end;

59
tests/test/units/fpcunit/tcstrutils.pp
View File

@ -1,6 +1,7 @@
unit tcstrutils; unit tcstrutils;
{$mode objfpc}{$H+} {$mode objfpc}{$H+}
{$codepage utf8}
interface interface
@ -9,8 +10,6 @@ uses
type type
{ TTestSearchBuf }
TTestSearchBuf= class(TTestCase) TTestSearchBuf= class(TTestCase)
Private Private
Procedure TestSearch(Sub:String; Start : Integer; O : TStringSearchOptions; Expected : Integer); Procedure TestSearch(Sub:String; Start : Integer; O : TStringSearchOptions; Expected : Integer);
@ -41,6 +40,14 @@ type
Procedure TestDecodeSoundexInt; Procedure TestDecodeSoundexInt;
end; end;
TTestGeneral = class(TTestCase)
published
procedure TestIndexStr;
procedure TestMatchStr;
end;
implementation implementation
Const Const
@ -258,8 +265,56 @@ begin
TestSearch('in',0,[soWholeWord,soDown],39); TestSearch('in',0,[soWholeWord,soDown],39);
end; 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 initialization
RegisterTest(TTestSearchBuf); RegisterTest(TTestSearchBuf);
RegisterTest(TTestGeneral);
writeln ('Testing with ', WhichSearchbuf, ' implementation'); writeln ('Testing with ', WhichSearchbuf, ' implementation');
writeln; writeln;
end. end.

139
tests/test/units/fpcunit/tstrutils.lpi
View File

@ -1,19 +1,24 @@
<?xml version="1.0"?> <?xml version="1.0" encoding="UTF-8"?>
<CONFIG> <CONFIG>
<ProjectOptions> <ProjectOptions>
<PathDelim Value="/"/> <Version Value="9"/>
<Version Value="6"/>
<General> <General>
<Flags>
<LRSInOutputDirectory Value="False"/>
</Flags>
<SessionStorage Value="InProjectDir"/>
<MainUnit Value="0"/> <MainUnit Value="0"/>
<IconPath Value="./"/> <Title Value="FPCUnit Console test runner"/>
<TargetFileExt Value=""/> <ResourceType Value="res"/>
<ActiveEditorIndexAtStart Value="0"/>
</General> </General>
<VersionInfo> <VersionInfo>
<ProjectVersion Value=""/>
<Language Value=""/> <Language Value=""/>
<CharSet Value=""/> <CharSet Value=""/>
<StringTable ProductVersion=""/>
</VersionInfo> </VersionInfo>
<BuildModes Count="1">
<Item1 Name="default" Default="True"/>
</BuildModes>
<PublishOptions> <PublishOptions>
<Version Value="2"/> <Version Value="2"/>
<IgnoreBinaries Value="False"/> <IgnoreBinaries Value="False"/>
@ -27,131 +32,43 @@
<LaunchingApplication PathPlusParams="/usr/X11R6/bin/xterm -T 'Lazarus Run Output' -e $(LazarusDir)/tools/runwait.sh $(TargetCmdLine)"/> <LaunchingApplication PathPlusParams="/usr/X11R6/bin/xterm -T 'Lazarus Run Output' -e $(LazarusDir)/tools/runwait.sh $(TargetCmdLine)"/>
</local> </local>
</RunParams> </RunParams>
<RequiredPackages Count="2"> <RequiredPackages Count="1">
<Item1> <Item1>
<PackageName Value="FCL"/>
</Item1>
<Item2>
<PackageName Value="FPCUnitConsoleRunner"/> <PackageName Value="FPCUnitConsoleRunner"/>
</Item2> </Item1>
</RequiredPackages> </RequiredPackages>
<Units Count="11"> <Units Count="4">
<Unit0> <Unit0>
<Filename Value="tstrutils.lpr"/> <Filename Value="tstrutils.lpr"/>
<IsPartOfProject Value="True"/> <IsPartOfProject Value="True"/>
<UnitName Value="tstrutils"/>
<CursorPos X="37" Y="6"/>
<TopLine Value="1"/>
<EditorIndex Value="6"/>
<UsageCount Value="44"/>
<Loaded Value="True"/>
</Unit0> </Unit0>
<Unit1> <Unit1>
<Filename Value="tcstrutils.pp"/> <Filename Value="tcstrutils.pp"/>
<IsPartOfProject Value="True"/> <IsPartOfProject Value="True"/>
<UnitName Value="tcstrutils"/>
<CursorPos X="1" Y="163"/>
<TopLine Value="148"/>
<EditorIndex Value="0"/>
<UsageCount Value="44"/>
<Loaded Value="True"/>
</Unit1> </Unit1>
<Unit2> <Unit2>
<Filename Value="tcstringlist.pp"/> <Filename Value="tcstringlist.pp"/>
<IsPartOfProject Value="True"/> <IsPartOfProject Value="True"/>
<UnitName Value="tcstringlist"/>
<CursorPos X="19" Y="47"/>
<TopLine Value="1"/>
<EditorIndex Value="2"/>
<UsageCount Value="44"/>
<Loaded Value="True"/>
</Unit2> </Unit2>
<Unit3> <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"/> <Filename Value="tclist.pp"/>
<IsPartOfProject Value="True"/> <IsPartOfProject Value="True"/>
<UnitName Value="tclist"/> </Unit3>
<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>
</Units> </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> </ProjectOptions>
<CompilerOptions> <CompilerOptions>
<Version Value="5"/> <Version Value="11"/>
<CodeGeneration> <Target>
<Generate Value="Faster"/> <Filename Value="tstrutils"/>
</CodeGeneration> </Target>
<Linking> <SearchPaths>
<Debugging> <UnitOutputDirectory Value="units"/>
<GenerateDebugInfo Value="True"/> </SearchPaths>
</Debugging> <Parsing>
</Linking> <SyntaxOptions>
<Other> <AllowLabel Value="False"/>
<CompilerPath Value="$(CompPath)"/> </SyntaxOptions>
</Other> </Parsing>
</CompilerOptions> </CompilerOptions>
<Debugging> <Debugging>
<Exceptions Count="2"> <Exceptions Count="2">

1
tests/test/units/fpcunit/tstrutils.lpr
View File

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