From 874a86309f1e17baeaf352b0baf18927359dbe42 Mon Sep 17 00:00:00 2001 From: marco Date: Sat, 28 May 2016 13:35:24 +0000 Subject: [PATCH] # revisions: 32540,32818,32939,33299,33305,33328,33329,33339,33342,33344,33700,33829 git-svn-id: branches/fixes_3_0@33839 - --- packages/rtl-objpas/src/inc/strutils.pp | 362 ++++++++++++++++-------- rtl/inc/resh.inc | 4 +- rtl/inc/sstrings.inc | 37 ++- rtl/inc/sysres.inc | 4 +- rtl/objpas/classes/classesh.inc | 10 +- rtl/objpas/classes/stringl.inc | 111 +++++--- rtl/objpas/sysutils/sysstr.inc | 17 +- tests/test/units/fpcunit/tcstrutils.pp | 59 +++- tests/test/units/fpcunit/tstrutils.lpi | 139 ++------- tests/test/units/fpcunit/tstrutils.lpr | 1 + 10 files changed, 446 insertions(+), 298 deletions(-) diff --git a/packages/rtl-objpas/src/inc/strutils.pp b/packages/rtl-objpas/src/inc/strutils.pp index 1e86bfab39..5def35f24d 100644 --- a/packages/rtl-objpas/src/inc/strutils.pp +++ b/packages/rtl-objpas/src/inc/strutils.pp @@ -44,6 +44,8 @@ Function AnsiEndsStr(const ASubText, AText: string): Boolean; Function AnsiReplaceStr(const AText, AFromText, AToText: string): string;inline; Function AnsiMatchStr(const AText: string; const AValues: array of string): Boolean;inline; Function AnsiIndexStr(const AText: string; const AValues: array of string): Integer; +Function MatchStr(const AText: UnicodeString; const AValues: array of UnicodeString): Boolean; +Function IndexStr(const AText: UnicodeString; const AValues: array of UnicodeString): Integer; { --------------------------------------------------------------------- Miscellaneous @@ -62,18 +64,18 @@ function NaturalCompareText(const Str1, Str2: string; const ADecSeparator, AThou VB emulations. ---------------------------------------------------------------------} -Function LeftStr(const AText: AnsiString; const ACount: Integer): AnsiString;inline; -Function RightStr(const AText: AnsiString; const ACount: Integer): AnsiString; -Function MidStr(const AText: AnsiString; const AStart, ACount: Integer): AnsiString;inline; -Function RightBStr(const AText: AnsiString; const AByteCount: Integer): AnsiString;inline; -Function MidBStr(const AText: AnsiString; const AByteStart, AByteCount: Integer): AnsiString;inline; -Function AnsiLeftStr(const AText: AnsiString; const ACount: Integer): AnsiString;inline; -Function AnsiRightStr(const AText: AnsiString; const ACount: Integer): AnsiString;inline; -Function AnsiMidStr(const AText: AnsiString; const AStart, ACount: Integer): AnsiString;inline; -Function LeftBStr(const AText: AnsiString; const AByteCount: Integer): AnsiString;inline; -Function LeftStr(const AText: WideString; const ACount: Integer): WideString;inline; -Function RightStr(const AText: WideString; const ACount: Integer): WideString; -Function MidStr(const AText: WideString; const AStart, ACount: Integer): WideString;inline; +Function LeftStr(const AText: AnsiString; const ACount: SizeInt): AnsiString;inline; +Function RightStr(const AText: AnsiString; const ACount: SizeInt): AnsiString; +Function MidStr(const AText: AnsiString; const AStart, ACount: SizeInt): AnsiString;inline; +Function RightBStr(const AText: AnsiString; const AByteCount: SizeInt): AnsiString;inline; +Function MidBStr(const AText: AnsiString; const AByteStart, AByteCount: SizeInt): AnsiString;inline; +Function AnsiLeftStr(const AText: AnsiString; const ACount: SizeInt): AnsiString;inline; +Function AnsiRightStr(const AText: AnsiString; const ACount: SizeInt): AnsiString;inline; +Function AnsiMidStr(const AText: AnsiString; const AStart, ACount: SizeInt): AnsiString;inline; +Function LeftBStr(const AText: AnsiString; const AByteCount: SizeInt): AnsiString;inline; +Function LeftStr(const AText: WideString; const ACount: SizeInt): WideString;inline; +Function RightStr(const AText: WideString; const ACount: SizeInt): WideString; +Function MidStr(const AText: WideString; const AStart, ACount: SizeInt): WideString;inline; { --------------------------------------------------------------------- Extended search and replace @@ -91,11 +93,14 @@ type TStringSearchOptions = set of TStringSearchOption; TStringSeachOption = TStringSearchOption; -Function SearchBuf(Buf: PChar; BufLen: Integer; SelStart, SelLength: Integer; SearchString: String; Options: TStringSearchOptions): PChar; -Function SearchBuf(Buf: PChar; BufLen: Integer; SelStart, SelLength: Integer; SearchString: String): PChar;inline; // ; Options: TStringSearchOptions = [soDown] -Function PosEx(const SubStr, S: string; Offset: Cardinal): Integer; -Function PosEx(const SubStr, S: string): Integer;inline; // Offset: Cardinal = 1 -Function PosEx(c:char; const S: string; Offset: Cardinal): Integer; +Function SearchBuf(Buf: PChar; BufLen: SizeInt; SelStart, SelLength: SizeInt; SearchString: String; Options: TStringSearchOptions): PChar; +Function SearchBuf(Buf: PChar; BufLen: SizeInt; SelStart, SelLength: SizeInt; SearchString: String): PChar;inline; // ; Options: TStringSearchOptions = [soDown] +Function PosEx(const SubStr, S: string; Offset: SizeUint): SizeInt; +Function PosEx(const SubStr, S: string): SizeInt;inline; // Offset: Cardinal = 1 +Function PosEx(c:char; const S: string; Offset: SizeUint): SizeInt; +Function PosEx(const SubStr, S: UnicodeString; Offset: SizeUint): SizeInt; +Function PosEx(c: WideChar; const S: UnicodeString; Offset: SizeUint): SizeInt; +Function PosEx(const SubStr, S: UnicodeString): Sizeint;inline; // Offset: Cardinal = 1 function StringsReplace(const S: string; OldPattern, NewPattern: array of string; Flags: TReplaceFlags): string; { --------------------------------------------------------------------- @@ -149,29 +154,35 @@ function DelSpace(const S: string): string; function DelChars(const S: string; Chr: Char): string; function DelSpace1(const S: string): string; function Tab2Space(const S: string; Numb: Byte): string; -function NPos(const C: string; S: string; N: Integer): Integer; -Function RPosEX(C:char;const S : AnsiString;offs:cardinal):Integer; overload; -Function RPosex (Const Substr : AnsiString; Const Source : AnsiString;offs:cardinal) : Integer; overload; -Function RPos(c:char;const S : AnsiString):Integer; overload; -Function RPos (Const Substr : AnsiString; Const Source : AnsiString) : Integer; overload; +function NPos(const C: string; S: string; N: Integer): SizeInt; +Function RPosEX(C:char;const S : AnsiString;offs:cardinal):SizeInt; overload; +Function RPosex (Const Substr : AnsiString; Const Source : AnsiString;offs:cardinal) : SizeInt; overload; +Function RPos(c:char;const S : AnsiString):SizeInt; overload; +Function RPos (Const Substr : AnsiString; Const Source : AnsiString) : SizeInt; overload; function AddChar(C: Char; const S: string; N: Integer): string; function AddCharR(C: Char; const S: string; N: Integer): string; function PadLeft(const S: string; N: Integer): string;inline; function PadRight(const S: string; N: Integer): string;inline; -function PadCenter(const S: string; Len: Integer): string; +function PadCenter(const S: string; Len: SizeInt): string; function Copy2Symb(const S: string; Symb: Char): string; function Copy2SymbDel(var S: string; Symb: Char): string; function Copy2Space(const S: string): string;inline; function Copy2SpaceDel(var S: string): string;inline; function AnsiProperCase(const S: string; const WordDelims: TSysCharSet): string; -function WordCount(const S: string; const WordDelims: TSysCharSet): Integer; -function WordPosition(const N: Integer; const S: string; const WordDelims: TSysCharSet): Integer; +function WordCount(const S: string; const WordDelims: TSysCharSet): SizeInt; +function WordPosition(const N: Integer; const S: string; const WordDelims: TSysCharSet): SizeInt; function ExtractWord(N: Integer; const S: string; const WordDelims: TSysCharSet): string;inline; -function ExtractWordPos(N: Integer; const S: string; const WordDelims: TSysCharSet; var Pos: Integer): string; +{$IF SIZEOF(SIZEINT)<>SIZEOF(INTEGER)} +function ExtractWordPos(N: Integer; const S: string; const WordDelims: TSysCharSet; out Pos: SizeInt): string; +{$ENDIF} +function ExtractWordPos(N: Integer; const S: string; const WordDelims: TSysCharSet; out Pos: Integer): string; function ExtractDelimited(N: Integer; const S: string; const Delims: TSysCharSet): string; +{$IF SIZEOF(SIZEINT)<>SIZEOF(INTEGER)} +function ExtractSubstr(const S: string; var Pos: SizeInt; const Delims: TSysCharSet): string; +{$ENDIF} function ExtractSubstr(const S: string; var Pos: Integer; const Delims: TSysCharSet): string; function IsWordPresent(const W, S: string; const WordDelims: TSysCharSet): Boolean; -function FindPart(const HelpWilds, InputStr: string): Integer; +function FindPart(const HelpWilds, InputStr: string): SizeInt; function IsWild(InputStr, Wilds: string; IgnoreCase: Boolean): Boolean; function XorString(const Key, Src: ShortString): ShortString; function XorEncode(const Key, Source: string): string; @@ -197,10 +208,10 @@ const StdWordDelims = [#0..' ',',','.',';','/','\',':','''','"','`'] + Brackets; StdSwitchChars = ['-','/']; -function PosSet (const c:TSysCharSet;const s : ansistring ):Integer; -function PosSet (const c:string;const s : ansistring ):Integer; -function PosSetEx (const c:TSysCharSet;const s : ansistring;count:Integer ):Integer; -function PosSetEx (const c:string;const s : ansistring;count:Integer ):Integer; +function PosSet (const c:TSysCharSet;const s : ansistring ):SizeInt; +function PosSet (const c:string;const s : ansistring ):SizeInt; +function PosSetEx (const c:TSysCharSet;const s : ansistring;count:Integer ):SizeInt; +function PosSetEx (const c:string;const s : ansistring;count:Integer ):SizeInt; Procedure Removeleadingchars(VAR S : AnsiString; Const CSet:TSysCharset); Procedure RemoveTrailingChars(VAR S : AnsiString;Const CSet:TSysCharset); @@ -804,7 +815,7 @@ end; procedure FindMatchesBoyerMooreCaseSensitive(const S,OldPattern: String; out aMatches: SizeIntArray; const aMatchAll: Boolean); Var - I : Integer; + I : SizeInt; begin FindMatchesBoyerMooreCaseSensitive(PChar(S),Pchar(OldPattern),Length(S),Length(OldPattern),aMatches,aMatchAll); @@ -815,7 +826,7 @@ end; procedure FindMatchesBoyerMooreCaseInSensitive(const S, OldPattern: String; out aMatches: SizeIntArray; const aMatchAll: Boolean); Var - I : Integer; + I : SizeInt; begin FindMatchesBoyerMooreCaseInSensitive(PChar(S),Pchar(OldPattern),Length(S),Length(OldPattern),aMatches,aMatchAll); @@ -902,11 +913,12 @@ end; Function AnsiIndexText(const AText: string; const AValues: array of string): Integer; -var i : longint; +var + i : Integer; begin - result:=-1; - if high(AValues)=-1 Then + Result:=-1; + if (high(AValues)=-1) or (High(AValues)>MaxInt) Then Exit; for i:=low(AValues) to High(Avalues) do if CompareText(avalues[i],atext)=0 Then @@ -960,7 +972,7 @@ var i : longint; begin result:=-1; - if high(AValues)=-1 Then + if (high(AValues)=-1) or (High(AValues)>MaxInt) Then Exit; for i:=low(AValues) to High(Avalues) do if (avalues[i]=AText) Then @@ -968,13 +980,31 @@ begin end; +Function MatchStr(const AText: UnicodeString; const AValues: array of UnicodeString): Boolean; +begin + Result := IndexStr(AText,AValues) <> -1; +end; + + +Function IndexStr(const AText: UnicodeString; const AValues: array of UnicodeString): Integer; +var + i: longint; +begin + Result := -1; + if (high(AValues) = -1) or (High(AValues) > MaxInt) Then + Exit; + for i := low(AValues) to High(Avalues) do + if (avalues[i] = AText) Then + exit(i); // make sure it is the first val. +end; + { --------------------------------------------------------------------- Playthingies ---------------------------------------------------------------------} Function DupeString(const AText: string; ACount: Integer): string; -var i,l : integer; +var i,l : SizeInt; begin result:=''; @@ -990,7 +1020,7 @@ end; Function ReverseString(const AText: string): string; var - i,j:longint; + i,j : SizeInt; begin setlength(result,length(atext)); @@ -1067,14 +1097,14 @@ function NaturalCompareText(const Str1, Str2: string; const ADecSeparator, AThou var Num1, Num2: double; pStr1, pStr2: PChar; - Len1, Len2: integer; - TextLen1, TextLen2: integer; + Len1, Len2: SizeInt; + TextLen1, TextLen2: SizeInt; TextStr1: string = ''; TextStr2: string = ''; - i: integer; - j: integer; + i: SizeInt; + j: SizeInt; - function Sign(const AValue: Integer): integer;inline; + function Sign(const AValue: sizeint): integer;inline; begin If Avalue<0 then @@ -1090,7 +1120,7 @@ var Result := ch in ['0'..'9']; end; - function GetInteger(var pch: PChar; var Len: integer): double; + function GetInteger(var pch: PChar; var Len: sizeint): double; begin Result := 0; while (pch^ <> #0) and IsNumber(pch^) do @@ -1203,15 +1233,15 @@ end; VB emulations. ---------------------------------------------------------------------} -Function LeftStr(const AText: AnsiString; const ACount: Integer): AnsiString;inline; +Function LeftStr(const AText: AnsiString; const ACount: SizeInt): AnsiString;inline; begin Result:=Copy(AText,1,ACount); end; -Function RightStr(const AText: AnsiString; const ACount: Integer): AnsiString; +Function RightStr(const AText: AnsiString; const ACount: SizeInt): AnsiString; -var j,l:integer; +var j,l:SizeInt; begin l:=length(atext); @@ -1220,7 +1250,7 @@ begin Result:=Copy(AText,l-j+1,j); end; -Function MidStr(const AText: AnsiString; const AStart, ACount: Integer): AnsiString;inline; +Function MidStr(const AText: AnsiString; const AStart, ACount: SizeInt): AnsiString;inline; begin if (ACount=0) or (AStart>length(atext)) then @@ -1230,52 +1260,52 @@ end; -Function LeftBStr(const AText: AnsiString; const AByteCount: Integer): AnsiString;inline; +Function LeftBStr(const AText: AnsiString; const AByteCount: SizeInt): AnsiString;inline; begin Result:=LeftStr(AText,AByteCount); end; -Function RightBStr(const AText: AnsiString; const AByteCount: Integer): AnsiString;inline; +Function RightBStr(const AText: AnsiString; const AByteCount: SizeInt): AnsiString;inline; begin Result:=RightStr(Atext,AByteCount); end; -Function MidBStr(const AText: AnsiString; const AByteStart, AByteCount: Integer): AnsiString;inline; +Function MidBStr(const AText: AnsiString; const AByteStart, AByteCount: SizeInt): AnsiString;inline; begin Result:=MidStr(AText,AByteStart,AByteCount); end; -Function AnsiLeftStr(const AText: AnsiString; const ACount: Integer): AnsiString;inline; +Function AnsiLeftStr(const AText: AnsiString; const ACount: SizeInt): AnsiString;inline; begin Result := copy(AText,1,ACount); end; -Function AnsiRightStr(const AText: AnsiString; const ACount: Integer): AnsiString;inline; +Function AnsiRightStr(const AText: AnsiString; const ACount: SizeInt): AnsiString;inline; begin Result := copy(AText,length(AText)-ACount+1,ACount); end; -Function AnsiMidStr(const AText: AnsiString; const AStart, ACount: Integer): AnsiString;inline; +Function AnsiMidStr(const AText: AnsiString; const AStart, ACount: SizeInt): AnsiString;inline; begin Result:=Copy(AText,AStart,ACount); end; -Function LeftStr(const AText: WideString; const ACount: Integer): WideString;inline; +Function LeftStr(const AText: WideString; const ACount: SizeInt): WideString;inline; begin Result:=Copy(AText,1,ACount); end; -Function RightStr(const AText: WideString; const ACount: Integer): WideString; +Function RightStr(const AText: WideString; const ACount: SizeInt): WideString; var - j,l:integer; + j,l:SizeInt; begin l:=length(atext); j:=ACount; @@ -1284,7 +1314,7 @@ begin end; -Function MidStr(const AText: WideString; const AStart, ACount: Integer): WideString;inline; +Function MidStr(const AText: WideString; const AStart, ACount: SizeInt): WideString;inline; begin Result:=Copy(AText,AStart,ACount); end; @@ -1387,7 +1417,7 @@ begin end; //function SearchDown(buf,aStart,endchar:pchar; SearchString:string; equal : TEqualFunction; WholeWords:boolean) : pchar; -function SearchBuf(Buf: PChar;BufLen: Integer;SelStart: Integer;SelLength: Integer; +function SearchBuf(Buf: PChar;BufLen: SizeInt;SelStart: SizeInt;SelLength: SizeInt; SearchString: String;Options: TStringSearchOptions):PChar; var equal : TEqualFunction; @@ -1409,12 +1439,12 @@ begin end; -Function SearchBuf(Buf: PChar; BufLen: Integer; SelStart, SelLength: Integer; SearchString: String): PChar;inline; // ; Options: TStringSearchOptions = [soDown] +Function SearchBuf(Buf: PChar; BufLen: SizeInt; SelStart, SelLength: SizeInt; SearchString: String): PChar;inline; // ; Options: TStringSearchOptions = [soDown] begin Result:=SearchBuf(Buf,BufLen,SelStart,SelLength,SearchString,[soDown]); end; -Function PosEx(const SubStr, S: string; Offset: Cardinal): Integer; +Function PosEx(const SubStr, S: string; Offset: SizeUint): SizeInt; var i,MaxLen, SubLen : SizeInt; @@ -1444,11 +1474,11 @@ begin end; end; -Function PosEx(c:char; const S: string; Offset: Cardinal): Integer; +Function PosEx(c:char; const S: string; Offset: SizeUint): SizeInt; var - Len : longint; - p: SizeInt; + p,Len : SizeInt; + begin Len := length(S); if (Offset < 1) or (Offset > SizeUInt(Length(S))) then exit(0); @@ -1460,11 +1490,62 @@ begin PosEx := p + sizeint(Offset); end; -Function PosEx(const SubStr, S: string): Integer;inline; // Offset: Cardinal = 1 +Function PosEx(const SubStr, S: string): SizeInt;inline; // Offset: Cardinal = 1 begin posex:=posex(substr,s,1); end; +Function PosEx(const SubStr, S: UnicodeString; Offset: SizeUint): SizeInt; + +var + i,MaxLen, SubLen : SizeInt; + SubFirst: WideChar; + pc : pwidechar; +begin + PosEx:=0; + SubLen := Length(SubStr); + if (SubLen > 0) and (Offset > 0) and (Offset <= Cardinal(Length(S))) then + begin + MaxLen := Length(S)- SubLen; + SubFirst := SubStr[1]; + i := indexword(S[Offset],Length(S) - Offset + 1, Word(SubFirst)); + while (i >= 0) and ((i + sizeint(Offset) - 1) <= MaxLen) do + begin + pc := @S[i+SizeInt(Offset)]; + //we know now that pc^ = SubFirst, because indexbyte returned a value > -1 + if (CompareWord(Substr[1],pc^,SubLen) = 0) then + begin + PosEx := i + SizeInt(Offset); + Exit; + end; + //point Offset to next char in S + Offset := sizeuint(i) + Offset + 1; + i := indexword(S[Offset],Length(S) - Offset + 1, Word(SubFirst)); + end; + end; +end; + +Function PosEx(c: WideChar; const S: UnicodeString; Offset: SizeUint): SizeInt; +var + Len,p : SizeInt; + +begin + Len := length(S); + if (Offset < 1) or (Offset > SizeUInt(Length(S))) then exit(0); + Len := length(S); + p := indexword(S[Offset],Len-offset+1,Word(c)); + if (p < 0) then + PosEx := 0 + else + PosEx := p + sizeint(Offset); +end; + +Function PosEx(const SubStr, S: UnicodeString): SizeInt;inline; // Offset: Cardinal = 1 +begin + PosEx:=PosEx(SubStr,S,1); +end; + + function StringsReplace(const S: string; OldPattern, NewPattern: array of string; Flags: TReplaceFlags): string; var pc,pcc,lastpc : pchar; @@ -1472,7 +1553,7 @@ var pc,pcc,lastpc : pchar; ResStr, CompStr : string; Found : Boolean; - sc : integer; + sc : sizeint; begin sc := length(OldPattern); @@ -1560,7 +1641,7 @@ Function Soundex(const AText: string; ALength: TSoundexLength): string; Var S,PS : Char; - I,L : integer; + I,L : SizeInt; begin Result:=''; @@ -1601,7 +1682,7 @@ Function SoundexInt(const AText: string; ALength: TSoundexIntLength): Integer; var SE: string; - I: Integer; + I: SizeInt; begin Result:=-1; @@ -1712,7 +1793,7 @@ end; function IsEmptyStr(const S: string; const EmptyChars: TSysCharSet): Boolean; var - i,l: Integer; + i,l: SizeInt; begin l:=Length(S); @@ -1734,7 +1815,7 @@ end; function DelChars(const S: string; Chr: Char): string; var - I,J: Integer; + I,J: SizeInt; begin Result:=S; @@ -1756,7 +1837,7 @@ end; function DelSpace1(const S: string): string; var - i: Integer; + I : SizeInt; begin Result:=S; @@ -1768,7 +1849,7 @@ end; function Tab2Space(const S: string; Numb: Byte): string; var - I: Integer; + I: SizeInt; begin I:=1; @@ -1785,10 +1866,10 @@ begin end; end; -function NPos(const C: string; S: string; N: Integer): Integer; +function NPos(const C: string; S: string; N: Integer): SizeInt; var - i,p,k: Integer; + i,p,k: SizeInt; begin Result:=0; @@ -1810,7 +1891,7 @@ end; function AddChar(C: Char; const S: string; N: Integer): string; Var - l : Integer; + l : SizeInt; begin Result:=S; @@ -1822,7 +1903,7 @@ end; function AddCharR(C: Char; const S: string; N: Integer): string; Var - l : Integer; + l : SizeInt; begin Result:=S; @@ -1847,7 +1928,7 @@ end; function Copy2Symb(const S: string; Symb: Char): string; var - p: Integer; + p: SizeInt; begin p:=Pos(Symb,S); @@ -1859,7 +1940,7 @@ end; function Copy2SymbDel(var S: string; Symb: Char): string; var - p: Integer; + p: SizeInt; begin p:=Pos(Symb,S); @@ -1888,7 +1969,6 @@ end; function AnsiProperCase(const S: string; const WordDelims: TSysCharSet): string; var -// l : Integer; P,PE : PChar; begin @@ -1906,7 +1986,7 @@ begin end; end; -function WordCount(const S: string; const WordDelims: TSysCharSet): Integer; +function WordCount(const S: string; const WordDelims: TSysCharSet): SizeInt; var P,PE : PChar; @@ -1926,7 +2006,7 @@ begin end; end; -function WordPosition(const N: Integer; const S: string; const WordDelims: TSysCharSet): Integer; +function WordPosition(const N: Integer; const S: string; const WordDelims: TSysCharSet): SizeInt; var PS,P,PE : PChar; @@ -1955,15 +2035,44 @@ end; function ExtractWord(N: Integer; const S: string; const WordDelims: TSysCharSet): string;inline; var - i: Integer; + i: SizeInt; begin Result:=ExtractWordPos(N,S,WordDelims,i); end; -function ExtractWordPos(N: Integer; const S: string; const WordDelims: TSysCharSet; var Pos: Integer): string; +function ExtractWordPos(N: Integer; const S: string; const WordDelims: TSysCharSet; out Pos: Integer): string; + var - i,j,l: 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) -(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 diff --git a/rtl/inc/resh.inc b/rtl/inc/resh.inc index f40690d085..9e0e60ce0e 100644 --- a/rtl/inc/resh.inc +++ b/rtl/inc/resh.inc @@ -65,8 +65,8 @@ Function LockResource(ResData: TFPResourceHGLOBAL): Pointer; Function UnlockResource(ResData: TFPResourceHGLOBAL): LongBool; Function FreeResource(ResData: TFPResourceHGLOBAL): LongBool; {$ifdef FPC_HAS_FEATURE_ANSISTRINGS} -Function FindResource(ModuleHandle: TFPResourceHMODULE; ResourceName, ResourceType: AnsiString): TFPResourceHandle; -Function FindResourceEx(ModuleHandle: TFPResourceHMODULE; ResourceType, ResourceName: AnsiString; Language : word): TFPResourceHandle; +Function FindResource(ModuleHandle: TFPResourceHMODULE; const ResourceName, ResourceType: AnsiString): TFPResourceHandle; +Function FindResourceEx(ModuleHandle: TFPResourceHMODULE; const ResourceType, ResourceName: AnsiString; Language : word): TFPResourceHandle; {$endif} type diff --git a/rtl/inc/sstrings.inc b/rtl/inc/sstrings.inc index 62147205b4..dcfaf43f96 100644 --- a/rtl/inc/sstrings.inc +++ b/rtl/inc/sstrings.inc @@ -1948,9 +1948,8 @@ function fpc_val_enum_shortstr(str2ordindex:pointer;const s:shortstring;out code function fpc_Val_Currency_ShortStr(const s : shortstring; out Code : ValSInt): currency; [public, alias:'FPC_VAL_CURRENCY_SHORTSTR']; compilerproc; const - MaxInt64 : Int64 = $7FFFFFFFFFFFFFFF; - Int64Edge : Int64 = ($7FFFFFFFFFFFFFFF - 10) div 10; - Int64Edge2 : Int64 = $7FFFFFFFFFFFFFFF div 10; + MinInt64 : Int64 =-$8000000000000000; + MinInt64Edge : Int64 = (-$8000000000000000 + 10) div 10; var { to enable taking the address on the JVM target } res : array[0..0] of Int64; @@ -1961,7 +1960,7 @@ begin res[0]:=0; len:=Length(s); Code:=1; - sign:=1; + sign:=-1; power:=0; while True do if Code > len then @@ -1973,10 +1972,12 @@ begin break; { Read sign } case s[Code] of - '+' : Inc(Code); + '+' : begin + Inc(Code); + end; '-' : begin - sign:=-1; - inc(code); + sign:=+1; + Inc(Code); end; end; { Read digits } @@ -1989,9 +1990,9 @@ begin begin j:=Ord(s[code])-Ord('0'); { check overflow } - if (res[0] <= Int64Edge) or (res[0] <= (MaxInt64 - j) div 10) then + if (res[0] >= MinInt64Edge) or (res[0] >= (MinInt64 + j) div 10) then begin - res[0]:=res[0]*10 + j; + res[0]:=res[0]*10 - j; Inc(i); end else @@ -2000,9 +2001,9 @@ begin exit else begin - if not FracOverflow and (j >= 5) and (res[0] < MaxInt64) then + if not FracOverflow and (j >= 5) and (res[0] > MinInt64) then { round if first digit of fractional part overflow } - Inc(res[0]); + Dec(res[0]); FracOverflow:=True; end; end; @@ -2063,7 +2064,7 @@ begin if power > 0 then begin for i:=1 to power do - if res[0] <= Int64Edge2 then + if res[0] >= MinInt64 div 10 then res[0]:=res[0]*10 else exit; @@ -2071,11 +2072,17 @@ begin else for i:=1 to -power do begin - if res[0] <= MaxInt64 - 5 then - Inc(res[0], 5); + if res[0] >= MinInt64 + 5 then + Dec(res[0], 5); res[0]:=res[0] div 10; end; - res[0]:=res[0]*sign; + + if sign <> 1 then + if res[0] > MinInt64 then + res[0]:=res[0]*sign + else + exit; + fpc_Val_Currency_ShortStr:=PCurrency(@res[0])^; Code:=0; end; diff --git a/rtl/inc/sysres.inc b/rtl/inc/sysres.inc index 1d03cd74bf..fb29ce73af 100644 --- a/rtl/inc/sysres.inc +++ b/rtl/inc/sysres.inc @@ -32,13 +32,13 @@ end; *****************************************************************************) {$ifdef FPC_HAS_FEATURE_ANSISTRINGS} -Function FindResource(ModuleHandle: TFPResourceHMODULE; ResourceName, ResourceType: AnsiString): TFPResourceHandle; +Function FindResource(ModuleHandle: TFPResourceHMODULE; const ResourceName, ResourceType: AnsiString): TFPResourceHandle; begin Result:=FindResource(ModuleHandle,PChar(ResourceName),PChar(ResourceType)); end; -Function FindResourceEx(ModuleHandle: TFPResourceHMODULE; ResourceType, ResourceName: AnsiString; Language : word): TFPResourceHandle; +Function FindResourceEx(ModuleHandle: TFPResourceHMODULE; const ResourceType, ResourceName: AnsiString; Language : word): TFPResourceHandle; begin Result:=FindResourceEx(ModuleHandle,PChar(ResourceType),PChar(ResourceName),Language); diff --git a/rtl/objpas/classes/classesh.inc b/rtl/objpas/classes/classesh.inc index 6ae157f27c..580a8e7217 100644 --- a/rtl/objpas/classes/classesh.inc +++ b/rtl/objpas/classes/classesh.inc @@ -729,6 +729,9 @@ type PStringItemList = ^TStringItemList; TStringItemList = array[0..MaxListSize] of TStringItem; + TStringsSortStyle = (sslNone,sslUser,sslAuto); + TStringsSortStyles = Set of TStringsSortStyle; + TStringList = class(TStrings) private FList: PStringItemList; @@ -738,15 +741,17 @@ type FOnChanging: TNotifyEvent; FDuplicates: TDuplicates; FCaseSensitive : Boolean; - FSorted: Boolean; FForceSort : Boolean; FOwnsObjects : Boolean; + FSortStyle: TStringsSortStyle; procedure ExchangeItemsInt(Index1, Index2: Integer); inline; + function GetSorted: Boolean; procedure Grow; procedure InternalClear(FromIndex : Integer = 0; ClearOnly : Boolean = False); procedure QuickSort(L, R: Integer; CompareFn: TStringListSortCompare); procedure SetSorted(Value: Boolean); procedure SetCaseSensitive(b : boolean); + procedure SetSortStyle(AValue: TStringsSortStyle); protected procedure ExchangeItems(Index1, Index2: Integer); virtual; procedure Changed; virtual; @@ -776,11 +781,12 @@ type procedure Sort; virtual; procedure CustomSort(CompareFn: TStringListSortCompare); virtual; property Duplicates: TDuplicates read FDuplicates write FDuplicates; - property Sorted: Boolean read FSorted write SetSorted; + property Sorted: Boolean read GetSorted write SetSorted; property CaseSensitive: Boolean read FCaseSensitive write SetCaseSensitive; property OnChange: TNotifyEvent read FOnChange write FOnChange; property OnChanging: TNotifyEvent read FOnChanging write FOnChanging; property OwnsObjects : boolean read FOwnsObjects write FOwnsObjects; + Property SortStyle : TStringsSortStyle Read FSortStyle Write SetSortStyle; end; {$else} diff --git a/rtl/objpas/classes/stringl.inc b/rtl/objpas/classes/stringl.inc index 5c50c0b3c0..ce8efff5ba 100644 --- a/rtl/objpas/classes/stringl.inc +++ b/rtl/objpas/classes/stringl.inc @@ -1044,7 +1044,7 @@ end; {$if not defined(FPC_TESTGENERICS)} -Procedure TStringList.ExchangeItemsInt(Index1, Index2: Integer); +procedure TStringList.ExchangeItemsInt(Index1, Index2: Integer); Var P1,P2 : Pointer; @@ -1057,14 +1057,19 @@ begin Pointer(Flist^[Index2].FObject):=P2; end; +function TStringList.GetSorted: Boolean; +begin + Result:=FSortStyle in [sslUser,sslAuto]; +end; -Procedure TStringList.ExchangeItems(Index1, Index2: Integer); + +procedure TStringList.ExchangeItems(Index1, Index2: Integer); begin ExchangeItemsInt(Index1, Index2); end; -Procedure TStringList.Grow; +procedure TStringList.Grow; Var NC : Integer; @@ -1080,7 +1085,7 @@ begin SetCapacity(NC); end; -Procedure TStringList.InternalClear(FromIndex : Integer = 0; ClearOnly : Boolean = False); +procedure TStringList.InternalClear(FromIndex: Integer; ClearOnly: Boolean); Var I: Integer; @@ -1107,7 +1112,8 @@ begin SetCapacity(0); end; -Procedure TStringList.QuickSort(L, R: Integer; CompareFn: TStringListSortCompare); +procedure TStringList.QuickSort(L, R: Integer; CompareFn: TStringListSortCompare + ); var Pivot, vL, vR: Integer; ExchangeProc: procedure(Left, Right: Integer) of object; @@ -1153,13 +1159,13 @@ begin end; -Procedure TStringList.InsertItem(Index: Integer; const S: string); +procedure TStringList.InsertItem(Index: Integer; const S: string); begin InsertItem(Index, S, nil); end; -Procedure TStringList.InsertItem(Index: Integer; const S: string; O: TObject); +procedure TStringList.InsertItem(Index: Integer; const S: string; O: TObject); begin Changing; If FCount=Fcapacity then Grow; @@ -1174,19 +1180,18 @@ begin end; -Procedure TStringList.SetSorted(Value: Boolean); +procedure TStringList.SetSorted(Value: Boolean); begin - If FSorted<>Value then - begin - If Value then sort; - FSorted:=VAlue - end; + If Value then + SortStyle:=sslAuto + else + SortStyle:=sslNone end; -Procedure TStringList.Changed; +procedure TStringList.Changed; begin If (FUpdateCount=0) Then @@ -1199,7 +1204,7 @@ end; -Procedure TStringList.Changing; +procedure TStringList.Changing; begin If FUpdateCount=0 then @@ -1209,7 +1214,7 @@ end; -Function TStringList.Get(Index: Integer): string; +function TStringList.Get(Index: Integer): string; begin If (Index<0) or (INdex>=Fcount) then @@ -1219,7 +1224,7 @@ end; -Function TStringList.GetCapacity: Integer; +function TStringList.GetCapacity: Integer; begin Result:=FCapacity; @@ -1227,7 +1232,7 @@ end; -Function TStringList.GetCount: Integer; +function TStringList.GetCount: Integer; begin Result:=FCount; @@ -1235,7 +1240,7 @@ end; -Function TStringList.GetObject(Index: Integer): TObject; +function TStringList.GetObject(Index: Integer): TObject; begin If (Index<0) or (INdex>=Fcount) then @@ -1245,7 +1250,7 @@ end; -Procedure TStringList.Put(Index: Integer; const S: string); +procedure TStringList.Put(Index: Integer; const S: string); begin If Sorted then @@ -1259,7 +1264,7 @@ end; -Procedure TStringList.PutObject(Index: Integer; AObject: TObject); +procedure TStringList.PutObject(Index: Integer; AObject: TObject); begin If (Index<0) or (INdex>=Fcount) then @@ -1271,7 +1276,7 @@ end; -Procedure TStringList.SetCapacity(NewCapacity: Integer); +procedure TStringList.SetCapacity(NewCapacity: Integer); Var NewList : Pointer; I,MSize : Longint; @@ -1316,7 +1321,7 @@ end; -Procedure TStringList.SetUpdateState(Updating: Boolean); +procedure TStringList.SetUpdateState(Updating: Boolean); begin If Updating then @@ -1336,10 +1341,10 @@ end; -Function TStringList.Add(const S: string): Integer; +function TStringList.Add(const S: string): Integer; begin - If Not Sorted then + If Not (SortStyle=sslAuto) then Result:=FCount else If Find (S,Result) then @@ -1350,7 +1355,7 @@ begin InsertItem (Result,S); end; -Procedure TStringList.Clear; +procedure TStringList.Clear; begin if FCount = 0 then Exit; @@ -1359,7 +1364,7 @@ begin Changed; end; -Procedure TStringList.Delete(Index: Integer); +procedure TStringList.Delete(Index: Integer); begin If (Index<0) or (Index>=FCount) then @@ -1378,7 +1383,7 @@ end; -Procedure TStringList.Exchange(Index1, Index2: Integer); +procedure TStringList.Exchange(Index1, Index2: Integer); begin If (Index1<0) or (Index1>=FCount) then @@ -1396,22 +1401,33 @@ begin if b=FCaseSensitive then Exit; FCaseSensitive:=b; - if FSorted then + if FSortStyle=sslAuto then begin FForceSort:=True; - sort; - FForceSort:=False; + try + Sort; + finally + FForceSort:=False; + end; end; end; +procedure TStringList.SetSortStyle(AValue: TStringsSortStyle); +begin + if FSortStyle=AValue then Exit; + if (AValue=sslAuto) then + Sort; + FSortStyle:=AValue; +end; -Function TStringList.DoCompareText(const s1,s2 : string) : PtrInt; - begin - if FCaseSensitive then - result:=AnsiCompareStr(s1,s2) - else - result:=AnsiCompareText(s1,s2); - end; + +function TStringList.DoCompareText(const s1, s2: string): PtrInt; +begin + if FCaseSensitive then + result:=AnsiCompareStr(s1,s2) + else + result:=AnsiCompareText(s1,s2); +end; function TStringList.CompareStrings(const s1,s2 : string) : Integer; @@ -1420,15 +1436,16 @@ begin end; -Function TStringList.Find(const S: string; Out Index: Integer): Boolean; +function TStringList.Find(const S: string; out Index: Integer): Boolean; var L, R, I: Integer; CompareRes: PtrInt; begin Result := false; - if Not Sorted then - exit; + Index:=-1; + if Not Sorted then + Raise EListError.Create(SErrFindNeedsSortedList); // Use binary search. L := 0; R := Count - 1; @@ -1452,7 +1469,7 @@ end; -Function TStringList.IndexOf(const S: string): Integer; +function TStringList.IndexOf(const S: string): Integer; begin If Not Sorted then @@ -1465,10 +1482,10 @@ end; -Procedure TStringList.Insert(Index: Integer; const S: string); +procedure TStringList.Insert(Index: Integer; const S: string); begin - If Sorted then + If SortStyle=sslAuto then Error (SSortedListError,0) else If (Index<0) or (Index>FCount) then @@ -1478,10 +1495,10 @@ begin end; -Procedure TStringList.CustomSort(CompareFn: TStringListSortCompare); +procedure TStringList.CustomSort(CompareFn: TStringListSortCompare); begin - If (FForceSort or (Not Sorted)) and (FCount>1) then + If (FForceSort or (Not (FSortStyle=sslAuto))) and (FCount>1) then begin Changing; QuickSort(0,FCount-1, CompareFn); @@ -1496,7 +1513,7 @@ begin List.FList^[Index].FString); end; -Procedure TStringList.Sort; +procedure TStringList.Sort; begin CustomSort(@StringListAnsiCompare); diff --git a/rtl/objpas/sysutils/sysstr.inc b/rtl/objpas/sysutils/sysstr.inc index 66606910d8..513702936f 100644 --- a/rtl/objpas/sysutils/sysstr.inc +++ b/rtl/objpas/sysutils/sysstr.inc @@ -2204,6 +2204,17 @@ Var End; If (J<>0) then Digits[1]:='-'; + If (Digits[1]='-') then + Begin + I:=1; + While (I<=length(Digits)) And (Not (Digits[I] in ['1'..'9'])) Do + Inc(I); + If (I>length(Digits)) then + Begin + Digits:=Copy(Digits, 2, Length(Digits)); + Dec(DecimalPoint); + End; + End; Exp := 0; End Else @@ -2843,7 +2854,7 @@ begin Inc(P,Blen) else begin - If (P>MaxCol) then + If (P>=MaxCol) then IBC:=C in BreakChars; Inc(P); end; @@ -2851,10 +2862,10 @@ begin // Writeln('"',C,'" : IBC : ',IBC,' HB : ',HB,' LQ : ',LQ,' P>MaxCol : ',P>MaxCol); end; Result:=Result+Copy(L,1,P-1); - If Not HB then - Result:=Result+BreakStr; Delete(L,1,P-1); Len:=Length(L); + If (Len>0) and Not HB then + Result:=Result+BreakStr; end; end; diff --git a/tests/test/units/fpcunit/tcstrutils.pp b/tests/test/units/fpcunit/tcstrutils.pp index 44c4ef7aac..85eb5c8fc8 100644 --- a/tests/test/units/fpcunit/tcstrutils.pp +++ b/tests/test/units/fpcunit/tcstrutils.pp @@ -1,6 +1,7 @@ unit tcstrutils; {$mode objfpc}{$H+} +{$codepage utf8} interface @@ -9,8 +10,6 @@ uses type - { TTestSearchBuf } - TTestSearchBuf= class(TTestCase) Private Procedure TestSearch(Sub:String; Start : Integer; O : TStringSearchOptions; Expected : Integer); @@ -41,6 +40,14 @@ type Procedure TestDecodeSoundexInt; end; + + TTestGeneral = class(TTestCase) + published + procedure TestIndexStr; + procedure TestMatchStr; + end; + + implementation Const @@ -258,8 +265,56 @@ begin TestSearch('in',0,[soWholeWord,soDown],39); end; +procedure TTestGeneral.TestIndexStr; +var + s: UnicodeString; + a: array of UnicodeString; +begin + s := 'Henry'; + AssertTrue('Failed on 1', IndexStr(s, ['Brian', 'Jim', 'Henry']) = 2); + AssertTrue('Failed on 2', IndexStr(s, ['Brian', 'Jim', 'henry']) = -1); + AssertTrue('Failed on 3', IndexStr(s, ['BRIAN', 'JIM', 'HENRY']) = -1); + s := 'HENRY'; + AssertTrue('Failed on 4', IndexStr(s, ['BRIAN', 'HENRY', 'JIM']) = 1); + + SetLength(a, 3); + a[0] := 'Brian'; + a[1] := 'Jim'; + a[2] := 'Henry'; + AssertTrue('Failed on 5', IndexStr(s, a) = -1); + s := 'Henry'; + AssertTrue('Failed on 6', IndexStr(s, a) = 2); + a[2] := 'henry'; + AssertTrue('Failed on 7', IndexStr(s, a) = -1); +end; + +procedure TTestGeneral.TestMatchStr; +var + s: UnicodeString; + a: array of UnicodeString; +begin + s := 'Henry'; + AssertEquals('Failed on 1', True, MatchStr(s, ['Brian', 'Jim', 'Henry'])); + AssertEquals('Failed on 2', False, MatchStr(s, ['Brian', 'Jim', 'henry'])); + AssertEquals('Failed on 3', False, MatchStr(s, ['BRIAN', 'JIM', 'HENRY'])); + s := 'HENRY'; + AssertEquals('Failed on 4', True, MatchStr(s, ['BRIAN', 'HENRY', 'JIM'])); + + SetLength(a, 3); + a[0] := 'Brian'; + a[1] := 'Jim'; + a[2] := 'Henry'; + AssertEquals('Failed on 5', False, MatchStr(s, a)); + s := 'Henry'; + AssertEquals('Failed on 6', True, MatchStr(s, a)); + a[2] := 'henry'; + AssertEquals('Failed on 7', False, MatchStr(s, a)); +end; + + initialization RegisterTest(TTestSearchBuf); + RegisterTest(TTestGeneral); writeln ('Testing with ', WhichSearchbuf, ' implementation'); writeln; end. diff --git a/tests/test/units/fpcunit/tstrutils.lpi b/tests/test/units/fpcunit/tstrutils.lpi index 25e0229360..2e4bdd9052 100644 --- a/tests/test/units/fpcunit/tstrutils.lpi +++ b/tests/test/units/fpcunit/tstrutils.lpi @@ -1,19 +1,24 @@ - + - - + + + + + - - - + + <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"> diff --git a/tests/test/units/fpcunit/tstrutils.lpr b/tests/test/units/fpcunit/tstrutils.lpr index a11f4df654..04ee695a4e 100644 --- a/tests/test/units/fpcunit/tstrutils.lpr +++ b/tests/test/units/fpcunit/tstrutils.lpr @@ -3,6 +3,7 @@ program tstrutils; {$mode objfpc}{$H+} uses + cwstring, Classes, consoletestrunner, tcstrutils, tcstringlist, tclist; type