paweld/fpc
1
0
Fork 0
mirror of https://gitlab.com/freepascal.org/fpc/source.git synced 2025-04-22 06:49:27 +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 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: 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
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

4
rtl/inc/resh.inc
View File

@ -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

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;
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;

4
rtl/inc/sysres.inc
View File

@ -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);

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

@ -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}

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

@ -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);

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

@ -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;

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

@ -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.

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>
<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
tests/test/units/fpcunit/tstrutils.lpr
View File

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