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

* patch by Rika: Small improvements to (a|u)strings.inc, resolves #40364

Browse Source
This commit is contained in:
florian 2024-02-11 16:29:23 +01:00
parent 62495c964a
commit e7600ee245
2 changed files with 29 additions and 49 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

34
rtl/inc/astrings.inc
View File

@ -792,24 +792,19 @@ begin
lens:=MemSize(Temp);
lena:=AnsiFirstOff+L+sizeof(AnsiChar);
{ allow shrinking string if that saves at least half of current size }
if (lena>lens) or ((lens>32) and (lena<=(lens div 2))) then
begin
reallocmem(Temp,lena);
Pointer(S):=Temp+AnsiFirstOff;
end;
if (lena>lens) or ((lens>32) and (lena<=SizeInt(SizeUint(lens) div 2))) then
Pointer(S):=reallocmem(Temp,lena)+AnsiFirstOff;
end
else
begin
{ Reallocation is needed... }
Temp:=NewAnsiString(L);
PAnsiRec(Pointer(Temp)-AnsiFirstOff)^.CodePage:=PAnsiRec(Pointer(S)-AnsiFirstOff)^.CodePage;
lens:=length(s);
if l<=lens then
lens:=l
else
{ Also copy a trailing implicit #0 of the original string
to the new larger string }
Inc(lens);
{ Also copy a trailing implicit #0 of the original string
to the new larger string }
lens:=PAnsiRec(Pointer(S)-AnsiFirstOff)^.Len+1;
if l<lens then
lens:=l;
Move(Pointer(S)^,Temp^,lens);
fpc_ansistr_decr_ref(Pointer(s));
Pointer(S):=Temp;
@ -894,9 +889,7 @@ Function fpc_ansistr_Unique(Var S : Pointer): Pointer; [Public,Alias : 'FPC_ANSI
}
begin
pointer(result) := pointer(s);
If Pointer(S)=Nil then
exit;
if PAnsiRec(Pointer(S)-AnsiFirstOff)^.Ref<>1 then
if (result<>Nil) and (PAnsiRec(result-AnsiFirstOff)^.Ref<>1) then
result:=fpc_truely_ansistr_unique(s);
end;
{$endif FPC_SYSTEM_HAS_ANSISTR_UNIQUE}
@ -905,17 +898,16 @@ end;
{$define FPC_HAS_ANSISTR_COPY}
Function Fpc_Ansistr_Copy(Const S : RawByteString; Index,Size : SizeInt): RawByteString;compilerproc;
var
Lim : SizeInt;
ResultAddress : Pointer;
begin
ResultAddress:=Nil;
dec(index);
if Index < 0 then
Index := 0;
{ Check Size. Accounts for Zero-length S, the double check is needed because
Size can be maxint and will get <0 when adding index }
if (Size>Length(S)) or
(Index+Size>Length(S)) then
Size:=Length(S)-Index;
Lim:=Length(S)-Index; { Cannot overflow as both Length(S) and Index are non-negative. }
if Size>Lim then
Size:=Lim;
If Size>0 then
begin
ResultAddress:=NewAnsiString(Size);
@ -927,7 +919,7 @@ begin
PAnsiRec(ResultAddress-AnsiFirstOff)^.CodePage:=PAnsiRec(Pointer(S)-AnsiFirstOff)^.CodePage;
end;
end;
fpc_ansistr_decr_ref(Pointer(fpc_ansistr_copy));
fpc_ansistr_decr_ref(Pointer(fpc_ansistr_copy));
Pointer(fpc_ansistr_Copy):=ResultAddress;
end;
{$endif FPC_HAS_ANSISTR_COPY}

44
rtl/inc/ustrings.inc
View File

@ -966,16 +966,14 @@ Procedure fpc_UnicodeStr_SetLength(Var S : UnicodeString; l : SizeInt);[Public,A
}
Var
Temp : Pointer;
movelen: SizeInt;
nl,lens, lena : SizeUInt;
lens, lena : SizeUInt;
begin
nl:=l;
if (l>0) then
begin
if Pointer(S)=nil then
begin
{ Need a complete new string...}
Pointer(s):=NewUnicodeString(nl);
Pointer(s):=NewUnicodeString(l);
end
else
if (PUnicodeRec(Pointer(S)-UnicodeFirstOff)^.Ref = 1) then
@ -983,31 +981,24 @@ begin
Temp:=Pointer(s)-UnicodeFirstOff;
lens:=MemSize(Temp);
lena:=SizeUInt(L*sizeof(UnicodeChar)+(UnicodeFirstOff+sizeof(UnicodeChar)));
if (lena>lens) or ((lens>32) and (lena<=(lens div 2))) then
begin
reallocmem(Temp, lena);
Pointer(S):=Temp+UnicodeFirstOff;
end;
if (lena>lens) or ((lens>32) and (lena<=SizeInt(SizeUint(lens) div 2))) then
Pointer(S):=reallocmem(Temp, lena)+UnicodeFirstOff;
end
else
begin
{ Reallocation is needed... }
Temp:=NewUnicodeString(nL);
if Length(S)>0 then
begin
if l < succ(length(s)) then
movelen := l
{ also move terminating null }
else
movelen := succ(length(s));
Move(Pointer(S)^,Temp^,movelen * Sizeof(UnicodeChar));
end;
Temp:=NewUnicodeString(l);
{ also move terminating null }
lens:=PUnicodeRec(Pointer(S)-UnicodeFirstOff)^.Len+1;
if l<lens then
lens:=l;
Move(Pointer(S)^,Temp^,lens * Sizeof(UnicodeChar));
fpc_unicodestr_decr_ref(Pointer(S));
Pointer(S):=Temp;
end;
{ Force nil termination in case it gets shorter }
PWord(Pointer(S)+l*sizeof(UnicodeChar))^:=0;
PUnicodeRec(Pointer(S)-UnicodeFirstOff)^.Len:=nl;
PUnicodeRec(Pointer(S)-UnicodeFirstOff)^.Len:=l;
end
else { length=0, deallocate the string }
fpc_unicodestr_decr_ref (Pointer(S));
@ -1140,9 +1131,7 @@ Var
L : SizeInt;
begin
pointer(result) := pointer(s);
If Pointer(S)=Nil then
exit;
if PUnicodeRec(Pointer(S)-UnicodeFirstOff)^.Ref<>1 then
If (result<>nil) and (PUnicodeRec(result-UnicodeFirstOff)^.Ref<>1) then
begin
L:=PUnicodeRec(Pointer(S)-UnicodeFirstOff)^.len;
SNew:=NewUnicodeString (L);
@ -1160,17 +1149,16 @@ end;
{$define FPC_HAS_UNICODESTR_COPY}
Function Fpc_UnicodeStr_Copy (Const S : UnicodeString; Index,Size : SizeInt) : UnicodeString;compilerproc;
var
Lim : SizeInt;
ResultAddress : Pointer;
begin
ResultAddress:=Nil;
dec(index);
if Index < 0 then
Index := 0;
{ Check Size. Accounts for Zero-length S, the double check is needed because
Size can be maxint and will get <0 when adding index }
if (Size>Length(S)) or
(Index+Size>Length(S)) then
Size:=Length(S)-Index;
Lim:=Length(S)-Index; { Cannot overflow as both Length(S) and Index are non-negative. }
if Size>Lim then
Size:=Lim;
If Size>0 then
begin
ResultAddress:=NewUnicodeString(Size);