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

* fixed tp procvar support in parameters of a called procvar

Browse Source 
* typenode cleanup, no special handling needed anymore for bt_type
This commit is contained in:
peter 2001-06-04 18:16:42 +00:00
parent f548f896a0
commit d7eb8e1e6b
1 changed files with 88 additions and 92 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

180
compiler/pexpr.pas
View File

@ -142,6 +142,7 @@ implementation
var var
p1,p2 : tnode; p1,p2 : tnode;
end_of_paras : ttoken; end_of_paras : ttoken;
prev_in_args : boolean;
old_allow_array_constructor : boolean; old_allow_array_constructor : boolean;
begin begin
if in_prop_paras then if in_prop_paras then
@ -153,10 +154,14 @@ implementation
parse_paras:=nil; parse_paras:=nil;
exit; exit;
end; end;
p2:=nil; { save old values }
inc(parsing_para_level); prev_in_args:=in_args;
old_allow_array_constructor:=allow_array_constructor; old_allow_array_constructor:=allow_array_constructor;
{ set para parsing values }
in_args:=true;
inc(parsing_para_level);
allow_array_constructor:=true; allow_array_constructor:=true;
p2:=nil;
while true do while true do
begin begin
p1:=comp_expr(true); p1:=comp_expr(true);
@ -183,6 +188,7 @@ implementation
end; end;
allow_array_constructor:=old_allow_array_constructor; allow_array_constructor:=old_allow_array_constructor;
dec(parsing_para_level); dec(parsing_para_level);
in_args:=prev_in_args;
parse_paras:=p2; parse_paras:=p2;
end; end;
@ -245,6 +251,8 @@ implementation
in_args:=true; in_args:=true;
p1:=comp_expr(true); p1:=comp_expr(true);
consume(_RKLAMMER); consume(_RKLAMMER);
if p1.nodetype=typen then
ttypenode(p1).allowed:=true;
if p1.resulttype.def.deftype=objectdef then if p1.resulttype.def.deftype=objectdef then
statement_syssym:=geninlinenode(in_typeof_x,false,p1) statement_syssym:=geninlinenode(in_typeof_x,false,p1)
else else
@ -552,13 +560,11 @@ implementation
{ reads the parameter for a subroutine call } { reads the parameter for a subroutine call }
procedure do_proc_call(sym:tsym;st:tsymtable;getaddr:boolean;var again : boolean;var p1:tnode); procedure do_proc_call(sym:tsym;st:tsymtable;getaddr:boolean;var again : boolean;var p1:tnode);
var var
prev_in_args : boolean;
prevafterassn : boolean; prevafterassn : boolean;
hs,hs1 : tvarsym; hs,hs1 : tvarsym;
para,p2 : tnode; para,p2 : tnode;
hst : tsymtable; hst : tsymtable;
begin begin
prev_in_args:=in_args;
prevafterassn:=afterassignment; prevafterassn:=afterassignment;
afterassignment:=false; afterassignment:=false;
{ want we only determine the address of } { want we only determine the address of }
@ -595,7 +601,6 @@ implementation
if token=_LKLAMMER then if token=_LKLAMMER then
begin begin
consume(_LKLAMMER); consume(_LKLAMMER);
in_args:=true;
para:=parse_paras(false,false); para:=parse_paras(false,false);
consume(_RKLAMMER); consume(_RKLAMMER);
end end
@ -632,7 +637,6 @@ implementation
{ no postfix operators } { no postfix operators }
again:=false; again:=false;
end; end;
in_args:=prev_in_args;
afterassignment:=prevafterassn; afterassignment:=prevafterassn;
end; end;
@ -1043,101 +1047,95 @@ implementation
end end
else else
begin begin
{ if we read a type declaration } if token=_LKLAMMER then
{ we have to return the type and }
{ nothing else }
if block_type=bt_type then
begin begin
p1:=ctypenode.create(htype); consume(_LKLAMMER);
p1:=comp_expr(true);
consume(_RKLAMMER);
p1:=ctypeconvnode.create(p1,htype);
include(p1.flags,nf_explizit);
end end
else { not type block } else { not LKLAMMER }
begin if (token=_POINT) and
if token=_LKLAMMER then is_object(htype.def) then
begin begin
consume(_LKLAMMER); consume(_POINT);
p1:=comp_expr(true); if assigned(procinfo) and
consume(_RKLAMMER); assigned(procinfo^._class) and
p1:=ctypeconvnode.create(p1,htype); not(getaddr) then
include(p1.flags,nf_explizit);
end
else { not LKLAMMER }
if (token=_POINT) and
is_object(htype.def) then
begin begin
consume(_POINT); if procinfo^._class.is_related(tobjectdef(htype.def)) then
if assigned(procinfo) and
assigned(procinfo^._class) and
not(getaddr) then
begin begin
if procinfo^._class.is_related(tobjectdef(htype.def)) then p1:=ctypenode.create(htype);
begin { search also in inherited methods }
p1:=nil; repeat
{ search also in inherited methods } srsym:=tvarsym(tobjectdef(htype.def).symtable.search(pattern));
repeat if assigned(srsym) then
srsym:=tvarsym(tobjectdef(htype.def).symtable.search(pattern)); break;
if assigned(srsym) then htype.def:=tobjectdef(htype.def).childof;
break; until not assigned(htype.def);
htype.def:=tobjectdef(htype.def).childof; consume(_ID);
until not assigned(htype.def); do_member_read(false,srsym,p1,again);
consume(_ID);
do_member_read(false,srsym,p1,again);
end
else
begin
Message(parser_e_no_super_class);
again:=false;
end;
end end
else else
begin begin
{ allows @TObject.Load } Message(parser_e_no_super_class);
{ also allows static methods and variables } again:=false;
p1:=nil;
{ TP allows also @TMenu.Load if Load is only }
{ defined in an anchestor class }
srsym:=tvarsym(search_class_member(tobjectdef(htype.def),pattern));
if not assigned(srsym) then
Message1(sym_e_id_no_member,pattern)
else if not(getaddr) and not(sp_static in srsym.symoptions) then
Message(sym_e_only_static_in_static)
else
begin
consume(_ID);
do_member_read(getaddr,srsym,p1,again);
end;
end; end;
end end
else else
begin
{ allows @TObject.Load }
{ also allows static methods and variables }
p1:=ctypenode.create(htype);
{ TP allows also @TMenu.Load if Load is only }
{ defined in an anchestor class }
srsym:=tvarsym(search_class_member(tobjectdef(htype.def),pattern));
if not assigned(srsym) then
Message1(sym_e_id_no_member,pattern)
else if not(getaddr) and not(sp_static in srsym.symoptions) then
Message(sym_e_only_static_in_static)
else
begin
consume(_ID);
do_member_read(getaddr,srsym,p1,again);
end;
end;
end
else
begin
{ class reference ? }
if is_class(htype.def) then
begin begin
{ class reference ? } if getaddr and (token=_POINT) then
if is_class(htype.def) then
begin begin
if getaddr and (token=_POINT) then consume(_POINT);
begin { allows @Object.Method }
consume(_POINT); { also allows static methods and variables }
{ allows @Object.Method } p1:=ctypenode.create(htype);
{ also allows static methods and variables } { TP allows also @TMenu.Load if Load is only }
p1:=ctypenode.create(htype); { defined in an anchestor class }
{ TP allows also @TMenu.Load if Load is only } srsym:=tvarsym(search_class_member(tobjectdef(htype.def),pattern));
{ defined in an anchestor class } if not assigned(srsym) then
srsym:=tvarsym(search_class_member(tobjectdef(htype.def),pattern)); Message1(sym_e_id_no_member,pattern)
if not assigned(srsym) then
Message1(sym_e_id_no_member,pattern)
else
begin
consume(_ID);
do_member_read(getaddr,srsym,p1,again);
end;
end
else else
begin begin
p1:=ctypenode.create(htype); consume(_ID);
p1:=cloadvmtnode.create(p1); do_member_read(getaddr,srsym,p1,again);
end; end;
end end
else else
p1:=ctypenode.create(htype); begin
end; p1:=ctypenode.create(htype);
{ For a type block we simply return only
the type. For all other blocks we return
a loadvmt node }
if (block_type<>bt_type) then
p1:=cloadvmtnode.create(p1);
end;
end
else
p1:=ctypenode.create(htype);
end; end;
end; end;
end; end;
@ -2198,7 +2196,6 @@ implementation
p1,p2 : tnode; p1,p2 : tnode;
oldafterassignment : boolean; oldafterassignment : boolean;
oldp1 : tnode; oldp1 : tnode;
oldblock_type : tblock_type;
filepos : tfileposinfo; filepos : tfileposinfo;
begin begin
@ -2218,12 +2215,7 @@ implementation
_POINTPOINT : _POINTPOINT :
begin begin
consume(_POINTPOINT); consume(_POINTPOINT);
{ we are now parsing a const so switch the
blocksize. This is delphi compatible }
oldblock_type:=block_type;
block_type:=bt_const;
p2:=sub_expr(opcompare,true); p2:=sub_expr(opcompare,true);
block_type:=oldblock_type;
p1:=crangenode.create(p1,p2); p1:=crangenode.create(p1,p2);
end; end;
_ASSIGNMENT : _ASSIGNMENT :
@ -2321,7 +2313,11 @@ implementation
end. end.
{ {
$Log$ $Log$
Revision 1.35 2001-06-04 11:45:35 peter Revision 1.36 2001-06-04 18:16:42 peter
* fixed tp procvar support in parameters of a called procvar
* typenode cleanup, no special handling needed anymore for bt_type
Revision 1.35 2001/06/04 11:45:35 peter
* parse const after .. using bt_const block to allow expressions, this * parse const after .. using bt_const block to allow expressions, this
is Delphi compatible is Delphi compatible