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

compiler + rtl: pass codepage to fpc_CharArray_To_AnsiStr to get the preserve the codepage of result string

Browse Source 
git-svn-id: trunk@19240 -
This commit is contained in:
paul 2011-09-26 04:49:09 +00:00
parent 4868b09844
commit 5560f6b3f2
5 changed files with 28 additions and 6 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

1
.gitattributes vendored
View File

@ -9947,6 +9947,7 @@ tests/test/tconstref3.pp svneol=native#text/pascal
tests/test/tconstref4.pp svneol=native#text/pascal
tests/test/tcpstr1.pp svneol=native#text/plain
tests/test/tcpstr10.pp svneol=native#text/pascal
tests/test/tcpstr11.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

4
compiler/ncnv.pas
View File

@ -921,8 +921,7 @@ implementation
addstatement(newstat,ctemprefnode.create(restemp));
result:=newblock;
end
else if is_widechar(tarraydef(left.resultdef).elementdef) and
(tstringdef(resultdef).stringtype=st_ansistring) then
else if (tstringdef(resultdef).stringtype=st_ansistring) then
begin
result:=ccallnode.createinternres(
'fpc_'+chartype+'array_to_'+tstringdef(resultdef).stringtypname,
@ -1134,7 +1133,6 @@ implementation
begin
result:=nil;
if (left.nodetype=stringconstn) and
//(tstringdef(resultdef).stringtype in [st_ansistring,st_shortstring]) and
((tstringdef(resultdef).stringtype=st_shortstring) or
((tstringdef(resultdef).stringtype=st_ansistring) and
(tstringdef(resultdef).encoding<>CP_NONE)

16
rtl/inc/astrings.inc
View File

@ -550,9 +550,12 @@ begin
end;
Function fpc_CharArray_To_AnsiStr(const arr: array of char; zerobased: boolean = true): ansistring; compilerproc;
Function fpc_CharArray_To_AnsiStr(const arr: array of ansichar; {$ifdef FPC_HAS_CPSTRING}cp : TSystemCodePage;{$endif FPC_HAS_CPSTRING}zerobased: boolean = true): RawByteString; compilerproc;
var
i : SizeInt;
{$ifndef FPC_HAS_CPSTRING}
cp : TSystemCodePage;
{$endif FPC_HAS_CPSTRING}
begin
if (zerobased) then
begin
@ -569,7 +572,16 @@ begin
i := high(arr)+1;
SetLength(fpc_CharArray_To_AnsiStr,i);
if i > 0 then
Move (arr[0],Pointer(fpc_CharArray_To_AnsiStr)^,i);
begin
{$ifdef FPC_HAS_CPSTRING}
if (cp=0) then
cp:=DefaultSystemCodePage;
{$else FPC_HAS_CPSTRING}
cp:=DefaultSystemCodePage;
{$endif FPC_HAS_CPSTRING}
Move (arr[0],Pointer(fpc_CharArray_To_AnsiStr)^,i);
SetCodePage(fpc_CharArray_To_AnsiStr,cp,False);
end;
end;
{$ifndef FPC_STRTOCHARARRAYPROC}

2
rtl/inc/compproc.inc
View File

@ -273,7 +273,7 @@ Function fpc_ShortStr_To_AnsiStr (Const S2 : ShortString{$ifdef FPC_HAS_CPSTRING
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{$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;
Function fpc_CharArray_To_AnsiStr(const arr: array of char; {$ifdef FPC_HAS_CPSTRING}cp : TSystemCodePage;{$endif FPC_HAS_CPSTRING}zerobased: boolean = true): RawByteString; compilerproc;
{$ifndef FPC_STRTOCHARARRAYPROC}
function fpc_ansistr_to_chararray(arraysize: SizeInt; const src: ansistring): fpc_big_chararray; compilerproc;
{$else ndef FPC_STRTOCHARARRAYPROC}

11
tests/test/tcpstr11.pp Normal file
View File

@ -0,0 +1,11 @@
program tcpstr11;
type
cp866 = type AnsiString(866);
var
A: cp866;
c: array[0..5] of ansichar = '能芍乒';
begin
A := c;
if StringCodePage(A) <> 866 then
halt(1);
end.