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

* only set the assignmentside flag for typeconversion nodes in

Browse Source 
valid_for_assign() if that routine returns true (in some cases,
    it's used to simply check whether we could possibly put it on
    the assignment side)

git-svn-id: branches/jvmbackend@18751 -
This commit is contained in:
Jonas Maebe 2011-08-20 08:32:41 +00:00
parent da5bd3b0bd
commit a73d5b6da7
1 changed files with 59 additions and 3 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

58
compiler/htypechk.pas
View File

@ -1068,6 +1068,7 @@ implementation
function valid_for_assign(p:tnode;opts:TValidAssigns; report_errors: boolean):boolean; function valid_for_assign(p:tnode;opts:TValidAssigns; report_errors: boolean):boolean;
var var
typeconvs: tfpobjectlist;
hp2, hp2,
hp : tnode; hp : tnode;
gotstring, gotstring,
@ -1109,6 +1110,22 @@ implementation
CGMessagePos(hp.fileinfo,type_e_no_assign_to_const); CGMessagePos(hp.fileinfo,type_e_no_assign_to_const);
end; end;
procedure mayberesettypeconvs;
var
i: longint;
begin
if assigned(typeconvs) then
begin
if not report_errors and
not result then
for i:=0 to typeconvs.Count-1 do
ttypeconvnode(typeconvs[i]).assignment_side:=false;
typeconvs.free;
end;
end;
begin begin
if valid_const in opts then if valid_const in opts then
errmsg:=type_e_variable_id_expected errmsg:=type_e_variable_id_expected
@ -1134,6 +1151,7 @@ implementation
CGMessagePos(hp.fileinfo,errmsg); CGMessagePos(hp.fileinfo,errmsg);
exit; exit;
end; end;
typeconvs:=nil;
while assigned(hp) do while assigned(hp) do
begin begin
{ property allowed? calln has a property check itself } { property allowed? calln has a property check itself }
@ -1205,12 +1223,14 @@ implementation
if report_errors then if report_errors then
CGMessagePos(hp.fileinfo,errmsg); CGMessagePos(hp.fileinfo,errmsg);
end; end;
mayberesettypeconvs;
exit; exit;
end; end;
case hp.nodetype of case hp.nodetype of
temprefn : temprefn :
begin begin
valid_for_assign := not(ti_readonly in ttemprefnode(hp).tempinfo^.flags); valid_for_assign := not(ti_readonly in ttemprefnode(hp).tempinfo^.flags);
mayberesettypeconvs;
exit; exit;
end; end;
derefn : derefn :
@ -1234,12 +1254,22 @@ implementation
if not(gotderef or if not(gotderef or
((target_info.system=system_jvm_java32) and ((target_info.system=system_jvm_java32) and
(gotsubscript or gotvec))) then (gotsubscript or gotvec))) then
begin
ttypeconvnode(hp).assignment_side:=true; ttypeconvnode(hp).assignment_side:=true;
if not assigned(typeconvs) then
typeconvs:=tfpobjectlist.create(false);
typeconvs.add(hp);
end;
{ in managed VMs, you cannot typecast formaldef when assigning { in managed VMs, you cannot typecast formaldef when assigning
to it, see http://hallvards.blogspot.com/2007/10/dn4dp24-net-vs-win32-untyped-parameters.html } to it, see http://hallvards.blogspot.com/2007/10/dn4dp24-net-vs-win32-untyped-parameters.html }
if (target_info.system in systems_managed_vm) and if (target_info.system in systems_managed_vm) and
(fromdef.typ=formaldef) then (fromdef.typ=formaldef) then
CGMessagePos(hp.fileinfo,type_e_no_managed_formal_assign_typecast) begin
if report_errors then
CGMessagePos(hp.fileinfo,type_e_no_managed_formal_assign_typecast);
mayberesettypeconvs;
exit;
end
else if not((nf_absolute in ttypeconvnode(hp).flags) or else if not((nf_absolute in ttypeconvnode(hp).flags) or
ttypeconvnode(hp).target_specific_general_typeconv or ttypeconvnode(hp).target_specific_general_typeconv or
((nf_explicit in hp.flags) and ((nf_explicit in hp.flags) and
@ -1268,6 +1298,7 @@ implementation
begin begin
if report_errors then if report_errors then
CGMessagePos(hp.fileinfo,errmsg); CGMessagePos(hp.fileinfo,errmsg);
mayberesettypeconvs;
exit; exit;
end; end;
case hp.resultdef.typ of case hp.resultdef.typ of
@ -1303,6 +1334,7 @@ implementation
CGMessagePos(hp.fileinfo,parser_e_packed_element_no_loop) CGMessagePos(hp.fileinfo,parser_e_packed_element_no_loop)
else else
CGMessagePos(hp.fileinfo,parser_e_packed_element_no_var_addr); CGMessagePos(hp.fileinfo,parser_e_packed_element_no_var_addr);
mayberesettypeconvs;
exit; exit;
end; end;
gotvec:=true; gotvec:=true;
@ -1326,6 +1358,7 @@ implementation
begin begin
if report_errors then if report_errors then
CGMessagePos(hp.fileinfo,type_e_variable_id_expected); CGMessagePos(hp.fileinfo,type_e_variable_id_expected);
mayberesettypeconvs;
exit; exit;
end; end;
end; end;
@ -1337,6 +1370,7 @@ implementation
begin begin
if report_errors then if report_errors then
CGMessagePos(hp.fileinfo,errmsg); CGMessagePos(hp.fileinfo,errmsg);
mayberesettypeconvs;
exit; exit;
end; end;
hp:=tunarynode(hp).left; hp:=tunarynode(hp).left;
@ -1356,12 +1390,16 @@ implementation
CGMessagePos(hp.fileinfo,parser_e_packed_element_no_loop) CGMessagePos(hp.fileinfo,parser_e_packed_element_no_loop)
else else
CGMessagePos(hp.fileinfo,parser_e_packed_element_no_var_addr); CGMessagePos(hp.fileinfo,parser_e_packed_element_no_var_addr);
mayberesettypeconvs;
exit; exit;
end; end;
{ check for final fields } { check for final fields }
if (tsubscriptnode(hp).vs.varspez=vs_final) and if (tsubscriptnode(hp).vs.varspez=vs_final) and
not constaccessok(tsubscriptnode(hp).vs) then not constaccessok(tsubscriptnode(hp).vs) then
begin
mayberesettypeconvs;
exit; exit;
end;
gotsubscript:=true; gotsubscript:=true;
{ loop counter? } { loop counter? }
if not(Valid_Const in opts) and if not(Valid_Const in opts) and
@ -1369,6 +1407,7 @@ implementation
begin begin
if report_errors then if report_errors then
CGMessage1(parser_e_illegal_assignment_to_count_var,tsubscriptnode(hp).vs.realname); CGMessage1(parser_e_illegal_assignment_to_count_var,tsubscriptnode(hp).vs.realname);
mayberesettypeconvs;
exit; exit;
end; end;
{ implicit pointer object types result in dereferencing } { implicit pointer object types result in dereferencing }
@ -1402,6 +1441,7 @@ implementation
else else
if report_errors then if report_errors then
CGMessagePos(hp.fileinfo,type_e_variable_id_expected); CGMessagePos(hp.fileinfo,type_e_variable_id_expected);
mayberesettypeconvs;
exit; exit;
end; end;
niln, niln,
@ -1413,6 +1453,7 @@ implementation
else else
if report_errors then if report_errors then
CGMessagePos(hp.fileinfo,type_e_no_assign_to_addr); CGMessagePos(hp.fileinfo,type_e_no_assign_to_addr);
mayberesettypeconvs;
exit; exit;
end; end;
ordconstn, ordconstn,
@ -1421,6 +1462,7 @@ implementation
{ these constants will be passed by value } { these constants will be passed by value }
if report_errors then if report_errors then
CGMessagePos(hp.fileinfo,type_e_variable_id_expected); CGMessagePos(hp.fileinfo,type_e_variable_id_expected);
mayberesettypeconvs;
exit; exit;
end; end;
setconstn, setconstn,
@ -1433,6 +1475,7 @@ implementation
else else
if report_errors then if report_errors then
CGMessagePos(hp.fileinfo,type_e_variable_id_expected); CGMessagePos(hp.fileinfo,type_e_variable_id_expected);
mayberesettypeconvs;
exit; exit;
end; end;
addrn : addrn :
@ -1442,6 +1485,7 @@ implementation
else else
if report_errors then if report_errors then
CGMessagePos(hp.fileinfo,type_e_no_assign_to_addr); CGMessagePos(hp.fileinfo,type_e_no_assign_to_addr);
mayberesettypeconvs;
exit; exit;
end; end;
calln : calln :
@ -1489,6 +1533,7 @@ implementation
else else
if report_errors then if report_errors then
CGMessagePos(hp.fileinfo,errmsg); CGMessagePos(hp.fileinfo,errmsg);
mayberesettypeconvs;
exit; exit;
end; end;
inlinen : inlinen :
@ -1500,12 +1545,14 @@ implementation
else else
if report_errors then if report_errors then
CGMessagePos(hp.fileinfo,type_e_variable_id_expected); CGMessagePos(hp.fileinfo,type_e_variable_id_expected);
mayberesettypeconvs;
exit; exit;
end; end;
dataconstn: dataconstn:
begin begin
{ only created internally, so no additional checks necessary } { only created internally, so no additional checks necessary }
result:=true; result:=true;
mayberesettypeconvs;
exit; exit;
end; end;
loadn : loadn :
@ -1523,15 +1570,18 @@ implementation
begin begin
if report_errors then if report_errors then
CGMessage1(parser_e_illegal_assignment_to_count_var,tloadnode(hp).symtableentry.realname); CGMessage1(parser_e_illegal_assignment_to_count_var,tloadnode(hp).symtableentry.realname);
mayberesettypeconvs;
exit; exit;
end; end;
{ read-only variable? } { read-only variable? }
if (tabstractvarsym(tloadnode(hp).symtableentry).varspez in [vs_const,vs_constref,vs_final]) then if (tabstractvarsym(tloadnode(hp).symtableentry).varspez in [vs_const,vs_constref,vs_final]) then
begin begin
result:=constaccessok(tabstractvarsym(tloadnode(hp).symtableentry)); result:=constaccessok(tabstractvarsym(tloadnode(hp).symtableentry));
mayberesettypeconvs;
exit; exit;
end; end;
result:=true; result:=true;
mayberesettypeconvs;
exit; exit;
end; end;
procsym : procsym :
@ -1541,6 +1591,7 @@ implementation
else else
if report_errors then if report_errors then
CGMessagePos(hp.fileinfo,type_e_variable_id_expected); CGMessagePos(hp.fileinfo,type_e_variable_id_expected);
mayberesettypeconvs;
exit; exit;
end; end;
labelsym : labelsym :
@ -1550,6 +1601,7 @@ implementation
else else
if report_errors then if report_errors then
CGMessagePos(hp.fileinfo,type_e_variable_id_expected); CGMessagePos(hp.fileinfo,type_e_variable_id_expected);
mayberesettypeconvs;
exit; exit;
end; end;
constsym: constsym:
@ -1560,12 +1612,14 @@ implementation
else else
if report_errors then if report_errors then
CGMessagePos(hp.fileinfo,type_e_variable_id_expected); CGMessagePos(hp.fileinfo,type_e_variable_id_expected);
mayberesettypeconvs;
exit; exit;
end; end;
else else
begin begin
if report_errors then if report_errors then
CGMessagePos(hp.fileinfo,type_e_variable_id_expected); CGMessagePos(hp.fileinfo,type_e_variable_id_expected);
mayberesettypeconvs;
exit; exit;
end; end;
end; end;
@ -1574,10 +1628,12 @@ implementation
begin begin
if report_errors then if report_errors then
CGMessagePos(hp.fileinfo,type_e_variable_id_expected); CGMessagePos(hp.fileinfo,type_e_variable_id_expected);
mayberesettypeconvs;
exit; exit;
end; end;
end; end;
end; end;
mayberesettypeconvs;
end; end;