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

merge r14133 from cpstrnew branch by paul except ptconst.pas which has a difficult merge conflict (code moved to another unit which is not at the branch during the revision):

Browse Source 
make AnsiStr concatenation and copy work

git-svn-id: trunk@19094 -
This commit is contained in:
paul 2011-09-17 11:44:47 +00:00
parent 2162add8ac
commit b3db8db481
4 changed files with 29 additions and 5 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
compiler/symdef.pas
View File

@ -1447,6 +1447,7 @@ implementation
begin begin
inherited create(stringdef); inherited create(stringdef);
stringtype:=st_ansistring; stringtype:=st_ansistring;
encoding:=65535;
len:=-1; len:=-1;
savesize:=sizeof(pint); savesize:=sizeof(pint);
end; end;
@ -1466,6 +1467,7 @@ implementation
begin begin
inherited create(stringdef); inherited create(stringdef);
stringtype:=st_widestring; stringtype:=st_widestring;
encoding:=CP_UTF16;
len:=-1; len:=-1;
savesize:=sizeof(pint); savesize:=sizeof(pint);
end; end;

27
rtl/inc/astrings.inc
View File

@ -208,11 +208,30 @@ end;
{$else STR_CONCAT_PROCS} {$else STR_CONCAT_PROCS}
procedure fpc_AnsiStr_Concat (var DestS:ansistring;const S1,S2 : AnsiString); compilerproc; procedure fpc_AnsiStr_Concat (var DestS:RawByteString;const S1,S2 : RawByteString); compilerproc;
Var Var
Size,Location : SizeInt; Size,Location : SizeInt;
same : boolean; same : boolean;
S1CP, S2CP, DestCP: TSystemCodePage;
U: UnicodeString;
begin begin
{ if codepages are differ then concat using unicodestring }
S1CP:=StringCodePage(S1);
if S1CP=$ffff then
S1CP:=DefaultSystemCodePage;
S2CP:=StringCodePage(S2);
if S2CP=$ffff then
S2CP:=DefaultSystemCodePage;
DestCP:=StringCodePage(DestS);
if DestCP=$ffff then
DestCP:=DefaultSystemCodePage;
if (S1CP<>DestCP) or (S2CP<>DestCP) then
begin
U:=UnicodeString(S1)+UnicodeString(S2);
DestS:='';
widestringmanager.Unicode2AnsiMoveProc(PUnicodeChar(Pointer(U)),DestS,DestCP,Length(U));
exit;
end;
{ only assign if s1 or s2 is empty } { only assign if s1 or s2 is empty }
if (S1='') then if (S1='') then
begin begin
@ -681,6 +700,7 @@ begin
SNew:=NewAnsiString (L); SNew:=NewAnsiString (L);
Move (Pointer(S)^,SNew^,L+1); Move (Pointer(S)^,SNew^,L+1);
PAnsiRec(SNew-AnsiFirstOff)^.len:=L; PAnsiRec(SNew-AnsiFirstOff)^.len:=L;
PAnsiRec(SNew-AnsiFirstOff)^.CodePage:=PAnsiRec(Pointer(S)-AnsiFirstOff)^.CodePage;
fpc_ansistr_decr_ref (Pointer(S)); { Thread safe } fpc_ansistr_decr_ref (Pointer(S)); { Thread safe }
pointer(S):=SNew; pointer(S):=SNew;
pointer(result):=SNew; pointer(result):=SNew;
@ -746,7 +766,7 @@ begin
move(S[1],(pointer(S)+ofs)^,strlength+1) move(S[1],(pointer(S)+ofs)^,strlength+1)
end; end;
Function Fpc_Ansistr_Copy (Const S : AnsiString; Index,Size : SizeInt) : AnsiString;compilerproc; Function Fpc_Ansistr_Copy (Const S : RawByteString; Index,Size : SizeInt) : AnsiString;compilerproc;
var var
ResultAddress : Pointer; ResultAddress : Pointer;
begin begin
@ -767,8 +787,9 @@ begin
if ResultAddress<>Nil then if ResultAddress<>Nil then
begin begin
Move (Pointer(Pointer(S)+index)^,ResultAddress^,Size); Move (Pointer(Pointer(S)+index)^,ResultAddress^,Size);
PAnsiRec(ResultAddress-AnsiFirstOff)^.Len:=Size;
PByte(ResultAddress+Size)^:=0; PByte(ResultAddress+Size)^:=0;
PAnsiRec(ResultAddress-AnsiFirstOff)^.Len:=Size;
PAnsiRec(ResultAddress-AnsiFirstOff)^.CodePage:=PAnsiRec(Pointer(S)-AnsiFirstOff)^.CodePage;
end; end;
end; end;
fpc_ansistr_decr_ref(Pointer(fpc_ansistr_copy)); fpc_ansistr_decr_ref(Pointer(fpc_ansistr_copy));

4
rtl/inc/compproc.inc
View File

@ -249,7 +249,7 @@ Procedure fpc_ansistr_decr_ref (Var S : Pointer); compilerproc;
Procedure fpc_ansistr_incr_ref (S : Pointer); compilerproc; Procedure fpc_ansistr_incr_ref (S : Pointer); compilerproc;
Procedure fpc_AnsiStr_Assign (Var DestS : Pointer;S2 : Pointer); compilerproc; Procedure fpc_AnsiStr_Assign (Var DestS : Pointer;S2 : Pointer); compilerproc;
{$ifdef STR_CONCAT_PROCS} {$ifdef STR_CONCAT_PROCS}
Procedure fpc_AnsiStr_Concat (Var DestS : Ansistring;const S1,S2 : AnsiString); compilerproc; Procedure fpc_AnsiStr_Concat (Var DestS : RawByteString;const S1,S2 : RawByteString); compilerproc;
Procedure fpc_AnsiStr_Concat_multi (Var DestS : Ansistring;const sarr:array of Ansistring); compilerproc; Procedure fpc_AnsiStr_Concat_multi (Var DestS : Ansistring;const sarr:array of Ansistring); compilerproc;
{$else STR_CONCAT_PROCS} {$else STR_CONCAT_PROCS}
function fpc_AnsiStr_Concat (const S1,S2 : AnsiString): AnsiString; compilerproc; function fpc_AnsiStr_Concat (const S1,S2 : AnsiString): AnsiString; compilerproc;
@ -288,7 +288,7 @@ Procedure fpc_AnsiStr_CheckRange(p : Pointer; index : SizeInt); compilerproc;
{$endif VER2_4} {$endif VER2_4}
Procedure fpc_AnsiStr_SetLength (Var S : RawByteString; l : SizeInt); compilerproc; Procedure fpc_AnsiStr_SetLength (Var S : RawByteString; l : SizeInt); compilerproc;
Function fpc_ansistr_Copy (Const S : AnsiString; Index,Size : SizeInt) : AnsiString;compilerproc; Function fpc_ansistr_Copy (Const S : RawByteString; Index,Size : SizeInt) : AnsiString;compilerproc;
{$ifdef EXTRAANSISHORT} {$ifdef EXTRAANSISHORT}
Function fpc_AnsiStr_ShortStr_Compare (Var S1 : Pointer; Var S2 : ShortString): SizeInt; compilerproc; Function fpc_AnsiStr_ShortStr_Compare (Var S1 : Pointer; Var S2 : ShortString): SizeInt; compilerproc;
{$endif EXTRAANSISHORT} {$endif EXTRAANSISHORT}

1
tests/test/tcpstr6.pp
View File

@ -1,3 +1,4 @@
{$CODEPAGE cp1251}
// file encoding is cp1251 // file encoding is cp1251
type type
Cp866String = string<866>; Cp866String = string<866>;