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

* fixed conversion of empty ansistring/widestring constants to pchar on

Browse Source 
the jvm target + test

git-svn-id: trunk@21391 -
This commit is contained in:
Jonas Maebe 2012-05-26 11:32:20 +00:00
parent 5aeb9c860d
commit 8234a842e6
5 changed files with 81 additions and 30 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

49
compiler/jvm/njvmcnv.pas
View File

@ -37,6 +37,7 @@ interface
function typecheck_proc_to_procvar: tnode; override;
function pass_1: tnode; override;
function simplify(forinline: boolean): tnode; override;
function first_cstring_to_pchar: tnode;override;
function first_set_to_set : tnode;override;
function first_nil_to_methodprocvar: tnode; override;
function first_proc_to_procvar: tnode; override;
@ -280,6 +281,30 @@ implementation
end;
function tjvmtypeconvnode.first_cstring_to_pchar: tnode;
var
vs: tstaticvarsym;
begin
result:=inherited;
if assigned(result) then
exit;
{ nil pointer -> valid address }
if (left.nodetype=stringconstn) and
(tstringconstnode(left).cst_type in [cst_widestring,cst_unicodestring,cst_ansistring]) and
(tstringconstnode(left).len=0) then
begin
if tstringconstnode(left).cst_type=cst_ansistring then
vs:=tstaticvarsym(systemunit.Find('FPC_EMPTYANSICHAR'))
else
vs:=tstaticvarsym(systemunit.Find('FPC_EMPTYWIDECHAR'));
if not assigned(vs) then
internalerror(2012052605);
result:=caddrnode.create(cloadnode.create(vs,vs.owner));
result:=ctypeconvnode.create_explicit(result,resultdef);
end;
end;
function tjvmtypeconvnode.first_set_to_set: tnode;
var
setclassdef: tdef;
@ -566,30 +591,8 @@ implementation
procedure tjvmtypeconvnode.second_cstring_to_pchar;
var
hr: treference;
vs: tstaticvarsym;
begin
{ don't use is_chararray because it doesn't support special arrays }
if (left.resultdef.typ<>arraydef) or
(tarraydef(left.resultdef).elementdef.typ<>orddef) or
(torddef(tarraydef(left.resultdef).elementdef).ordtype<>uchar) then
internalerror(2011081304);
if (tstringconstnode(left).cst_type in [cst_widestring,cst_unicodestring,cst_ansistring]) and
(tstringconstnode(left).len=0) then
begin
if tstringconstnode(left).cst_type=cst_ansistring then
vs:=tstaticvarsym(systemunit.Find('EMPTYPANSICHAR'))
else
vs:=tstaticvarsym(systemunit.Find('EMPTYPWIDECHAR'));
reference_reset(hr,4);
hr.symbol:=current_asmdata.RefAsmSymbol(vs.mangledname);
location_reset(location,LOC_REGISTER,OS_ADDR);
location.register:=hlcg.getaddressregister(current_asmdata.CurrAsmList,resultdef);
hlcg.a_loadaddr_ref_reg(current_asmdata.CurrAsmList,vs.vardef,resultdef,hr,location.register);
end
else
location_copy(location,left.location);
location_copy(location,left.location);
end;

12
compiler/jvm/njvmcon.pas
View File

@ -195,8 +195,6 @@ implementation
{ we have to use nil rather than an empty string, because an
empty string has a code page and this messes up the code
page selection logic in the RTL }
result:=cnilnode.create;
inserttypeconv_internal(result,resultdef);
exit;
end;
strclass:=tobjectdef(search_system_type('ANSISTRINGCLASS').typedef);
@ -229,14 +227,20 @@ implementation
case cst_type of
cst_ansistring:
begin
current_asmdata.CurrAsmList.concat(taicpu.op_string(a_ldc,len,value_str));
if len<>0 then
internalerror(2012052604);
hlcg.a_load_const_reg(current_asmdata.CurrAsmList,resultdef,0,location.register);
{ done }
exit;
end;
cst_shortstring,
cst_conststring:
current_asmdata.CurrAsmList.concat(taicpu.op_string(a_ldc,len,value_str));
internalerror(2012052601);
cst_unicodestring,
cst_widestring:
current_asmdata.CurrAsmList.concat(taicpu.op_wstring(a_ldc,pcompilerwidestring(value_str)));
else
internalerror(2012052602);
end;
thlcgjvm(hlcg).incstack(current_asmdata.CurrAsmList,1);
thlcgjvm(hlcg).a_load_stack_reg(current_asmdata.CurrAsmList,resultdef,location.register);

9
rtl/java/jsystem.inc
View File

@ -96,12 +96,15 @@ const
ErrorBase : Pointer = nil; public name 'FPC_ERRORBASE';
*)
{$ifndef cpujvm}
{ Used by the ansi/widestrings and maybe also other things in the future }
var
{ separated compared to generic version, for Java type safety }
emptypansichar : array[0..0] of ansichar; public name 'FPC_EMPTYANSICHAR';
emptypwidechar : array[0..0] of widechar; public name 'FPC_EMPTYWIDECHAR';
{ widechar, because also used by widestring -> pwidechar conversions }
emptychar : widechar;public name 'FPC_EMPTYCHAR';
{ declared in interface for jvm target }
{$endif}
{$ifndef FPC_NO_GENERIC_STACK_CHECK}
var
{ if the OS does the stack checking, we don't need any stklen from the
main program }
initialstklen : SizeUint;external name '__stklen';

6
rtl/java/jsystemh.inc
View File

@ -410,6 +410,12 @@ function strpas(p:pchar):shortstring;{$ifdef SYSTEMINLINE}inline;{$endif}
function strlen(p:pchar):sizeint;external name 'FPC_PCHAR_LENGTH';
*)
var
{ separated compared to generic version, for Java type safety }
FPC_EMPTYANSICHAR : array[0..0] of ansichar;
FPC_EMPTYWIDECHAR : array[0..0] of widechar;
{ Shortstring functions }
Procedure Delete(var s:shortstring;index:SizeInt;count:SizeInt);
Procedure Insert(const source:shortstring;var s:shortstring;index:SizeInt);

35
tests/test/jvm/tcnvstr1.pp
View File

@ -166,6 +166,41 @@ begin
else
Writeln('Success');
p:='';
Write('empty string const -> pchar...');
if p^<>#0 then
fail;
if p[0]<>#0 then
fail
else
Writeln('Success');
p:=ansistring('');
Write('empty ansistring const -> pchar...');
if p^<>#0 then
fail;
if p[0]<>#0 then
fail
else
Writeln('Success');
p:=widestring('');
Write('empty widestring const -> pchar...');
if p^<>#0 then
fail;
if p[0]<>#0 then
fail
else
Writeln('Success');
p:=BIG_STRING;
str_ansi:=BIG_STRING;
Write('big ansistring -> pchar...');
if p = str_ansi then
WriteLn('Success.')
else
fail;
s2 := '';
str_ansi:='';
str_ansi := BIG_STRING;