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

compiler, rtl: pass codepage argument to all ansistring str() helpers to return result with correct codepage

Browse Source 
git-svn-id: trunk@19287 -
This commit is contained in:
paul 2011-09-30 03:26:34 +00:00
parent 647218fd13
commit 485695d4e6
5 changed files with 59 additions and 16 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

1
.gitattributes vendored
View File

@ -9957,6 +9957,7 @@ tests/test/tcpstr10.pp svneol=native#text/pascal
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/tcpstr2.pp svneol=native#text/plain
tests/test/tcpstr2a.pp svneol=native#text/plain
tests/test/tcpstr3.pp svneol=native#text/plain

5
compiler/ninl.pas
View File

@ -322,6 +322,11 @@ implementation
procname := procname + 'sint';
end;
{ for ansistrings insert the encoding argument }
if is_ansistring(dest.resultdef) then
newparas:=ccallparanode.create(cordconstnode.create(
tstringdef(dest.resultdef).encoding,u16inttype,true),newparas);
{ free the errornode we generated in the beginning }
result.free;
{ create the call node, }

40
rtl/inc/astrings.inc
View File

@ -1136,31 +1136,40 @@ end;
{$ifndef FPUNONE}
procedure fpc_AnsiStr_Float(d : ValReal;len,fr,rt : SizeInt;out s : ansistring);[public,alias:'FPC_ANSISTR_FLOAT']; compilerproc; {$IFNDEF VER2_0} Inline; {$ENDIF}
procedure fpc_AnsiStr_Float(d : ValReal;len,fr,rt : SizeInt;out s : RawByteString{$ifdef FPC_HAS_CPSTRING};cp : TSystemCodePage{$endif FPC_HAS_CPSTRING});[public,alias:'FPC_ANSISTR_FLOAT']; compilerproc; {$IFNDEF VER2_0} Inline; {$ENDIF}
var
ss: ShortString;
begin
str_real(len,fr,d,treal_type(rt),ss);
s:=ss;
{$ifdef FPC_HAS_CPSTRING}
SetCodePage(s,cp,false);
{$endif FPC_HAS_CPSTRING}
end;
{$endif}
procedure fpc_ansistr_enum(ordinal,len:sizeint;typinfo,ord2strindex:pointer;out s:ansistring);[public,alias:'FPC_ANSISTR_ENUM'];compilerproc; {$IFNDEF VER2_0} Inline; {$ENDIF}
procedure fpc_ansistr_enum(ordinal,len:sizeint;typinfo,ord2strindex:pointer;out s:RawByteString{$ifdef FPC_HAS_CPSTRING};cp : TSystemCodePage{$endif FPC_HAS_CPSTRING});[public,alias:'FPC_ANSISTR_ENUM'];compilerproc; {$IFNDEF VER2_0} Inline; {$ENDIF}
var ss:shortstring;
begin
fpc_shortstr_enum(ordinal,len,typinfo,ord2strindex,ss);
s:=ss;
{$ifdef FPC_HAS_CPSTRING}
SetCodePage(s,cp,false);
{$endif FPC_HAS_CPSTRING}
end;
procedure fpc_ansistr_bool(b : boolean;len:sizeint;out s:ansistring);[public,alias:'FPC_ANSISTR_BOOL'];compilerproc; {$IFNDEF VER2_0} Inline; {$ENDIF}
procedure fpc_ansistr_bool(b : boolean;len:sizeint;out s:RawByteString{$ifdef FPC_HAS_CPSTRING};cp : TSystemCodePage{$endif FPC_HAS_CPSTRING});[public,alias:'FPC_ANSISTR_BOOL'];compilerproc; {$IFNDEF VER2_0} Inline; {$ENDIF}
var
ss:shortstring;
begin
fpc_shortstr_bool(b,len,ss);
s:=ss;
{$ifdef FPC_HAS_CPSTRING}
SetCodePage(s,cp,false);
{$endif FPC_HAS_CPSTRING}
end;
@ -1172,50 +1181,65 @@ end;
{$ifdef FPC_HAS_STR_CURRENCY}
procedure fpc_AnsiStr_Currency(c : currency;len,fr : SizeInt;out s : ansistring);[public,alias:'FPC_ANSISTR_CURRENCY']; compilerproc; {$IFNDEF VER2_0} Inline; {$ENDIF}
procedure fpc_AnsiStr_Currency(c : currency;len,fr : SizeInt;out s : RawByteString{$ifdef FPC_HAS_CPSTRING};cp : TSystemCodePage{$endif FPC_HAS_CPSTRING});[public,alias:'FPC_ANSISTR_CURRENCY']; compilerproc; {$IFNDEF VER2_0} Inline; {$ENDIF}
var
ss: ShortString;
begin
str(c:len:fr,ss);
s:=ss;
{$ifdef FPC_HAS_CPSTRING}
SetCodePage(s,cp,false);
{$endif FPC_HAS_CPSTRING}
end;
{$endif FPC_HAS_STR_CURRENCY}
Procedure fpc_AnsiStr_UInt(v : ValUInt;Len : SizeInt; out S : AnsiString);[Public,Alias : 'FPC_ANSISTR_VALUINT']; compilerproc; {$IFNDEF VER2_0} Inline; {$ENDIF}
Procedure fpc_AnsiStr_UInt(v : ValUInt;Len : SizeInt; out S : RawByteString{$ifdef FPC_HAS_CPSTRING};cp : TSystemCodePage{$endif FPC_HAS_CPSTRING});[Public,Alias : 'FPC_ANSISTR_VALUINT']; compilerproc; {$IFNDEF VER2_0} Inline; {$ENDIF}
Var
SS : ShortString;
begin
str(v:Len,SS);
S:=SS;
{$ifdef FPC_HAS_CPSTRING}
SetCodePage(s,cp,false);
{$endif FPC_HAS_CPSTRING}
end;
Procedure fpc_AnsiStr_SInt(v : ValSInt;Len : SizeInt; out S : AnsiString);[Public,Alias : 'FPC_ANSISTR_VALSINT']; compilerproc; {$IFNDEF VER2_0} Inline; {$ENDIF}
Procedure fpc_AnsiStr_SInt(v : ValSInt;Len : SizeInt; out S : RawByteString{$ifdef FPC_HAS_CPSTRING};cp : TSystemCodePage{$endif FPC_HAS_CPSTRING});[Public,Alias : 'FPC_ANSISTR_VALSINT']; compilerproc; {$IFNDEF VER2_0} Inline; {$ENDIF}
Var
SS : ShortString;
begin
str (v:Len,SS);
S:=SS;
{$ifdef FPC_HAS_CPSTRING}
SetCodePage(s,cp,false);
{$endif FPC_HAS_CPSTRING}
end;
{$ifndef CPU64}
Procedure fpc_AnsiStr_QWord(v : QWord;Len : SizeInt; out S : AnsiString);[Public,Alias : 'FPC_ANSISTR_QWORD']; compilerproc; {$IFNDEF VER2_0} Inline; {$ENDIF}
Procedure fpc_AnsiStr_QWord(v : QWord;Len : SizeInt; out S : RawByteString{$ifdef FPC_HAS_CPSTRING};cp : TSystemCodePage{$endif FPC_HAS_CPSTRING});[Public,Alias : 'FPC_ANSISTR_QWORD']; compilerproc; {$IFNDEF VER2_0} Inline; {$ENDIF}
Var
SS : ShortString;
begin
str(v:Len,SS);
S:=SS;
{$ifdef FPC_HAS_CPSTRING}
SetCodePage(s,cp,false);
{$endif FPC_HAS_CPSTRING}
end;
Procedure fpc_AnsiStr_Int64(v : Int64; Len : SizeInt; out S : AnsiString);[Public,Alias : 'FPC_ANSISTR_INT64']; compilerproc; {$IFNDEF VER2_0} Inline; {$ENDIF}
Procedure fpc_AnsiStr_Int64(v : Int64; Len : SizeInt; out S : RawByteString{$ifdef FPC_HAS_CPSTRING};cp : TSystemCodePage{$endif FPC_HAS_CPSTRING});[Public,Alias : 'FPC_ANSISTR_INT64']; compilerproc; {$IFNDEF VER2_0} Inline; {$ENDIF}
Var
SS : ShortString;
begin
str (v:Len,SS);
S:=SS;
{$ifdef FPC_HAS_CPSTRING}
SetCodePage(s,cp,false);
{$endif FPC_HAS_CPSTRING}
end;
{$endif CPU64}

16
rtl/inc/compproc.inc
View File

@ -108,15 +108,15 @@ procedure fpc_ShortStr_Currency(c : currency; len,f : SizeInt; out s : shortstri
procedure fpc_chararray_sint(v : valsint;len : SizeInt;out a : array of char); compilerproc;
procedure fpc_chararray_uint(v : valuint;len : SizeInt;out a : array of char); compilerproc;
{$ifdef FPC_HAS_FEATURE_ANSISTRINGS}
procedure fpc_AnsiStr_sint(v : valsint; Len : SizeInt; out S : AnsiString); compilerproc;
procedure fpc_AnsiStr_uint(v : valuint;Len : SizeInt; out S : AnsiString); compilerproc;
procedure fpc_AnsiStr_sint(v : valsint; Len : SizeInt; out S : RawByteString{$ifdef FPC_HAS_CPSTRING};cp : TSystemCodePage{$endif FPC_HAS_CPSTRING}); compilerproc;
procedure fpc_AnsiStr_uint(v : valuint;Len : SizeInt; out S : RawByteString{$ifdef FPC_HAS_CPSTRING};cp : TSystemCodePage{$endif FPC_HAS_CPSTRING}); compilerproc;
{$ifndef FPUNONE}
procedure fpc_AnsiStr_Float(d : ValReal;len,fr,rt : SizeInt;out s : ansistring); compilerproc;
procedure fpc_AnsiStr_Float(d : ValReal;len,fr,rt : SizeInt;out s : RawByteString{$ifdef FPC_HAS_CPSTRING};cp : TSystemCodePage{$endif FPC_HAS_CPSTRING}); compilerproc;
{$endif}
procedure fpc_ansistr_enum(ordinal,len:sizeint;typinfo,ord2strindex:pointer;out s:ansistring); compilerproc;
procedure fpc_ansistr_bool(b : boolean;len:sizeint;out s:ansistring); compilerproc;
procedure fpc_ansistr_enum(ordinal,len:sizeint;typinfo,ord2strindex:pointer;out s:RawByteString{$ifdef FPC_HAS_CPSTRING};cp : TSystemCodePage{$endif FPC_HAS_CPSTRING}); compilerproc;
procedure fpc_ansistr_bool(b : boolean;len:sizeint;out s:RawByteString{$ifdef FPC_HAS_CPSTRING};cp : TSystemCodePage{$endif FPC_HAS_CPSTRING}); compilerproc;
{$ifdef FPC_HAS_STR_CURRENCY}
procedure fpc_AnsiStr_Currency(c : currency;len,fr : SizeInt;out s : ansistring); compilerproc;
procedure fpc_AnsiStr_Currency(c : currency;len,fr : SizeInt;out s : RawByteString{$ifdef FPC_HAS_CPSTRING};cp : TSystemCodePage{$endif FPC_HAS_CPSTRING}); compilerproc;
{$endif FPC_HAS_STR_CURRENCY}
{$endif FPC_HAS_FEATURE_ANSISTRINGS}
@ -137,8 +137,8 @@ procedure fpc_AnsiStr_Currency(c : currency;len,fr : SizeInt;out s : ansistring)
procedure fpc_chararray_qword(v : qword;len : SizeInt;out a : array of char); compilerproc;
procedure fpc_chararray_int64(v : int64;len : SizeInt;out a : array of char); compilerproc;
{$ifdef FPC_HAS_FEATURE_ANSISTRINGS}
procedure fpc_ansistr_qword(v : qword;len : SizeInt;out s : ansistring); compilerproc;
procedure fpc_ansistr_int64(v : int64;len : SizeInt;out s : ansistring); compilerproc;
procedure fpc_ansistr_qword(v : qword;len : SizeInt;out s : RawByteString{$ifdef FPC_HAS_CPSTRING};cp : TSystemCodePage{$endif FPC_HAS_CPSTRING}); compilerproc;
procedure fpc_ansistr_int64(v : int64;len : SizeInt;out s : RawByteString{$ifdef FPC_HAS_CPSTRING};cp : TSystemCodePage{$endif FPC_HAS_CPSTRING}); compilerproc;
{$endif FPC_HAS_FEATURE_ANSISTRINGS}
{$ifdef FPC_HAS_FEATURE_WIDESTRINGS}

13
tests/test/tcpstr14.pp Normal file
View File

@ -0,0 +1,13 @@
program tcpstr14;
{$apptype console}
{$mode delphi}{$H+}
type
t866 = type AnsiString(866);
var
s866: t866;
begin
Str(123, s866);
if StringCodePage(s866) <> 866 then
halt(1);
end.