Permalink
Browse files

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

    the jvm target + test

git-svn-id: http://svn.freepascal.org/svn/fpc/trunk@21391 3ad0048d-3df7-0310-abae-a5850022a9f2
  • Loading branch information...
1 parent e146dbb commit ca4ae09eff4ddbb02ccf8ac08a5cf98f36196def @jmaebe jmaebe committed May 26, 2012
Showing with 81 additions and 30 deletions.
  1. +26 −23 compiler/jvm/njvmcnv.pas
  2. +8 −4 compiler/jvm/njvmcon.pas
  3. +6 −3 rtl/java/jsystem.inc
  4. +6 −0 rtl/java/jsystemh.inc
  5. +35 −0 tests/test/jvm/tcnvstr1.pp
View
@@ -37,6 +37,7 @@ tjvmtypeconvnode = class(tcgtypeconvnode)
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;
View
@@ -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);
View
@@ -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';
View
@@ -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);
View
@@ -166,6 +166,41 @@ procedure test_ansi_to_short;
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;

0 comments on commit ca4ae09

Please sign in to comment.