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

* Add offset to Pos functions, Delphi XE 8 compatible.

Browse Source 
git-svn-id: trunk@31464 -
This commit is contained in:
michael 2015-08-31 13:05:37 +00:00
parent 130eba51ee
commit 8161c1135c
4 changed files with 56 additions and 45 deletions

25
rtl/inc/astrings.inc
View File

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

21
rtl/inc/sstrings.inc
View File

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

12
rtl/inc/systemh.inc
View File

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

43
rtl/inc/wstrings.inc
View File

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