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

compiler:

Browse Source 
- don't pass CP_NONE encoding to internal functions. They handled it as 0 encoding. This will optimize the generated code a bit.
  - convert all king of string/char/pchar constants to local ansistring def if they needs to be passed to rawbytestring type. They should not get a CP_NONE codepage (delphi compatible)
  - don't convert left and right arguments of string concatenation to ansistring type if they are already ansistrings but with different codepage - RTL already handles different codepages in concat routine
  - fix resultdef for ansistring concatenations inside assignments - return def of left assignment operand if it is already ansistring - this reduces amount of unneeded condepage conversions since concat functions can return result in any desired codepage
rtl: remove CP_NONE comparisions from most of RTL functions, replace 0 constant with CP_ACP
tests: add test to check various conversions to RawByteString type

git-svn-id: trunk@19519 -
This commit is contained in:
paul 2011-10-20 09:25:51 +00:00
parent 22f98e3259
commit c1866d5c17
13 changed files with 114 additions and 40 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

1
.gitattributes vendored
View File

@ -9979,6 +9979,7 @@ tests/test/tcpstr14.pp svneol=native#text/pascal
tests/test/tcpstr15.pp svneol=native#text/pascal tests/test/tcpstr15.pp svneol=native#text/pascal
tests/test/tcpstr16.pp svneol=native#text/pascal tests/test/tcpstr16.pp svneol=native#text/pascal
tests/test/tcpstr17.pp svneol=native#text/pascal tests/test/tcpstr17.pp svneol=native#text/pascal
tests/test/tcpstr18.pp svneol=native#text/pascal
tests/test/tcpstr2.pp svneol=native#text/plain tests/test/tcpstr2.pp svneol=native#text/plain
tests/test/tcpstr2a.pp svneol=native#text/plain tests/test/tcpstr2a.pp svneol=native#text/plain
tests/test/tcpstr3.pp svneol=native#text/plain tests/test/tcpstr3.pp svneol=native#text/plain

18
compiler/nadd.pas
View File

@ -1665,8 +1665,10 @@ implementation
inserttypeconv(left,rd) inserttypeconv(left,rd)
else else
begin begin
inserttypeconv(left,getansistringdef); if not is_ansistring(ld) then
inserttypeconv(right,getansistringdef); inserttypeconv(left,getansistringdef);
if not is_ansistring(rd) then
inserttypeconv(right,getansistringdef);
end; end;
end; end;
st_longstring : st_longstring :
@ -1960,6 +1962,14 @@ implementation
{ for strings, return is always a 255 char string } { for strings, return is always a 255 char string }
if is_shortstring(left.resultdef) then if is_shortstring(left.resultdef) then
resultdef:=cshortstringtype resultdef:=cshortstringtype
else
{ for ansistrings set resultdef to assignment left node
if it is an assignment and left node expects ansistring }
if is_ansistring(left.resultdef) and
assigned(aktassignmentnode) and
(aktassignmentnode.right=self) and
is_ansistring(aktassignmentnode.left.resultdef) then
resultdef:=aktassignmentnode.left.resultdef
else else
resultdef:=left.resultdef; resultdef:=left.resultdef;
end; end;
@ -2047,7 +2057,7 @@ implementation
if is_ansistring(resultdef) then if is_ansistring(resultdef) then
para:=ccallparanode.create( para:=ccallparanode.create(
cordconstnode.create( cordconstnode.create(
tstringdef(resultdef).encoding, getparaencoding(resultdef),
u16inttype, u16inttype,
true true
), ),
@ -2075,7 +2085,7 @@ implementation
if is_ansistring(resultdef) then if is_ansistring(resultdef) then
para:=ccallparanode.create( para:=ccallparanode.create(
cordconstnode.create( cordconstnode.create(
tstringdef(resultdef).encoding, getparaencoding(resultdef),
u16inttype, u16inttype,
true true
), ),

18
compiler/ncnv.pas
View File

@ -938,7 +938,7 @@ implementation
), ),
ccallparanode.create( ccallparanode.create(
cordconstnode.create( cordconstnode.create(
tstringdef(resultdef).encoding, getparaencoding(resultdef),
u16inttype, u16inttype,
true true
), ),
@ -1071,7 +1071,11 @@ implementation
end end
else else
hp:=cstringconstnode.createstr(chr(tordconstnode(left).value.uvalue)); hp:=cstringconstnode.createstr(chr(tordconstnode(left).value.uvalue));
tstringconstnode(hp).changestringtype(resultdef); { output string consts in local ansistring encoding }
if is_ansistring(resultdef) and ((tstringdef(resultdef).encoding=0) or (tstringdef(resultdef).encoding=globals.CP_NONE)) then
tstringconstnode(hp).changestringtype(getansistringdef)
else
tstringconstnode(hp).changestringtype(resultdef);
end; end;
result:=hp; result:=hp;
end end
@ -1098,7 +1102,7 @@ implementation
para:=ccallparanode.create(left,nil); para:=ccallparanode.create(left,nil);
{ encoding required? } { encoding required? }
if tstringdef(resultdef).stringtype=st_ansistring then if tstringdef(resultdef).stringtype=st_ansistring then
para:=ccallparanode.create(cordconstnode.create(tstringdef(resultdef).encoding,u16inttype,true),para); para:=ccallparanode.create(cordconstnode.create(getparaencoding(resultdef),u16inttype,true),para);
{ create the procname } { create the procname }
if torddef(left.resultdef).ordtype<>uwidechar then if torddef(left.resultdef).ordtype<>uwidechar then
@ -1469,7 +1473,7 @@ implementation
result := ccallnode.createinternres( result := ccallnode.createinternres(
'fpc_pchar_to_'+tstringdef(resultdef).stringtypname, 'fpc_pchar_to_'+tstringdef(resultdef).stringtypname,
ccallparanode.create( ccallparanode.create(
cordconstnode.create(tstringdef(resultdef).encoding,u16inttype,true), cordconstnode.create(getparaencoding(resultdef),u16inttype,true),
ccallparanode.create(left,nil) ccallparanode.create(left,nil)
), ),
resultdef resultdef
@ -1542,7 +1546,7 @@ implementation
'fpc_pwidechar_to_'+tstringdef(resultdef).stringtypname, 'fpc_pwidechar_to_'+tstringdef(resultdef).stringtypname,
ccallparanode.create( ccallparanode.create(
cordconstnode.create( cordconstnode.create(
tstringdef(resultdef).encoding, getparaencoding(resultdef),
u16inttype, u16inttype,
true true
), ),
@ -2291,7 +2295,7 @@ implementation
) )
) then ) then
begin begin
{ convert ansistring and rawbytestring constants to explicit source encoding if set } { output string consts in local ansistring encoding }
if is_ansistring(resultdef) and ((tstringdef(resultdef).encoding=0)or(tstringdef(resultdef).encoding=globals.CP_NONE)) then if is_ansistring(resultdef) and ((tstringdef(resultdef).encoding=0)or(tstringdef(resultdef).encoding=globals.CP_NONE)) then
tstringconstnode(left).changestringtype(getansistringdef) tstringconstnode(left).changestringtype(getansistringdef)
else else
@ -3004,7 +3008,7 @@ implementation
else if (tstringdef(resultdef).stringtype=st_ansistring) and else if (tstringdef(resultdef).stringtype=st_ansistring) and
(tstringdef(left.resultdef).stringtype in [st_widestring,st_unicodestring,st_shortstring,st_ansistring]) then (tstringdef(left.resultdef).stringtype in [st_widestring,st_unicodestring,st_shortstring,st_ansistring]) then
result:=ccallnode.createinternres(procname, result:=ccallnode.createinternres(procname,
ccallparanode.create(cordconstnode.create(tstringdef(resultdef).encoding,u16inttype,true), ccallparanode.create(cordconstnode.create(getparaencoding(resultdef),u16inttype,true),
ccallparanode.create(left,nil)),resultdef) ccallparanode.create(left,nil)),resultdef)
else else
result:=ccallnode.createinternres(procname,ccallparanode.create(left,nil),resultdef); result:=ccallnode.createinternres(procname,ccallparanode.create(left,nil),resultdef);

4
compiler/ninl.pas
View File

@ -325,7 +325,7 @@ implementation
{ for ansistrings insert the encoding argument } { for ansistrings insert the encoding argument }
if is_ansistring(dest.resultdef) then if is_ansistring(dest.resultdef) then
newparas:=ccallparanode.create(cordconstnode.create( newparas:=ccallparanode.create(cordconstnode.create(
tstringdef(dest.resultdef).encoding,u16inttype,true),newparas); getparaencoding(dest.resultdef),u16inttype,true),newparas);
{ free the errornode we generated in the beginning } { free the errornode we generated in the beginning }
result.free; result.free;
@ -759,7 +759,7 @@ implementation
{ in case of reading an ansistring pass a codepage argument } { in case of reading an ansistring pass a codepage argument }
if do_read and is_ansistring(para.left.resultdef) then if do_read and is_ansistring(para.left.resultdef) then
para:=ccallparanode.create(cordconstnode.create( para:=ccallparanode.create(cordconstnode.create(
tstringdef(para.left.resultdef).encoding,u16inttype,true),para); getparaencoding(para.left.resultdef),u16inttype,true),para);
{ create the call statement } { create the call statement }
addstatement(Tstatementnode(newstatement), addstatement(Tstatementnode(newstatement),
ccallnode.createintern(name,para)); ccallnode.createintern(name,para));

8
compiler/nld.pas
View File

@ -516,6 +516,7 @@ implementation
var var
hp : tnode; hp : tnode;
useshelper : boolean; useshelper : boolean;
oldassignmentnode : tassignmentnode;
begin begin
result:=nil; result:=nil;
resultdef:=voidtype; resultdef:=voidtype;
@ -524,7 +525,14 @@ implementation
set_unique(left); set_unique(left);
typecheckpass(left); typecheckpass(left);
{ PI. This is needed to return correct resultdef of add nodes for ansistrings
rawbytestring return needs to be replaced by left.resultdef }
oldassignmentnode:=aktassignmentnode;
aktassignmentnode:=self;
typecheckpass(right); typecheckpass(right);
aktassignmentnode:=oldassignmentnode;
set_varstate(right,vs_read,[vsf_must_be_valid]); set_varstate(right,vs_read,[vsf_must_be_valid]);
set_varstate(left,vs_written,[]); set_varstate(left,vs_written,[]);
if codegenerror then if codegenerror then

4
compiler/nopt.pas
View File

@ -346,7 +346,7 @@ begin
if is_ansistring(p.resultdef) then if is_ansistring(p.resultdef) then
para:=ccallparanode.create( para:=ccallparanode.create(
cordconstnode.create( cordconstnode.create(
tstringdef(p.resultdef).encoding, getparaencoding(p.resultdef),
u16inttype, u16inttype,
true true
), ),
@ -370,7 +370,7 @@ begin
if is_ansistring(p.resultdef) then if is_ansistring(p.resultdef) then
para:=ccallparanode.create( para:=ccallparanode.create(
cordconstnode.create( cordconstnode.create(
tstringdef(p.resultdef).encoding, getparaencoding(p.resultdef),
u16inttype, u16inttype,
true true
), ),

2
compiler/pdecl.pas
View File

@ -554,7 +554,7 @@ implementation
Message(parser_e_invalid_codepage); Message(parser_e_invalid_codepage);
tordconstnode(p).value:=0; tordconstnode(p).value:=0;
end; end;
tstringdef(hdef).encoding:=int64(tordconstnode(p).value); tstringdef(hdef).encoding:=int64(tordconstnode(p).value);
end; end;
p.free; p.free;
end; end;

2
compiler/pinline.pas
View File

@ -581,7 +581,7 @@ implementation
newblock:=ccallnode.createintern( newblock:=ccallnode.createintern(
'fpc_'+tstringdef(destppn.resultdef).stringtypname+'_setlength', 'fpc_'+tstringdef(destppn.resultdef).stringtypname+'_setlength',
ccallparanode.create( ccallparanode.create(
cordconstnode.create(tstringdef(destppn.resultdef).encoding,u16inttype,true), cordconstnode.create(getparaencoding(destppn.resultdef),u16inttype,true),
paras paras
) )
); );

10
compiler/symdef.pas
View File

@ -828,6 +828,7 @@ interface
function getansistringcodepage:tstringencoding; inline; function getansistringcodepage:tstringencoding; inline;
function getansistringdef:tstringdef; inline; function getansistringdef:tstringdef; inline;
function getparaencoding(def:tdef):tstringencoding; inline;
implementation implementation
@ -882,6 +883,15 @@ implementation
result:=tstringdef(cansistringtype); result:=tstringdef(cansistringtype);
end; end;
function getparaencoding(def:tdef):tstringencoding; inline;
begin
{ don't pass CP_NONE encoding to internal functions
they expect 0 encoding instead }
result:=tstringdef(def).encoding;
if result=CP_NONE then
result:=0
end;
function make_mangledname(const typeprefix:string;st:TSymtable;const suffix:string):string; function make_mangledname(const typeprefix:string;st:TSymtable;const suffix:string):string;
var var
s,hs, s,hs,

32
rtl/inc/astrings.inc
View File

@ -203,10 +203,10 @@ Var
begin begin
{ if codepages are differ then concat using unicodestring } { if codepages are differ then concat using unicodestring }
S1CP:=StringCodePage(S1); S1CP:=StringCodePage(S1);
if (S1CP=CP_NONE) or (S1CP=0) then if (S1CP=CP_ACP) then
S1CP:=DefaultSystemCodePage; S1CP:=DefaultSystemCodePage;
S2CP:=StringCodePage(S2); S2CP:=StringCodePage(S2);
if (S2CP=CP_NONE) or (S2CP=0) then if (S2CP=CP_ACP) then
S2CP:=DefaultSystemCodePage; S2CP:=DefaultSystemCodePage;
{$ifdef FPC_HAS_CPSTRING} {$ifdef FPC_HAS_CPSTRING}
if (Pointer(DestS)=nil) then if (Pointer(DestS)=nil) then
@ -216,7 +216,7 @@ begin
{$else FPC_HAS_CPSTRING} {$else FPC_HAS_CPSTRING}
DestCP:=StringCodePage(DestS); DestCP:=StringCodePage(DestS);
{$endif FPC_HAS_CPSTRING} {$endif FPC_HAS_CPSTRING}
if (DestCP=CP_NONE) or (DestCP=0) then if (DestCP=CP_ACP) then
DestCP:=DefaultSystemCodePage; DestCP:=DefaultSystemCodePage;
if (S1CP<>DestCP) or (S2CP<>DestCP) then if (S1CP<>DestCP) or (S2CP<>DestCP) then
begin begin
@ -291,7 +291,7 @@ begin
{$else FPC_HAS_CPSTRING} {$else FPC_HAS_CPSTRING}
DestCP:=StringCodePage(DestS); DestCP:=StringCodePage(DestS);
{$endif FPC_HAS_CPSTRING} {$endif FPC_HAS_CPSTRING}
if (DestCP=CP_NONE) or (DestCP=0) then if (DestCP=CP_ACP) then
DestCP:=DefaultSystemCodePage; DestCP:=DefaultSystemCodePage;
sameCP:=true; sameCP:=true;
lowstart:=low(sarr); lowstart:=low(sarr);
@ -308,7 +308,7 @@ begin
U:=''; U:='';
for i:=lowstart to high(sarr) do begin for i:=lowstart to high(sarr) do begin
tmpCP:=StringCodePage(sarr[i]); tmpCP:=StringCodePage(sarr[i]);
if (tmpCP=CP_NONE) or (tmpCP=0) then if (tmpCP=CP_ACP) then
begin begin
tmpStr:=sarr[i]; tmpStr:=sarr[i];
SetCodePage(tmpStr,DefaultSystemCodePage,False); SetCodePage(tmpStr,DefaultSystemCodePage,False);
@ -408,7 +408,7 @@ begin
Size:=Length(S); Size:=Length(S);
if Size>0 then if Size>0 then
begin begin
if (cp=0) or (cp=CP_NONE) then if (cp=CP_ACP) then
cp:=DefaultSystemCodePage; cp:=DefaultSystemCodePage;
orgcp:=StringCodePage(S); orgcp:=StringCodePage(S);
if (orgcp=cp) or (orgcp=CP_NONE) then if (orgcp=cp) or (orgcp=CP_NONE) then
@ -489,7 +489,7 @@ Var
{$endif FPC_HAS_CPSTRING} {$endif FPC_HAS_CPSTRING}
begin begin
{$ifdef FPC_HAS_CPSTRING} {$ifdef FPC_HAS_CPSTRING}
if (cp=0) or (cp=CP_NONE) then if (cp=CP_ACP) then
cp:=DefaultSystemCodePage; cp:=DefaultSystemCodePage;
{$else FPC_HAS_CPSTRING} {$else FPC_HAS_CPSTRING}
cp:=DefaultSystemCodePage; cp:=DefaultSystemCodePage;
@ -513,7 +513,7 @@ var
{$endif FPC_HAS_CPSTRING} {$endif FPC_HAS_CPSTRING}
begin begin
{$ifdef FPC_HAS_CPSTRING} {$ifdef FPC_HAS_CPSTRING}
if (cp=0) or (cp=CP_NONE) then if (cp=CP_ACP) then
cp:=DefaultSystemCodePage; cp:=DefaultSystemCodePage;
{$else FPC_HAS_CPSTRING} {$else FPC_HAS_CPSTRING}
cp:=DefaultSystemCodePage; cp:=DefaultSystemCodePage;
@ -541,7 +541,7 @@ begin
if L > 0 then if L > 0 then
begin begin
{$ifdef FPC_HAS_CPSTRING} {$ifdef FPC_HAS_CPSTRING}
if (cp=0) or (cp=CP_NONE) then if (cp=CP_ACP) then
cp:=DefaultSystemCodePage; cp:=DefaultSystemCodePage;
{$else FPC_HAS_CPSTRING} {$else FPC_HAS_CPSTRING}
cp:=DefaultSystemCodePage; cp:=DefaultSystemCodePage;
@ -576,7 +576,7 @@ begin
if i > 0 then if i > 0 then
begin begin
{$ifdef FPC_HAS_CPSTRING} {$ifdef FPC_HAS_CPSTRING}
if (cp=0) or (cp=CP_NONE) then if (cp=CP_ACP) then
cp:=DefaultSystemCodePage; cp:=DefaultSystemCodePage;
{$else FPC_HAS_CPSTRING} {$else FPC_HAS_CPSTRING}
cp:=DefaultSystemCodePage; cp:=DefaultSystemCodePage;
@ -674,10 +674,10 @@ begin
else else
begin begin
r1:=S1; r1:=S1;
if (cp1=CP_NONE) or (cp1=0) then if (cp1=CP_ACP) then
SetCodePage(r1,DefaultSystemCodePage,false); SetCodePage(r1,DefaultSystemCodePage,false);
r2:=S2; r2:=S2;
if (cp2=CP_NONE) or (cp2=0) then if (cp2=CP_ACP) then
SetCodePage(r2,DefaultSystemCodePage,false); SetCodePage(r2,DefaultSystemCodePage,false);
//convert them to utf8 then compare //convert them to utf8 then compare
SetCodePage(r1,65001); SetCodePage(r1,65001);
@ -728,10 +728,10 @@ begin
else else
begin begin
r1:=S1; r1:=S1;
if (cp1=CP_NONE) or (cp1=0) then if (cp1=CP_ACP) then
SetCodePage(r1,DefaultSystemCodePage,false); SetCodePage(r1,DefaultSystemCodePage,false);
r2:=S2; r2:=S2;
if (cp2=CP_NONE) or (cp2=0) then if (cp2=CP_ACP) then
SetCodePage(r2,DefaultSystemCodePage,false); SetCodePage(r2,DefaultSystemCodePage,false);
//convert them to utf8 then compare //convert them to utf8 then compare
SetCodePage(r1,65001); SetCodePage(r1,65001);
@ -784,7 +784,7 @@ begin
GetMem(Pointer(S),AnsiRecLen+L); GetMem(Pointer(S),AnsiRecLen+L);
PAnsiRec(S)^.Ref:=1; PAnsiRec(S)^.Ref:=1;
{$ifdef FPC_HAS_CPSTRING} {$ifdef FPC_HAS_CPSTRING}
if (cp=0) or (cp=CP_NONE) then if (cp=CP_ACP) then
cp:=DefaultSystemCodePage; cp:=DefaultSystemCodePage;
PAnsiRec(S)^.CodePage:=cp; PAnsiRec(S)^.CodePage:=cp;
{$else} {$else}
@ -1249,7 +1249,7 @@ begin
Dec(Index); Dec(Index);
SetLength(Temp,Length(Source)+LS); SetLength(Temp,Length(Source)+LS);
cp:=StringCodePage(S); cp:=StringCodePage(S);
if (cp=0) or (cp=CP_NONE) then if (cp=CP_ACP) then
cp:=DefaultSystemCodePage; cp:=DefaultSystemCodePage;
SetCodePage(Temp,cp,false); SetCodePage(Temp,cp,false);
If Index>0 then If Index>0 then

8
rtl/inc/ustrings.inc
View File

@ -37,7 +37,7 @@ Type
PUnicodeRec = ^TUnicodeRec; PUnicodeRec = ^TUnicodeRec;
TUnicodeRec = Packed Record TUnicodeRec = Packed Record
CodePage : TSystemCodePage; CodePage : TSystemCodePage;
ElementSize : Word; ElementSize : Word;
{$ifdef CPU64} {$ifdef CPU64}
{ align fields } { align fields }
Dummy : DWord; Dummy : DWord;
@ -313,7 +313,7 @@ begin
Size:=Length(S2); Size:=Length(S2);
if Size>0 then if Size>0 then
begin begin
if (cp=CP_NONE) or (cp=0) then if (cp=CP_ACP) then
cp:=DefaultSystemCodePage; cp:=DefaultSystemCodePage;
widestringmanager.Unicode2AnsiMoveProc(PUnicodeChar(Pointer(S2)),result,cp,Size); widestringmanager.Unicode2AnsiMoveProc(PUnicodeChar(Pointer(S2)),result,cp,Size);
end; end;
@ -333,7 +333,7 @@ begin
if Size>0 then if Size>0 then
begin begin
cp:=StringCodePage(S2); cp:=StringCodePage(S2);
if (cp=CP_NONE) or (cp=0) then if (cp=CP_ACP) then
cp:=DefaultSystemCodePage; cp:=DefaultSystemCodePage;
widestringmanager.Ansi2UnicodeMoveProc(PChar(S2),cp,result,Size); widestringmanager.Ansi2UnicodeMoveProc(PChar(S2),cp,result,Size);
end; end;
@ -789,7 +789,7 @@ begin
{$ifndef FPC_HAS_CPSTRING} {$ifndef FPC_HAS_CPSTRING}
cp:=DefaultSystemCodePage; cp:=DefaultSystemCodePage;
{$endif FPC_HAS_CPSTRING} {$endif FPC_HAS_CPSTRING}
if (cp=CP_NONE) or (cp=0) then if (cp=CP_ACP) then
cp:=DefaultSystemCodePage; cp:=DefaultSystemCodePage;
widestringmanager.Unicode2AnsiMoveProc(@c, fpc_UChar_To_AnsiStr, cp, 1); widestringmanager.Unicode2AnsiMoveProc(@c, fpc_UChar_To_AnsiStr, cp, 1);
end; end;

6
rtl/inc/wstrings.inc
View File

@ -251,14 +251,14 @@ begin
Size:=Length(S2); Size:=Length(S2);
if Size>0 then if Size>0 then
begin begin
if (cp=CP_NONE) or (cp=0) then if (cp=CP_ACP) then
cp:=DefaultSystemCodePage; cp:=DefaultSystemCodePage;
widestringmanager.Wide2AnsiMoveProc(PWideChar(Pointer(S2)),result,cp,Size); widestringmanager.Wide2AnsiMoveProc(PWideChar(Pointer(S2)),result,cp,Size);
end; end;
end; end;
Function fpc_AnsiStr_To_WideStr (Const S2 : RawByteString): WideString; compilerproc; Function fpc_AnsiStr_To_WideStr(Const S2 : RawByteString): WideString; compilerproc;
{ {
Converts an AnsiString to a WideString; Converts an AnsiString to a WideString;
} }
@ -271,7 +271,7 @@ begin
if Size>0 then if Size>0 then
begin begin
cp:=StringCodePage(S2); cp:=StringCodePage(S2);
if (cp=CP_NONE) or (cp=0) then if (cp=CP_ACP) then
cp:=DefaultSystemCodePage; cp:=DefaultSystemCodePage;
widestringmanager.Ansi2WideMoveProc(PChar(S2),cp,result,Size); widestringmanager.Ansi2WideMoveProc(PChar(S2),cp,result,Size);
end; end;

41
tests/test/tcpstr18.pp Normal file
View File

@ -0,0 +1,41 @@
// to have correct test result with delphi set codepage option to 866
program tcpstr17;
{$apptype console}
{$ifdef fpc}
{$mode delphi}
{$codepage cp866}
{$endif}
{$ifdef unix}
uses
cwstring;
{$endif}
procedure TestRawByte(const Source: RawByteString; cp: word; const reason: integer);
begin
Writeln(StringCodePage(Source), ' ', Source);
if StringCodePage(Source) <> cp then
halt(reason);
end;
const
test: array[0..4] of ansichar = 'test'#0;
var
s: rawbytestring;
ss: shortstring;
c: ansichar;
w: widechar;
begin
s := 'test';
ss := 'test';
TestRawByte(s, 866, 1);
TestRawByte(ss, DefaultSystemCodePage, 2);
TestRawByte(AnsiChar('t'), 866, 3);
c := 't';
TestRawByte(c, DefaultSystemCodePage, 4);
TestRawByte(WideChar('t'), 866, 5);
w := 't';
TestRawByte(w, DefaultSystemCodePage, 6);
TestRawByte(test, DefaultSystemCodePage, 7);
TestRawByte(PAnsiChar(@test[0]), DefaultSystemCodePage, 8);
end.