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

rtl: eat $ffff encoding in more routines, fix Insert() procedure to preserve destination string codepage

Browse Source 
git-svn-id: trunk@19289 -
This commit is contained in:
paul 2011-09-30 06:10:24 +00:00
parent 36851c86de
commit bcb0317209
3 changed files with 34 additions and 13 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

1
.gitattributes vendored
View File

@ -9958,6 +9958,7 @@ tests/test/tcpstr11.pp svneol=native#text/pascal
tests/test/tcpstr12.pp svneol=native#text/pascal
tests/test/tcpstr13.pp svneol=native#text/pascal
tests/test/tcpstr14.pp svneol=native#text/pascal
tests/test/tcpstr15.pp svneol=native#text/pascal
tests/test/tcpstr2.pp svneol=native#text/plain
tests/test/tcpstr2a.pp svneol=native#text/plain
tests/test/tcpstr3.pp svneol=native#text/plain

30
rtl/inc/astrings.inc
View File

@ -407,7 +407,7 @@ begin
Size:=Length(S);
if Size>0 then
begin
if (cp=0) then
if (cp=0) or (cp=$ffff) then
cp:=DefaultSystemCodePage;
if (StringCodePage(S)=cp) then
begin
@ -487,13 +487,13 @@ Var
{$endif FPC_HAS_CPSTRING}
begin
{$ifdef FPC_HAS_CPSTRING}
if (cp=0) then
if (cp=0) or (cp=$ffff) then
cp:=DefaultSystemCodePage;
{$else FPC_HAS_CPSTRING}
cp:=DefaultSystemCodePage;
{$endif FPC_HAS_CPSTRING}
Size:=Length(S2);
Setlength (fpc_ShortStr_To_AnsiStr,Size);
Setlength(fpc_ShortStr_To_AnsiStr,Size);
if Size>0 then
begin
Move(S2[1],Pointer(fpc_ShortStr_To_AnsiStr)^,Size);
@ -511,7 +511,7 @@ var
{$endif FPC_HAS_CPSTRING}
begin
{$ifdef FPC_HAS_CPSTRING}
if (cp=0) then
if (cp=0) or (cp=$ffff) then
cp:=DefaultSystemCodePage;
{$else FPC_HAS_CPSTRING}
cp:=DefaultSystemCodePage;
@ -539,7 +539,7 @@ begin
if L > 0 then
begin
{$ifdef FPC_HAS_CPSTRING}
if (cp=0) then
if (cp=0) or (cp=$ffff) then
cp:=DefaultSystemCodePage;
{$else FPC_HAS_CPSTRING}
cp:=DefaultSystemCodePage;
@ -574,7 +574,7 @@ begin
if i > 0 then
begin
{$ifdef FPC_HAS_CPSTRING}
if (cp=0) then
if (cp=0) or (cp=$ffff) then
cp:=DefaultSystemCodePage;
{$else FPC_HAS_CPSTRING}
cp:=DefaultSystemCodePage;
@ -772,7 +772,7 @@ begin
GetMem(Pointer(S),AnsiRecLen+L);
PAnsiRec(S)^.Ref:=1;
{$ifdef FPC_HAS_CPSTRING}
if (cp=0) then
if (cp=0) or (cp=$ffff) then
cp:=DefaultSystemCodePage;
PAnsiRec(S)^.CodePage:=cp;
{$else}
@ -1244,14 +1244,14 @@ end;
{$endif CPU64}
Procedure Delete (Var S : RawByteString; Index,Size: SizeInt);
Procedure Delete(Var S : RawByteString; Index,Size: SizeInt);
Var
LS : SizeInt;
begin
ls:=Length(S);
If (Index>LS) or (Index<=0) or (Size<=0) then
exit;
UniqueString (S);
UniqueString(S);
If (Size>LS-Index) then // Size+Index gives overflow ??
Size:=LS-Index+1;
If (Size<=LS-Index) then
@ -1263,10 +1263,11 @@ begin
end;
Procedure Insert (Const Source : RawByteString; Var S : RawByteString; Index : SizeInt);
Procedure Insert(Const Source : RawByteString; Var S : RawByteString; Index : SizeInt);
var
Temp : RawByteString;
LS : SizeInt;
cp : TSystemCodePage;
begin
If Length(Source)=0 then
exit;
@ -1276,11 +1277,14 @@ begin
if index > LS then
index := LS+1;
Dec(Index);
Pointer(Temp) := NewAnsiString(Length(Source)+LS);
SetLength(Temp,Length(Source)+LS);
cp:=StringCodePage(S);
if (cp=0) or (cp=$ffff) then
cp:=DefaultSystemCodePage;
SetCodePage(Temp,cp,false);
If Index>0 then
move (Pointer(S)^,Pointer(Temp)^,Index);
Move (Pointer(Source)^,PByte(Temp)[Index],Length(Source));
Move(Pointer(S)^,Pointer(Temp)^,Index);
Move(Pointer(Source)^,PByte(Temp)[Index],Length(Source));
If (LS-Index)>0 then
Move(PByte(Pointer(S))[Index],PByte(temp)[Length(Source)+index],LS-Index);
S:=Temp;

16
tests/test/tcpstr15.pp Normal file
View File

@ -0,0 +1,16 @@
program tcpstr15;
{$apptype console}
{$codepage cp1251}
{$mode delphi}
type
t866 = type AnsiString(866);
var
s866: t866;
ss: ShortString;
begin
s866 := 'ïðèâåò ';
ss := 'çåìëÿíå';
Insert(ss, s866, 8);
if StringCodePage(s866) <> 866 then
halt(1);
end.