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

* fixed 'with object do' bug

Browse Source
This commit is contained in:
peter 1998-08-20 21:36:38 +00:00
parent a731c4ac0d
commit 7c8e445400
3 changed files with 524 additions and 493 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

9
compiler/cg386cal.pas
View File

@ -729,6 +729,7 @@ implementation
p^.methodpointer:=genzeronode(callparan); p^.methodpointer:=genzeronode(callparan);
p^.methodpointer^.location.loc:=LOC_REGISTER; p^.methodpointer^.location.loc:=LOC_REGISTER;
p^.methodpointer^.location.register:=R_ESI; p^.methodpointer^.location.register:=R_ESI;
p^.methodpointer^.resulttype:=p^.symtable^.defowner;
{ make a reference } { make a reference }
new(r); new(r);
reset_reference(r^); reset_reference(r^);
@ -871,7 +872,8 @@ implementation
end; end;
{ direct call to class constructor, don't allocate memory } { direct call to class constructor, don't allocate memory }
if is_con_or_destructor and (p^.methodpointer^.resulttype^.deftype=objectdef) and if is_con_or_destructor and
(p^.methodpointer^.resulttype^.deftype=objectdef) and
(pobjectdef(p^.methodpointer^.resulttype)^.isclass) then (pobjectdef(p^.methodpointer^.resulttype)^.isclass) then
exprasmlist^.concat(new(pai386,op_const(A_PUSH,S_L,0))) exprasmlist^.concat(new(pai386,op_const(A_PUSH,S_L,0)))
else else
@ -2314,7 +2316,10 @@ implementation
end. end.
{ {
$Log$ $Log$
Revision 1.17 1998-08-19 16:07:36 jonas Revision 1.18 1998-08-20 21:36:38 peter
* fixed 'with object do' bug
Revision 1.17 1998/08/19 16:07:36 jonas
* changed optimizer switches + cleanup of DestroyRefs in daopt386.pas * changed optimizer switches + cleanup of DestroyRefs in daopt386.pas
Revision 1.16 1998/08/18 09:24:36 pierre Revision 1.16 1998/08/18 09:24:36 pierre

695
compiler/pexpr.pas
View File

@ -647,9 +647,300 @@ unit pexpr;
{**************************************************************************** {****************************************************************************
Factor_read_set Factor
****************************************************************************} ****************************************************************************}
function factor(getaddr : boolean) : ptree;
var
l : longint;
oldp1,
p1,p2,p3 : ptree;
code : word;
pd,pd2 : pdef;
possible_error,
unit_specific,
again : boolean;
sym : pvarsym;
classh : pobjectdef;
d : bestreal;
static_name : string;
propsym : ppropertysym;
filepos : tfileposinfo;
{---------------------------------------------
Factor_read_id
---------------------------------------------}
procedure factor_read_id;
begin
{ allow post fix operators }
again:=true;
if (cs_delphi2_compatible in aktmoduleswitches) and
(pattern='RESULT') and
assigned(aktprocsym) and
(procinfo.retdef<>pdef(voiddef)) then
begin
consume(ID);
p1:=genzeronode(funcretn);
pd:=procinfo.retdef;
{$ifdef TEST_FUNCRET}
p1^.funcretprocinfo:=pointer(@procinfo);
p1^.retdef:=pd;
{$endif TEST_FUNCRET}
end
else
begin
if lastsymknown then
begin
srsym:=lastsrsym;
srsymtable:=lastsrsymtable;
lastsymknown:=false;
end
else
getsym(pattern,true);
consume(ID);
{$ifndef TEST_FUNCRET}
{ is this an access to a function result ? }
if assigned(aktprocsym) and
((srsym^.name=aktprocsym^.name){ or
((pvarsym(srsym)=opsym) and
((procinfo.flags and pi_operator)<>0))}) and
(procinfo.retdef<>pdef(voiddef)) and
(token<>LKLAMMER) and
(not ((cs_tp_compatible in aktmoduleswitches) and
(afterassignment or in_args))) then
begin
p1:=genzeronode(funcretn);
pd:=procinfo.retdef;
end
else
{$else TEST_FUNCRET}
if not is_func_ret(srsym) then
{$endif TEST_FUNCRET}
{ else it's a normal symbol }
begin
{ is it defined like UNIT.SYMBOL ? }
if srsym^.typ=unitsym then
begin
consume(POINT);
getsymonlyin(punitsym(srsym)^.unitsymtable,pattern);
unit_specific:=true;
consume(ID);
end
else
unit_specific:=false;
if not assigned(srsym) then
Begin
p1:=genzeronode(errorn);
{ try to clean up }
pd:=generrordef;
end
else
Begin
{ check semantics of private }
if (srsym^.typ in [propertysym,procsym,varsym]) and
(srsymtable^.symtabletype=objectsymtable) then
begin
if ((srsym^.properties and sp_private)<>0) and
(pobjectdef(srsym^.owner^.defowner)^.owner^.symtabletype=unitsymtable) then
Message(parser_e_cant_access_private_member);
end;
case srsym^.typ of
absolutesym : begin
p1:=genloadnode(pvarsym(srsym),srsymtable);
pd:=pabsolutesym(srsym)^.definition;
end;
varsym : begin
{ are we in a class method ? }
if (srsymtable^.symtabletype=objectsymtable) and
assigned(aktprocsym) and
((aktprocsym^.definition^.options and poclassmethod)<>0) then
Message(parser_e_only_class_methods);
if (srsym^.properties and sp_static)<>0 then
begin
static_name:=lower(srsymtable^.name^)+'_'+srsym^.name;
getsym(static_name,true);
end;
p1:=genloadnode(pvarsym(srsym),srsymtable);
if pvarsym(srsym)^.is_valid=0 then
begin
p1^.is_first := true;
{ set special between first loaded until checked in firstpass }
pvarsym(srsym)^.is_valid:=2;
end;
pd:=pvarsym(srsym)^.definition;
end;
typedconstsym : begin
p1:=gentypedconstloadnode(ptypedconstsym(srsym),srsymtable);
pd:=ptypedconstsym(srsym)^.definition;
end;
syssym : p1:=statement_syssym(psyssym(srsym)^.number,pd);
typesym : begin
pd:=ptypesym(srsym)^.definition;
{ if we read a type declaration }
{ we have to return the type and }
{ nothing else }
if block_type=bt_type then
begin
p1:=genzeronode(typen);
p1^.resulttype:=pd;
pd:=voiddef;
end
else
begin
if token=LKLAMMER then
begin
consume(LKLAMMER);
p1:=comp_expr(true);
consume(RKLAMMER);
p1:=gentypeconvnode(p1,pd);
p1^.explizit:=true;
end
else
if (token=POINT) and
(pd^.deftype=objectdef) and
((pobjectdef(pd)^.options and oois_class)=0) then
begin
consume(POINT);
if assigned(procinfo._class) then
begin
if procinfo._class^.isrelated(pobjectdef(pd)) then
begin
p1:=genzeronode(typen);
p1^.resulttype:=pd;
srsymtable:=pobjectdef(pd)^.publicsyms;
sym:=pvarsym(srsymtable^.search(pattern));
{ search also in inherited methods }
while sym=nil do
begin
pd:=pobjectdef(pd)^.childof;
srsymtable:=pobjectdef(pd)^.publicsyms;
sym:=pvarsym(srsymtable^.search(pattern));
end;
consume(ID);
do_member_read(false,sym,p1,pd,again);
end
else
begin
Message(parser_e_no_super_class);
pd:=generrordef;
again:=false;
end;
end
else
begin
{ allows @TObject.Load }
{ also allows static methods and variables }
p1:=genzeronode(typen);
p1^.resulttype:=pd;
{ srsymtable:=pobjectdef(pd)^.publicsyms;
sym:=pvarsym(srsymtable^.search(pattern)); }
{ TP allows also @TMenu.Load if Load is only }
{ defined in an anchestor class }
sym:=pvarsym(search_class_member(pobjectdef(pd),pattern));
if not(getaddr) and ((sym^.properties and sp_static)=0) then
Message(sym_e_only_static_in_static)
else
begin
consume(ID);
do_member_read(getaddr,sym,p1,pd,again);
end;
end;
end
else
begin
{ class reference ? }
if (pd^.deftype=objectdef)
and ((pobjectdef(pd)^.options and oois_class)<>0) then
begin
p1:=genzeronode(typen);
p1^.resulttype:=pd;
pd:=new(pclassrefdef,init(pd));
p1:=gensinglenode(loadvmtn,p1);
p1^.resulttype:=pd;
end
else
begin
{ generate a type node }
{ (for typeof etc) }
p1:=genzeronode(typen);
p1^.resulttype:=pd;
pd:=voiddef;
end;
end;
end;
end;
enumsym : begin
p1:=genenumnode(penumsym(srsym));
pd:=p1^.resulttype;
end;
constsym : begin
case pconstsym(srsym)^.consttype of
constint : p1:=genordinalconstnode(pconstsym(srsym)^.value,s32bitdef);
conststring : p1:=genstringconstnode(pstring(pconstsym(srsym)^.value)^);
constchar : p1:=genordinalconstnode(pconstsym(srsym)^.value,cchardef);
constreal : p1:=genrealconstnode(pbestreal(pconstsym(srsym)^.value)^);
constbool : p1:=genordinalconstnode(pconstsym(srsym)^.value,booldef);
constseta : p1:=gensetconstruktnode(pconstset(pconstsym(srsym)^.value),
psetdef(pconstsym(srsym)^.definition));
constord : p1:=genordinalconstnode(pconstsym(srsym)^.value,
pconstsym(srsym)^.definition);
end;
pd:=p1^.resulttype;
end;
procsym : begin
{ are we in a class method ? }
possible_error:=(srsymtable^.symtabletype=objectsymtable) and
assigned(aktprocsym) and
((aktprocsym^.definition^.options and poclassmethod)<>0);
p1:=gencallnode(pprocsym(srsym),srsymtable);
p1^.unit_specific:=unit_specific;
do_proc_call(getaddr or
(getprocvar and
proc_to_procvar_equal(getprocvardef,pprocsym(srsym)^.definition)),
again,p1,pd);
if possible_error and
((p1^.procdefinition^.options and poclassmethod)=0) then
Message(parser_e_only_class_methods);
end;
propertysym : begin
{ access to property in a method }
{ are we in a class method ? }
if (srsymtable^.symtabletype=objectsymtable) and
assigned(aktprocsym) and
((aktprocsym^.definition^.options and poclassmethod)<>0) then
Message(parser_e_only_class_methods);
{ no method pointer }
p1:=nil;
handle_propertysym(srsym,p1,pd);
end;
errorsym : begin
p1:=genzeronode(errorn);
pd:=generrordef;
if token=LKLAMMER then
begin
consume(LKLAMMER);
parse_paras(false,false);
consume(RKLAMMER);
end;
end;
else
begin
p1:=genzeronode(errorn);
pd:=generrordef;
Message(cg_e_illegal_expression);
end;
end; { end case }
end;
end;
end;
end;
{---------------------------------------------
Factor_Read_Set
---------------------------------------------}
{ Read a set between [] } { Read a set between [] }
function factor_read_set:ptree; function factor_read_set:ptree;
var var
@ -697,13 +988,10 @@ unit pexpr;
FillChar(constset^,sizeof(constset^),0); FillChar(constset^,sizeof(constset^),0);
constsetlo:=0; constsetlo:=0;
constsethi:=0; constsethi:=0;
constp:=gensinglenode(setconstrn,nil); constp:=gensinglenode(setconstrn,nil);
constp^.constset:=constset; constp^.constset:=constset;
buildp:=constp; buildp:=constp;
pd:=nil; pd:=nil;
if token<>RECKKLAMMER then if token<>RECKKLAMMER then
begin begin
while true do while true do
@ -804,32 +1092,13 @@ unit pexpr;
break; break;
end; end;
end; end;
constp^.resulttype:=new(psetdef,init(pd,constsethi)); constp^.resulttype:=new(psetdef,init(pd,constsethi));
factor_read_set:=buildp; factor_read_set:=buildp;
end; end;
{---------------------------------------------
Helpers
{**************************************************************************** ---------------------------------------------}
Factor
****************************************************************************}
function factor(getaddr : boolean) : ptree;
var
l : longint;
p1,p2,p3 : ptree;
code : word;
pd,pd2 : pdef;
unit_specific, again : boolean;
static_name : string;
sym : pvarsym;
classh : pobjectdef;
d : bestreal;
propsym : ppropertysym;
oldp1 : ptree;
filepos : tfileposinfo;
procedure check_tokenpos; procedure check_tokenpos;
begin begin
@ -842,6 +1111,57 @@ unit pexpr;
end; end;
end; end;
{$ifdef TEST_FUNCRET}
function is_func_ret(sym : psym) : boolean;
var
p : pprocinfo;
storesymtablestack : psymtable;
begin
is_func_ret:=false;
if (sym^.typ<>funcretsym) and ((procinfo.flags and pi_operator)=0) then
exit;
p:=@procinfo;
while assigned(p) do
begin
{ is this an access to a function result ? }
if assigned(p^.funcretsym) and
((sym=p^.funcretsym) or
((pvarsym(sym)=opsym) and
((p^.flags and pi_operator)<>0))) and
(p^.retdef<>pdef(voiddef)) and
(token<>LKLAMMER) and
(not ((cs_tp_compatible in aktmoduleswitches) and
(afterassignment or in_args))) then
begin
p1:=genzeronode(funcretn);
pd:=p^.retdef;
p1^.funcretprocinfo:=p;
p1^.retdef:=pd;
is_func_ret:=true;
exit;
end;
p:=p^.parent;
end;
{ we must use the function call }
if(sym^.typ=funcretsym) then
begin
storesymtablestack:=symtablestack;
symtablestack:=srsymtable^.next;
getsym(sym^.name,true);
if srsym^.typ<>procsym then
Message(cg_e_illegal_expression);
symtablestack:=storesymtablestack;
end;
end;
{$endif TEST_FUNCRET}
{---------------------------------------------
PostFixOperators
---------------------------------------------}
procedure postfixoperators; procedure postfixoperators;
{ p1 and p2 must contain valid values } { p1 and p2 must contain valid values }
begin begin
@ -1062,323 +1382,21 @@ unit pexpr;
end; end;
{$ifdef TEST_FUNCRET} {---------------------------------------------
function is_func_ret(sym : psym) : boolean; Factor (Main)
var ---------------------------------------------}
p : pprocinfo;
storesymtablestack : psymtable;
begin
is_func_ret:=false;
if (sym^.typ<>funcretsym) and ((procinfo.flags and pi_operator)=0) then
exit;
p:=@procinfo;
while assigned(p) do
begin
{ is this an access to a function result ? }
if assigned(p^.funcretsym) and
((sym=p^.funcretsym) or
((pvarsym(sym)=opsym) and
((p^.flags and pi_operator)<>0))) and
(p^.retdef<>pdef(voiddef)) and
(token<>LKLAMMER) and
(not ((cs_tp_compatible in aktmoduleswitches) and
(afterassignment or in_args))) then
begin
p1:=genzeronode(funcretn);
pd:=p^.retdef;
p1^.funcretprocinfo:=p;
p1^.retdef:=pd;
is_func_ret:=true;
exit;
end;
p:=p^.parent;
end;
{ we must use the function call }
if(sym^.typ=funcretsym) then
begin
storesymtablestack:=symtablestack;
symtablestack:=srsymtable^.next;
getsym(sym^.name,true);
if srsym^.typ<>procsym then
Message(cg_e_illegal_expression);
symtablestack:=storesymtablestack;
end;
end;
{$endif TEST_FUNCRET}
var
possible_error : boolean;
begin begin
oldp1:=nil; oldp1:=nil;
filepos:=tokenpos; filepos:=tokenpos;
case token of if token=ID then
ID : begin
{ allow post fix operators }
again:=true;
if (cs_delphi2_compatible in aktmoduleswitches) and
(pattern='RESULT') and
assigned(aktprocsym) and
(procinfo.retdef<>pdef(voiddef)) then
begin begin
consume(ID); factor_read_id;
p1:=genzeronode(funcretn);
pd:=procinfo.retdef;
{$ifdef TEST_FUNCRET}
p1^.funcretprocinfo:=pointer(@procinfo);
p1^.retdef:=pd;
{$endif TEST_FUNCRET}
end
else
begin
if lastsymknown then
begin
srsym:=lastsrsym;
srsymtable:=lastsrsymtable;
lastsymknown:=false;
end
else
getsym(pattern,true);
consume(ID);
{$ifndef TEST_FUNCRET}
{ is this an access to a function result ? }
if assigned(aktprocsym) and
((srsym^.name=aktprocsym^.name){ or
((pvarsym(srsym)=opsym) and
((procinfo.flags and pi_operator)<>0))}) and
(procinfo.retdef<>pdef(voiddef)) and
(token<>LKLAMMER) and
(not ((cs_tp_compatible in aktmoduleswitches) and
(afterassignment or in_args))) then
begin
p1:=genzeronode(funcretn);
pd:=procinfo.retdef;
end
else
{$else TEST_FUNCRET}
if not is_func_ret(srsym) then
{$endif TEST_FUNCRET}
{ else it's a normal symbol }
begin
{ is it defined like UNIT.SYMBOL ? }
if srsym^.typ=unitsym then
begin
consume(POINT);
getsymonlyin(punitsym(srsym)^.unitsymtable,pattern);
unit_specific:=true;
consume(ID);
end
else
unit_specific:=false;
if not assigned(srsym) then
Begin
p1:=genzeronode(errorn);
{ try to clean up }
pd:=generrordef;
end
else
Begin
{ check semantics of private }
if (srsym^.typ in [propertysym,procsym,varsym]) and
(srsymtable^.symtabletype=objectsymtable) then
begin
if ((srsym^.properties and sp_private)<>0) and
(pobjectdef(srsym^.owner^.defowner)^.owner^.symtabletype=unitsymtable) then
Message(parser_e_cant_access_private_member);
end;
case srsym^.typ of
absolutesym : begin
p1:=genloadnode(pvarsym(srsym),srsymtable);
pd:=pabsolutesym(srsym)^.definition;
end;
varsym : begin
{ are we in a class method ? }
if (srsymtable^.symtabletype=objectsymtable) and
assigned(aktprocsym) and
((aktprocsym^.definition^.options and poclassmethod)<>0) then
Message(parser_e_only_class_methods);
if (srsym^.properties and sp_static)<>0 then
begin
static_name:=lower(srsymtable^.name^)+'_'+srsym^.name;
getsym(static_name,true);
end;
p1:=genloadnode(pvarsym(srsym),srsymtable);
if pvarsym(srsym)^.is_valid=0 then
begin
p1^.is_first := true;
{ set special between first loaded until checked in firstpass }
pvarsym(srsym)^.is_valid:=2;
end;
pd:=pvarsym(srsym)^.definition;
end;
typedconstsym : begin
p1:=gentypedconstloadnode(ptypedconstsym(srsym),srsymtable);
pd:=ptypedconstsym(srsym)^.definition;
end;
syssym : p1:=statement_syssym(psyssym(srsym)^.number,pd);
typesym : begin
pd:=ptypesym(srsym)^.definition;
{ if we read a type declaration }
{ we have to return the type and }
{ nothing else }
if block_type=bt_type then
begin
p1:=genzeronode(typen);
p1^.resulttype:=pd;
pd:=voiddef;
end
else
begin
if token=LKLAMMER then
begin
consume(LKLAMMER);
p1:=comp_expr(true);
consume(RKLAMMER);
p1:=gentypeconvnode(p1,pd);
p1^.explizit:=true;
end
else
if (token=POINT) and
(pd^.deftype=objectdef) and
((pobjectdef(pd)^.options and oois_class)=0) then
begin
consume(POINT);
if assigned(procinfo._class) then
begin
if procinfo._class^.isrelated(pobjectdef(pd)) then
begin
p1:=genzeronode(typen);
p1^.resulttype:=pd;
srsymtable:=pobjectdef(pd)^.publicsyms;
sym:=pvarsym(srsymtable^.search(pattern));
{ search also in inherited methods }
while sym=nil do
begin
pd:=pobjectdef(pd)^.childof;
srsymtable:=pobjectdef(pd)^.publicsyms;
sym:=pvarsym(srsymtable^.search(pattern));
end;
consume(ID);
do_member_read(false,sym,p1,pd,again);
end
else
begin
Message(parser_e_no_super_class);
pd:=generrordef;
again:=false;
end;
end
else
begin
{ allows @TObject.Load }
{ also allows static methods and variables }
p1:=genzeronode(typen);
p1^.resulttype:=pd;
{ srsymtable:=pobjectdef(pd)^.publicsyms;
sym:=pvarsym(srsymtable^.search(pattern)); }
{ TP allows also @TMenu.Load if Load is only }
{ defined in an anchestor class }
sym:=pvarsym(search_class_member(pobjectdef(pd),pattern));
if not(getaddr) and ((sym^.properties and sp_static)=0) then
Message(sym_e_only_static_in_static)
else
begin
consume(ID);
do_member_read(getaddr,sym,p1,pd,again);
end;
end;
end
else
begin
{ class reference ? }
if (pd^.deftype=objectdef)
and ((pobjectdef(pd)^.options and oois_class)<>0) then
begin
p1:=genzeronode(typen);
p1^.resulttype:=pd;
pd:=new(pclassrefdef,init(pd));
p1:=gensinglenode(loadvmtn,p1);
p1^.resulttype:=pd;
end
else
begin
{ generate a type node }
{ (for typeof etc) }
p1:=genzeronode(typen);
p1^.resulttype:=pd;
pd:=voiddef;
end;
end;
end;
end;
enumsym : begin
p1:=genenumnode(penumsym(srsym));
pd:=p1^.resulttype;
end;
constsym : begin
case pconstsym(srsym)^.consttype of
constint : p1:=genordinalconstnode(pconstsym(srsym)^.value,s32bitdef);
conststring : p1:=genstringconstnode(pstring(pconstsym(srsym)^.value)^);
constchar : p1:=genordinalconstnode(pconstsym(srsym)^.value,cchardef);
constreal : p1:=genrealconstnode(pbestreal(pconstsym(srsym)^.value)^);
constbool : p1:=genordinalconstnode(pconstsym(srsym)^.value,booldef);
constseta : p1:=gensetconstruktnode(pconstset(pconstsym(srsym)^.value),
psetdef(pconstsym(srsym)^.definition));
constord : p1:=genordinalconstnode(pconstsym(srsym)^.value,
pconstsym(srsym)^.definition);
end;
pd:=p1^.resulttype;
end;
procsym : begin
{ are we in a class method ? }
possible_error:=(srsymtable^.symtabletype=objectsymtable) and
assigned(aktprocsym) and
((aktprocsym^.definition^.options and poclassmethod)<>0);
p1:=gencallnode(pprocsym(srsym),srsymtable);
p1^.unit_specific:=unit_specific;
do_proc_call(getaddr or
(getprocvar and
proc_to_procvar_equal(getprocvardef,pprocsym(srsym)^.definition)),
again,p1,pd);
if possible_error and
((p1^.procdefinition^.options and poclassmethod)=0) then
Message(parser_e_only_class_methods);
end;
propertysym : begin
{ access to property in a method }
{ are we in a class method ? }
if (srsymtable^.symtabletype=objectsymtable) and
assigned(aktprocsym) and
((aktprocsym^.definition^.options and poclassmethod)<>0) then
Message(parser_e_only_class_methods);
{ no method pointer }
p1:=nil;
handle_propertysym(srsym,p1,pd);
end;
errorsym : begin
p1:=genzeronode(errorn);
pd:=generrordef;
if token=LKLAMMER then
begin
consume(LKLAMMER);
parse_paras(false,false);
consume(RKLAMMER);
end;
end;
else
begin
p1:=genzeronode(errorn);
pd:=generrordef;
Message(cg_e_illegal_expression);
end;
end; { end case }
end;
end;
end;
{ handle post fix operators } { handle post fix operators }
postfixoperators; postfixoperators;
end; end
else
case token of
_NEW : begin _NEW : begin
consume(_NEW); consume(_NEW);
consume(LKLAMMER); consume(LKLAMMER);
@ -1855,7 +1873,10 @@ unit pexpr;
end. end.
{ {
$Log$ $Log$
Revision 1.40 1998-08-20 09:26:41 pierre Revision 1.41 1998-08-20 21:36:39 peter
* fixed 'with object do' bug
Revision 1.40 1998/08/20 09:26:41 pierre
+ funcret setting in underproc testing + funcret setting in underproc testing
compile with _dTEST_FUNCRET compile with _dTEST_FUNCRET

7
compiler/pstatmnt.pas
View File

@ -366,6 +366,7 @@ unit pstatmnt;
withsymtable:=new(psymtable,init(symtable.withsymtable)); withsymtable:=new(psymtable,init(symtable.withsymtable));
withsymtable^.root:=obj^.publicsyms^.root; withsymtable^.root:=obj^.publicsyms^.root;
withsymtable^.defowner:=obj;
symtab:=withsymtable; symtab:=withsymtable;
levelcount:=1; levelcount:=1;
obj:=obj^.childof; obj:=obj^.childof;
@ -386,6 +387,7 @@ unit pstatmnt;
withsymtable:=new(psymtable,init(symtable.withsymtable)); withsymtable:=new(psymtable,init(symtable.withsymtable));
withsymtable^.root:=symtab^.root; withsymtable^.root:=symtab^.root;
withsymtable^.next:=symtablestack; withsymtable^.next:=symtablestack;
withsymtable^.defowner:=obj;
symtablestack:=withsymtable; symtablestack:=withsymtable;
end; end;
else else
@ -1236,7 +1238,10 @@ unit pstatmnt;
end. end.
{ {
$Log$ $Log$
Revision 1.35 1998-08-20 09:26:42 pierre Revision 1.36 1998-08-20 21:36:41 peter
* fixed 'with object do' bug
Revision 1.35 1998/08/20 09:26:42 pierre
+ funcret setting in underproc testing + funcret setting in underproc testing
compile with _dTEST_FUNCRET compile with _dTEST_FUNCRET