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

merge r17601 from cpstrnew branch by inoussa:

Browse Source 
Correct fpc_ansistr_to_ansistr and fpc_short_to_ansistr and test

git-svn-id: trunk@19121 -
This commit is contained in:
paul 2011-09-17 14:03:10 +00:00
parent 7c21524892
commit aaf5392315
5 changed files with 67 additions and 5 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

1
.gitattributes vendored
View File

@ -9955,6 +9955,7 @@ tests/test/tcpstrconcatmulti.pp svneol=native#text/plain
tests/test/tcpstrconcatmulti2.pp svneol=native#text/plain
tests/test/tcpstrsetlength.pp svneol=native#text/plain
tests/test/tcpstrsetlength2.pp svneol=native#text/plain
tests/test/tcpstrshortstr2ansistr.pp svneol=native#text/plain
tests/test/tcptypedconst.pp svneol=native#text/plain
tests/test/tcptypedconst2.pp svneol=native#text/plain
tests/test/tcptypedconst3.pp svneol=native#text/plain

2
compiler/ncnv.pas
View File

@ -2979,7 +2979,7 @@ implementation
end
{ encoding parameter required? }
else if (tstringdef(resultdef).stringtype=st_ansistring) and
((tstringdef(left.resultdef).stringtype in [st_widestring,st_unicodestring]) or
((tstringdef(left.resultdef).stringtype in [st_widestring,st_unicodestring,st_shortstring]) or
{ ansistring to ansistring and no RawByteString envolved? }
(//(tstringdef(resultdef).encoding<>65535) and
(tstringdef(left.resultdef).stringtype=st_ansistring)

18
rtl/inc/astrings.inc
View File

@ -426,7 +426,7 @@ begin
begin
SetLength(result,Size);
Move(S[1],result[1],Size);
PAnsiRec(Pointer(S)-AnsiFirstOff)^.CodePage:=cp;
PAnsiRec(Pointer(result)-AnsiFirstOff)^.CodePage:=cp;
end
else
begin
@ -489,17 +489,29 @@ end;
{$endif FPC_STRTOSHORTSTRINGPROC}
Function fpc_ShortStr_To_AnsiStr (Const S2 : ShortString): ansistring; compilerproc;
Function fpc_ShortStr_To_AnsiStr (Const S2 : ShortString{$ifdef FPC_HAS_CPSTRING};cp : TSystemCodePage{$endif FPC_HAS_CPSTRING}): RawByteString; compilerproc;
{
Converts a ShortString to a AnsiString;
}
Var
Size : SizeInt;
{$ifndef FPC_HAS_CPSTRING}
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}
Size:=Length(S2);
Setlength (fpc_ShortStr_To_AnsiStr,Size);
if Size>0 then
Move(S2[1],Pointer(fpc_ShortStr_To_AnsiStr)^,Size);
begin
Move(S2[1],Pointer(fpc_ShortStr_To_AnsiStr)^,Size);
SetCodePage(fpc_ShortStr_To_AnsiStr,cp,False);
end
end;
Function fpc_Char_To_AnsiStr(const c : Char): AnsiString; compilerproc;

2
rtl/inc/compproc.inc
View File

@ -269,7 +269,7 @@ procedure fpc_AnsiStr_To_ShortStr (out res : shortstring;const S2 : Ansistring);
{$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): ansistring; compilerproc;
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_PChar_To_AnsiStr(const p : pchar): ansistring; compilerproc;

49
tests/test/tcpstrshortstr2ansistr.pp Normal file
View File

@ -0,0 +1,49 @@
{$mode objfpc} {$H+}
uses
{$ifdef unix}
cwstring,
{$endif unix}
sysutils;
type
ts866 = type string<866>;
ts1252 = type string<1252>;
procedure doerror(ANumber : Integer);
begin
WriteLn('error ',ANumber);
Halt(ANumber);
end;
var
s : ts866;
x : ts1252;
ss : shortstring;
i : Integer;
begin
ss := #128#156#196;
s := ss;
if (StringCodePage(s) <> 866) then
doerror(1);
if (Length(s) <> Length(ss)) then
doerror(2);
for i := 1 to Length(s) do
begin
if (Byte(s[i]) <> Byte(ss[i])) then
doerror(3)
end;
x := ss;
if (StringCodePage(x) <> 1252) then
doerror(4);
if (Length(x) <> Length(ss)) then
doerror(5);
for i := 1 to Length(x) do
begin
if (Byte(x[i]) <> Byte(ss[i])) then
doerror(6)
end;
WriteLn('Ok');
end.