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

merge r17603 from cpstrnew branch by inoussa:

Browse Source 
Updated to take care of the code page : fpc_char_to_ansistr, fpc_pchar_to_ansistr, fpc_AnsiStr_To_ShortStr

git-svn-id: trunk@19122 -
This commit is contained in:
paul 2011-09-17 14:07:20 +00:00
parent aaf5392315
commit 05d66e31ce
3 changed files with 43 additions and 13 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

19
compiler/ncnv.pas
View File

@ -1086,17 +1086,15 @@ implementation
begin
{ parameter }
para:=ccallparanode.create(left,nil);
{ encoding required? }
if tstringdef(resultdef).stringtype=st_ansistring then
para:=ccallparanode.create(cordconstnode.create(tstringdef(resultdef).encoding,u16inttype,true),para);
{ create the procname }
if torddef(left.resultdef).ordtype<>uwidechar then
procname:='fpc_char_to_'
else
begin
{ encoding required? }
if tstringdef(resultdef).stringtype=st_ansistring then
para:=ccallparanode.create(cordconstnode.create(tstringdef(resultdef).encoding,u16inttype,true),para);
procname:='fpc_uchar_to_';
end;
procname:='fpc_uchar_to_';
procname:=procname+tstringdef(resultdef).stringtypname;
{ and finally the call }
@ -1453,6 +1451,15 @@ implementation
addstatement(newstat,ctemprefnode.create(restemp));
result:=newblock;
end
else if tstringdef(resultdef).stringtype=st_ansistring then
result := ccallnode.createinternres(
'fpc_pchar_to_'+tstringdef(resultdef).stringtypname,
ccallparanode.create(
cordconstnode.create(tstringdef(resultdef).encoding,u16inttype,true),
ccallparanode.create(left,nil)
),
resultdef
)
else
result := ccallnode.createinternres(
'fpc_pchar_to_'+tstringdef(resultdef).stringtypname,

31
rtl/inc/astrings.inc
View File

@ -467,7 +467,7 @@ end;
{$else FPC_STRTOSHORTSTRINGPROC}
procedure fpc_AnsiStr_To_ShortStr (out res: shortstring; const S2 : Ansistring);[Public, alias: 'FPC_ANSISTR_TO_SHORTSTR']; compilerproc;
procedure fpc_AnsiStr_To_ShortStr (out res: shortstring; const S2 : RawByteString);[Public, alias: 'FPC_ANSISTR_TO_SHORTSTR']; compilerproc;
{
Converts a AnsiString to a ShortString;
}
@ -514,21 +514,35 @@ begin
end
end;
Function fpc_Char_To_AnsiStr(const c : Char): AnsiString; compilerproc;
Function fpc_Char_To_AnsiStr(const c : Char{$ifdef FPC_HAS_CPSTRING};cp : TSystemCodePage{$endif FPC_HAS_CPSTRING}): RawByteString; compilerproc;
{
Converts a Char to a AnsiString;
}
{$ifndef FPC_HAS_CPSTRING}
var
cp : TSystemCodePage;
{$endif FPC_HAS_CPSTRING}
begin
{$ifdef FPC_HAS_CPSTRING}
if (cp=0) then
cp:=DefaultSystemCodePage;
{$else FPC_HAS_CPSTRING}
cp:=DefaultSystemCodePage;
{$endif FPC_HAS_CPSTRING}
Setlength (fpc_Char_To_AnsiStr,1);
PByte(Pointer(fpc_Char_To_AnsiStr))^:=byte(c);
{ Terminating Zero }
PByte(Pointer(fpc_Char_To_AnsiStr)+1)^:=0;
SetCodePage(fpc_Char_To_AnsiStr,cp,False);
end;
Function fpc_PChar_To_AnsiStr(const p : pchar): ansistring; compilerproc;
Function fpc_PChar_To_AnsiStr(const p : pchar{$ifdef FPC_HAS_CPSTRING};cp : TSystemCodePage{$endif FPC_HAS_CPSTRING}): RawByteString; compilerproc;
Var
L : SizeInt;
{$ifndef FPC_HAS_CPSTRING}
cp : TSystemCodePage;
{$endif FPC_HAS_CPSTRING}
begin
if (not assigned(p)) or (p[0]=#0) Then
L := 0
@ -536,7 +550,16 @@ begin
l:=IndexChar(p^,-1,#0);
SetLength(fpc_PChar_To_AnsiStr,L);
if L > 0 then
Move (P[0],Pointer(fpc_PChar_To_AnsiStr)^,L)
begin
{$ifdef FPC_HAS_CPSTRING}
if (cp=0) then
cp:=DefaultSystemCodePage;
{$else FPC_HAS_CPSTRING}
cp:=DefaultSystemCodePage;
{$endif FPC_HAS_CPSTRING}
Move (P[0],Pointer(fpc_PChar_To_AnsiStr)^,L);
SetCodePage(fpc_PChar_To_AnsiStr,cp,False);
end;
end;

6
rtl/inc/compproc.inc
View File

@ -264,15 +264,15 @@ Procedure fpc_AnsiStr_ShortStr_Concat (Var S1: AnsiString; Var S2 : ShortString)
{$ifndef FPC_STRTOSHORTSTRINGPROC}
function fpc_AnsiStr_To_ShortStr (high_of_res: SizeInt;const S2 : Ansistring): shortstring; compilerproc;
{$else FPC_STRTOSHORTSTRINGPROC}
procedure fpc_AnsiStr_To_ShortStr (out res : shortstring;const S2 : Ansistring); compilerproc;
procedure fpc_AnsiStr_To_ShortStr (out res : shortstring;const S2 : RawByteString); compilerproc;
{$endif FPC_STRTOSHORTSTRINGPROC}
{$ifdef FPC_HAS_CPSTRING}
Function fpc_AnsiStr_To_AnsiStr (const S : RawByteString;cp : TSystemCodePage): RawByteString; compilerproc;
{$endif FPC_HAS_CPSTRING}
Function fpc_ShortStr_To_AnsiStr (Const S2 : ShortString{$ifdef FPC_HAS_CPSTRING};cp : TSystemCodePage{$endif FPC_HAS_CPSTRING}): RawByteString; compilerproc;
Function fpc_Char_To_AnsiStr(const c : Char): AnsiString; compilerproc;
Function fpc_Char_To_AnsiStr(const c : Char{$ifdef FPC_HAS_CPSTRING};cp : TSystemCodePage{$endif FPC_HAS_CPSTRING}): RawByteString; compilerproc;
Function fpc_PChar_To_AnsiStr(const p : pchar): ansistring; compilerproc;
Function fpc_PChar_To_AnsiStr(const p : pchar{$ifdef FPC_HAS_CPSTRING};cp : TSystemCodePage{$endif FPC_HAS_CPSTRING}): RawByteString; compilerproc;
Function fpc_CharArray_To_AnsiStr(const arr: array of char; zerobased: boolean = true): ansistring; compilerproc;
{$ifndef FPC_STRTOCHARARRAYPROC}
function fpc_ansistr_to_chararray(arraysize: SizeInt; const src: ansistring): fpc_big_chararray; compilerproc;