mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-08-28 21:20:29 +02:00
* fixed 'with object do' bug
This commit is contained in:
peter
parent
a731c4ac0d
commit
7c8e445400
@ -729,6 +729,7 @@ implementation
|
||||
p^.methodpointer:=genzeronode(callparan);
|
||||
p^.methodpointer^.location.loc:=LOC_REGISTER;
|
||||
p^.methodpointer^.location.register:=R_ESI;
|
||||
p^.methodpointer^.resulttype:=p^.symtable^.defowner;
|
||||
{ make a reference }
|
||||
new(r);
|
||||
reset_reference(r^);
|
||||
@ -871,7 +872,8 @@ implementation
|
||||
end;
|
||||
|
||||
{ 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
|
||||
exprasmlist^.concat(new(pai386,op_const(A_PUSH,S_L,0)))
|
||||
else
|
||||
@ -2314,7 +2316,10 @@ implementation
|
||||
end.
|
||||
{
|
||||
$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
|
||||
|
||||
Revision 1.16 1998/08/18 09:24:36 pierre
|
||||
|
||||
@ -646,172 +646,6 @@ unit pexpr;
|
||||
end;
|
||||
|
||||
|
||||
{****************************************************************************
|
||||
Factor_read_set
|
||||
****************************************************************************}
|
||||
|
||||
{ Read a set between [] }
|
||||
function factor_read_set:ptree;
|
||||
var
|
||||
constp,
|
||||
buildp,
|
||||
p2,p3,p4 : ptree;
|
||||
pd : pdef;
|
||||
constset : pconstset;
|
||||
constsetlo,
|
||||
constsethi : longint;
|
||||
|
||||
procedure update_constsethi(p:pdef);
|
||||
begin
|
||||
if ((p^.deftype=orddef) and
|
||||
(porddef(p)^.high>constsethi)) then
|
||||
constsethi:=porddef(p)^.high
|
||||
else
|
||||
if ((p^.deftype=enumdef) and
|
||||
(penumdef(p)^.max>constsethi)) then
|
||||
constsethi:=penumdef(p)^.max;
|
||||
end;
|
||||
|
||||
procedure do_set(pos : longint);
|
||||
var
|
||||
mask,l : longint;
|
||||
begin
|
||||
if (pos>255) or (pos<0) then
|
||||
Message(parser_e_illegal_set_expr);
|
||||
if pos>constsethi then
|
||||
constsethi:=pos;
|
||||
if pos<constsetlo then
|
||||
constsetlo:=pos;
|
||||
l:=pos shr 3;
|
||||
mask:=1 shl (pos mod 8);
|
||||
{ do we allow the same twice }
|
||||
if (constset^[l] and mask)<>0 then
|
||||
Message(parser_e_illegal_set_expr);
|
||||
constset^[l]:=constset^[l] or mask;
|
||||
end;
|
||||
|
||||
var
|
||||
l : longint;
|
||||
begin
|
||||
new(constset);
|
||||
FillChar(constset^,sizeof(constset^),0);
|
||||
constsetlo:=0;
|
||||
constsethi:=0;
|
||||
|
||||
constp:=gensinglenode(setconstrn,nil);
|
||||
constp^.constset:=constset;
|
||||
|
||||
buildp:=constp;
|
||||
pd:=nil;
|
||||
|
||||
if token<>RECKKLAMMER then
|
||||
begin
|
||||
while true do
|
||||
begin
|
||||
p4:=nil; { will contain the tree to create the set }
|
||||
p2:=comp_expr(true);
|
||||
do_firstpass(p2);
|
||||
if codegenerror then
|
||||
break;
|
||||
case p2^.resulttype^.deftype of
|
||||
enumdef,
|
||||
orddef : begin
|
||||
if (p2^.resulttype^.deftype=orddef) and
|
||||
(porddef(p2^.resulttype)^.typ in [s8bit,s16bit,s32bit,u16bit,u32bit]) then
|
||||
begin
|
||||
p2:=gentypeconvnode(p2,u8bitdef);
|
||||
do_firstpass(p2);
|
||||
end;
|
||||
{ set settype result }
|
||||
if pd=nil then
|
||||
pd:=p2^.resulttype;
|
||||
if not(is_equal(pd,p2^.resulttype)) then
|
||||
begin
|
||||
Message(parser_e_typeconflict_in_set);
|
||||
disposetree(p2);
|
||||
end
|
||||
else
|
||||
begin
|
||||
if token=POINTPOINT then
|
||||
begin
|
||||
consume(POINTPOINT);
|
||||
p3:=comp_expr(true);
|
||||
do_firstpass(p3);
|
||||
if codegenerror then
|
||||
break;
|
||||
if (p3^.resulttype^.deftype=orddef) and
|
||||
(porddef(p3^.resulttype)^.typ in [s8bit,s16bit,s32bit,u16bit,u32bit]) then
|
||||
begin
|
||||
p3:=gentypeconvnode(p3,u8bitdef);
|
||||
do_firstpass(p3);
|
||||
end;
|
||||
if not(is_equal(pd,p3^.resulttype)) then
|
||||
Message(parser_e_typeconflict_in_set)
|
||||
else
|
||||
begin
|
||||
if (p2^.treetype=ordconstn) and (p3^.treetype=ordconstn) then
|
||||
begin
|
||||
for l:=p2^.value to p3^.value do
|
||||
do_set(l);
|
||||
disposetree(p3);
|
||||
disposetree(p2);
|
||||
end
|
||||
else
|
||||
begin
|
||||
update_constsethi(p3^.resulttype);
|
||||
p4:=gennode(rangen,p2,p3);
|
||||
end;
|
||||
end;
|
||||
end
|
||||
else
|
||||
begin
|
||||
{ Single value }
|
||||
if p2^.treetype=ordconstn then
|
||||
begin
|
||||
do_set(p2^.value);
|
||||
disposetree(p2);
|
||||
end
|
||||
else
|
||||
begin
|
||||
update_constsethi(p2^.resulttype);
|
||||
p4:=gensinglenode(setelen,p2);
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
stringdef : begin
|
||||
if pd=nil then
|
||||
pd:=cchardef;
|
||||
if not(is_equal(pd,cchardef)) then
|
||||
Message(parser_e_typeconflict_in_set)
|
||||
else
|
||||
for l:=1 to length(pstring(p2^.values)^) do
|
||||
do_set(ord(pstring(p2^.values)^[l]));
|
||||
disposetree(p2);
|
||||
end;
|
||||
else
|
||||
Internalerror(4234);
|
||||
end;
|
||||
{ insert the set creation tree }
|
||||
if assigned(p4) then
|
||||
begin
|
||||
buildp:=gennode(addn,buildp,p4);
|
||||
end;
|
||||
{ there could be more elements }
|
||||
if token=COMMA then
|
||||
consume(COMMA)
|
||||
else
|
||||
break;
|
||||
end;
|
||||
end;
|
||||
|
||||
constp^.resulttype:=new(psetdef,init(pd,constsethi));
|
||||
|
||||
factor_read_set:=buildp;
|
||||
end;
|
||||
|
||||
|
||||
|
||||
{****************************************************************************
|
||||
Factor
|
||||
****************************************************************************}
|
||||
@ -819,301 +653,26 @@ unit pexpr;
|
||||
function factor(getaddr : boolean) : ptree;
|
||||
var
|
||||
l : longint;
|
||||
oldp1,
|
||||
p1,p2,p3 : ptree;
|
||||
code : word;
|
||||
pd,pd2 : pdef;
|
||||
unit_specific, again : boolean;
|
||||
static_name : string;
|
||||
possible_error,
|
||||
unit_specific,
|
||||
again : boolean;
|
||||
sym : pvarsym;
|
||||
classh : pobjectdef;
|
||||
d : bestreal;
|
||||
static_name : string;
|
||||
propsym : ppropertysym;
|
||||
oldp1 : ptree;
|
||||
filepos : tfileposinfo;
|
||||
|
||||
procedure check_tokenpos;
|
||||
begin
|
||||
if (p1<>oldp1) then
|
||||
begin
|
||||
if assigned(p1) then
|
||||
set_tree_filepos(p1,filepos);
|
||||
oldp1:=p1;
|
||||
filepos:=tokenpos;
|
||||
end;
|
||||
end;
|
||||
{---------------------------------------------
|
||||
Factor_read_id
|
||||
---------------------------------------------}
|
||||
|
||||
procedure postfixoperators;
|
||||
{ p1 and p2 must contain valid values }
|
||||
procedure factor_read_id;
|
||||
begin
|
||||
check_tokenpos;
|
||||
while again do
|
||||
begin
|
||||
case token of
|
||||
CARET : begin
|
||||
consume(CARET);
|
||||
if pd^.deftype<>pointerdef then
|
||||
begin
|
||||
{ ^ as binary operator is a problem!!!! (FK) }
|
||||
again:=false;
|
||||
Message(cg_e_invalid_qualifier);
|
||||
disposetree(p1);
|
||||
p1:=genzeronode(errorn);
|
||||
end
|
||||
else
|
||||
begin
|
||||
p1:=gensinglenode(derefn,p1);
|
||||
pd:=ppointerdef(pd)^.definition;
|
||||
end;
|
||||
end;
|
||||
LECKKLAMMER : begin
|
||||
if (pd^.deftype=objectdef) and pobjectdef(pd)^.isclass then
|
||||
begin
|
||||
{ default property }
|
||||
propsym:=search_default_property(pobjectdef(pd));
|
||||
if not(assigned(propsym)) then
|
||||
begin
|
||||
disposetree(p1);
|
||||
p1:=genzeronode(errorn);
|
||||
again:=false;
|
||||
message(parser_e_no_default_property_available);
|
||||
end
|
||||
else
|
||||
begin
|
||||
p1:=nil;
|
||||
handle_propertysym(propsym,p1,pd);
|
||||
end;
|
||||
end
|
||||
else
|
||||
begin
|
||||
consume(LECKKLAMMER);
|
||||
repeat
|
||||
case pd^.deftype of
|
||||
pointerdef : begin
|
||||
p2:=comp_expr(true);
|
||||
p1:=gennode(vecn,p1,p2);
|
||||
pd:=ppointerdef(pd)^.definition;
|
||||
end;
|
||||
stringdef : begin
|
||||
p2:=comp_expr(true);
|
||||
p1:=gennode(vecn,p1,p2);
|
||||
pd:=cchardef
|
||||
end;
|
||||
arraydef : begin
|
||||
p2:=comp_expr(true);
|
||||
{$ifdef i386}
|
||||
{ support SEG:OFS for go32v2 Mem[] }
|
||||
if (target_info.target=target_GO32V2) and
|
||||
(p1^.treetype=loadn) and
|
||||
assigned(p1^.symtableentry) and
|
||||
assigned(p1^.symtableentry^.owner^.name) and
|
||||
(p1^.symtableentry^.owner^.name^='SYSTEM') and
|
||||
((p1^.symtableentry^.name='MEM') or
|
||||
(p1^.symtableentry^.name='MEMW') or
|
||||
(p1^.symtableentry^.name='MEML')) then
|
||||
begin
|
||||
if (token=COLON) then
|
||||
begin
|
||||
consume(COLON);
|
||||
p3:=gennode(muln,genordinalconstnode($10,s32bitdef),p2);
|
||||
p2:=comp_expr(true);
|
||||
p2:=gennode(addn,p2,p3);
|
||||
p1:=gennode(vecn,p1,p2);
|
||||
p1^.memseg:=true;
|
||||
p1^.memindex:=true;
|
||||
end
|
||||
else
|
||||
begin
|
||||
p1:=gennode(vecn,p1,p2);
|
||||
p1^.memindex:=true;
|
||||
end;
|
||||
end
|
||||
else
|
||||
{$endif}
|
||||
p1:=gennode(vecn,p1,p2);
|
||||
pd:=parraydef(pd)^.definition;
|
||||
end;
|
||||
else
|
||||
begin
|
||||
Message(cg_e_invalid_qualifier);
|
||||
disposetree(p1);
|
||||
p1:=genzeronode(errorn);
|
||||
again:=false;
|
||||
end;
|
||||
end;
|
||||
if token=COMMA then
|
||||
consume(COMMA)
|
||||
else
|
||||
break;
|
||||
until false;
|
||||
consume(RECKKLAMMER);
|
||||
end;
|
||||
end;
|
||||
POINT : begin
|
||||
consume(POINT);
|
||||
case pd^.deftype of
|
||||
recorddef : begin
|
||||
sym:=pvarsym(precdef(pd)^.symtable^.search(pattern));
|
||||
consume(ID);
|
||||
if sym=nil then
|
||||
begin
|
||||
Message(sym_e_illegal_field);
|
||||
disposetree(p1);
|
||||
p1:=genzeronode(errorn);
|
||||
end
|
||||
else
|
||||
begin
|
||||
p1:=gensubscriptnode(sym,p1);
|
||||
pd:=sym^.definition;
|
||||
end;
|
||||
end;
|
||||
classrefdef : begin
|
||||
classh:=pobjectdef(pclassrefdef(pd)^.definition);
|
||||
sym:=nil;
|
||||
while assigned(classh) do
|
||||
begin
|
||||
sym:=pvarsym(classh^.publicsyms^.search(pattern));
|
||||
srsymtable:=classh^.publicsyms;
|
||||
if assigned(sym) then
|
||||
break;
|
||||
classh:=classh^.childof;
|
||||
end;
|
||||
consume(ID);
|
||||
do_member_read(false,sym,p1,pd,again);
|
||||
end;
|
||||
objectdef : begin
|
||||
classh:=pobjectdef(pd);
|
||||
sym:=nil;
|
||||
while assigned(classh) do
|
||||
begin
|
||||
sym:=pvarsym(classh^.publicsyms^.search(pattern));
|
||||
srsymtable:=classh^.publicsyms;
|
||||
if assigned(sym) then
|
||||
break;
|
||||
classh:=classh^.childof;
|
||||
end;
|
||||
consume(ID);
|
||||
do_member_read(false,sym,p1,pd,again);
|
||||
end;
|
||||
pointerdef : begin
|
||||
Message(cg_e_invalid_qualifier);
|
||||
if ppointerdef(pd)^.definition^.deftype in [recorddef,objectdef,classrefdef] then
|
||||
Message(parser_h_maybe_deref_caret_missing);
|
||||
end;
|
||||
else
|
||||
begin
|
||||
Message(cg_e_invalid_qualifier);
|
||||
disposetree(p1);
|
||||
p1:=genzeronode(errorn);
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
else
|
||||
begin
|
||||
{ is this a procedure variable ? }
|
||||
if assigned(pd) then
|
||||
begin
|
||||
if (pd^.deftype=procvardef) then
|
||||
begin
|
||||
if getprocvar and proc_to_procvar_equal(pprocvardef(pd),getprocvardef) then
|
||||
again:=false
|
||||
else
|
||||
if (token=LKLAMMER) or
|
||||
((pprocvardef(pd)^.para1=nil) and
|
||||
(not((token in [ASSIGNMENT,UNEQUAL,EQUAL]))) and
|
||||
(not afterassignment) and
|
||||
(not in_args)) then
|
||||
begin
|
||||
{ do this in a strange way }
|
||||
{ it's not a clean solution }
|
||||
p2:=p1;
|
||||
p1:=gencallnode(nil,nil);
|
||||
p1^.right:=p2;
|
||||
p1^.unit_specific:=unit_specific;
|
||||
p1^.symtableprocentry:=sym;
|
||||
if token=LKLAMMER then
|
||||
begin
|
||||
consume(LKLAMMER);
|
||||
p1^.left:=parse_paras(false,false);
|
||||
consume(RKLAMMER);
|
||||
end;
|
||||
pd:=pprocvardef(pd)^.retdef;
|
||||
{ proc():= is never possible }
|
||||
if token=ASSIGNMENT then
|
||||
begin
|
||||
Message(cg_e_illegal_expression);
|
||||
p1:=genzeronode(errorn);
|
||||
again:=false;
|
||||
end;
|
||||
p1^.resulttype:=pd;
|
||||
end
|
||||
else
|
||||
again:=false;
|
||||
p1^.resulttype:=pd;
|
||||
end
|
||||
else
|
||||
again:=false;
|
||||
end
|
||||
else
|
||||
again:=false;
|
||||
end;
|
||||
end;
|
||||
check_tokenpos;
|
||||
end; { while again }
|
||||
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}
|
||||
|
||||
var
|
||||
possible_error : boolean;
|
||||
begin
|
||||
oldp1:=nil;
|
||||
filepos:=tokenpos;
|
||||
case token of
|
||||
ID : begin
|
||||
{ allow post fix operators }
|
||||
again:=true;
|
||||
if (cs_delphi2_compatible in aktmoduleswitches) and
|
||||
@ -1376,9 +935,468 @@ unit pexpr;
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
|
||||
{---------------------------------------------
|
||||
Factor_Read_Set
|
||||
---------------------------------------------}
|
||||
|
||||
{ Read a set between [] }
|
||||
function factor_read_set:ptree;
|
||||
var
|
||||
constp,
|
||||
buildp,
|
||||
p2,p3,p4 : ptree;
|
||||
pd : pdef;
|
||||
constset : pconstset;
|
||||
constsetlo,
|
||||
constsethi : longint;
|
||||
|
||||
procedure update_constsethi(p:pdef);
|
||||
begin
|
||||
if ((p^.deftype=orddef) and
|
||||
(porddef(p)^.high>constsethi)) then
|
||||
constsethi:=porddef(p)^.high
|
||||
else
|
||||
if ((p^.deftype=enumdef) and
|
||||
(penumdef(p)^.max>constsethi)) then
|
||||
constsethi:=penumdef(p)^.max;
|
||||
end;
|
||||
|
||||
procedure do_set(pos : longint);
|
||||
var
|
||||
mask,l : longint;
|
||||
begin
|
||||
if (pos>255) or (pos<0) then
|
||||
Message(parser_e_illegal_set_expr);
|
||||
if pos>constsethi then
|
||||
constsethi:=pos;
|
||||
if pos<constsetlo then
|
||||
constsetlo:=pos;
|
||||
l:=pos shr 3;
|
||||
mask:=1 shl (pos mod 8);
|
||||
{ do we allow the same twice }
|
||||
if (constset^[l] and mask)<>0 then
|
||||
Message(parser_e_illegal_set_expr);
|
||||
constset^[l]:=constset^[l] or mask;
|
||||
end;
|
||||
|
||||
var
|
||||
l : longint;
|
||||
begin
|
||||
new(constset);
|
||||
FillChar(constset^,sizeof(constset^),0);
|
||||
constsetlo:=0;
|
||||
constsethi:=0;
|
||||
constp:=gensinglenode(setconstrn,nil);
|
||||
constp^.constset:=constset;
|
||||
buildp:=constp;
|
||||
pd:=nil;
|
||||
if token<>RECKKLAMMER then
|
||||
begin
|
||||
while true do
|
||||
begin
|
||||
p4:=nil; { will contain the tree to create the set }
|
||||
p2:=comp_expr(true);
|
||||
do_firstpass(p2);
|
||||
if codegenerror then
|
||||
break;
|
||||
case p2^.resulttype^.deftype of
|
||||
enumdef,
|
||||
orddef : begin
|
||||
if (p2^.resulttype^.deftype=orddef) and
|
||||
(porddef(p2^.resulttype)^.typ in [s8bit,s16bit,s32bit,u16bit,u32bit]) then
|
||||
begin
|
||||
p2:=gentypeconvnode(p2,u8bitdef);
|
||||
do_firstpass(p2);
|
||||
end;
|
||||
{ set settype result }
|
||||
if pd=nil then
|
||||
pd:=p2^.resulttype;
|
||||
if not(is_equal(pd,p2^.resulttype)) then
|
||||
begin
|
||||
Message(parser_e_typeconflict_in_set);
|
||||
disposetree(p2);
|
||||
end
|
||||
else
|
||||
begin
|
||||
if token=POINTPOINT then
|
||||
begin
|
||||
consume(POINTPOINT);
|
||||
p3:=comp_expr(true);
|
||||
do_firstpass(p3);
|
||||
if codegenerror then
|
||||
break;
|
||||
if (p3^.resulttype^.deftype=orddef) and
|
||||
(porddef(p3^.resulttype)^.typ in [s8bit,s16bit,s32bit,u16bit,u32bit]) then
|
||||
begin
|
||||
p3:=gentypeconvnode(p3,u8bitdef);
|
||||
do_firstpass(p3);
|
||||
end;
|
||||
if not(is_equal(pd,p3^.resulttype)) then
|
||||
Message(parser_e_typeconflict_in_set)
|
||||
else
|
||||
begin
|
||||
if (p2^.treetype=ordconstn) and (p3^.treetype=ordconstn) then
|
||||
begin
|
||||
for l:=p2^.value to p3^.value do
|
||||
do_set(l);
|
||||
disposetree(p3);
|
||||
disposetree(p2);
|
||||
end
|
||||
else
|
||||
begin
|
||||
update_constsethi(p3^.resulttype);
|
||||
p4:=gennode(rangen,p2,p3);
|
||||
end;
|
||||
end;
|
||||
end
|
||||
else
|
||||
begin
|
||||
{ Single value }
|
||||
if p2^.treetype=ordconstn then
|
||||
begin
|
||||
do_set(p2^.value);
|
||||
disposetree(p2);
|
||||
end
|
||||
else
|
||||
begin
|
||||
update_constsethi(p2^.resulttype);
|
||||
p4:=gensinglenode(setelen,p2);
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
stringdef : begin
|
||||
if pd=nil then
|
||||
pd:=cchardef;
|
||||
if not(is_equal(pd,cchardef)) then
|
||||
Message(parser_e_typeconflict_in_set)
|
||||
else
|
||||
for l:=1 to length(pstring(p2^.values)^) do
|
||||
do_set(ord(pstring(p2^.values)^[l]));
|
||||
disposetree(p2);
|
||||
end;
|
||||
else
|
||||
Internalerror(4234);
|
||||
end;
|
||||
{ insert the set creation tree }
|
||||
if assigned(p4) then
|
||||
begin
|
||||
buildp:=gennode(addn,buildp,p4);
|
||||
end;
|
||||
{ there could be more elements }
|
||||
if token=COMMA then
|
||||
consume(COMMA)
|
||||
else
|
||||
break;
|
||||
end;
|
||||
end;
|
||||
constp^.resulttype:=new(psetdef,init(pd,constsethi));
|
||||
factor_read_set:=buildp;
|
||||
end;
|
||||
|
||||
{---------------------------------------------
|
||||
Helpers
|
||||
---------------------------------------------}
|
||||
|
||||
procedure check_tokenpos;
|
||||
begin
|
||||
if (p1<>oldp1) then
|
||||
begin
|
||||
if assigned(p1) then
|
||||
set_tree_filepos(p1,filepos);
|
||||
oldp1:=p1;
|
||||
filepos:=tokenpos;
|
||||
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;
|
||||
{ p1 and p2 must contain valid values }
|
||||
begin
|
||||
check_tokenpos;
|
||||
while again do
|
||||
begin
|
||||
case token of
|
||||
CARET : begin
|
||||
consume(CARET);
|
||||
if pd^.deftype<>pointerdef then
|
||||
begin
|
||||
{ ^ as binary operator is a problem!!!! (FK) }
|
||||
again:=false;
|
||||
Message(cg_e_invalid_qualifier);
|
||||
disposetree(p1);
|
||||
p1:=genzeronode(errorn);
|
||||
end
|
||||
else
|
||||
begin
|
||||
p1:=gensinglenode(derefn,p1);
|
||||
pd:=ppointerdef(pd)^.definition;
|
||||
end;
|
||||
end;
|
||||
LECKKLAMMER : begin
|
||||
if (pd^.deftype=objectdef) and pobjectdef(pd)^.isclass then
|
||||
begin
|
||||
{ default property }
|
||||
propsym:=search_default_property(pobjectdef(pd));
|
||||
if not(assigned(propsym)) then
|
||||
begin
|
||||
disposetree(p1);
|
||||
p1:=genzeronode(errorn);
|
||||
again:=false;
|
||||
message(parser_e_no_default_property_available);
|
||||
end
|
||||
else
|
||||
begin
|
||||
p1:=nil;
|
||||
handle_propertysym(propsym,p1,pd);
|
||||
end;
|
||||
end
|
||||
else
|
||||
begin
|
||||
consume(LECKKLAMMER);
|
||||
repeat
|
||||
case pd^.deftype of
|
||||
pointerdef : begin
|
||||
p2:=comp_expr(true);
|
||||
p1:=gennode(vecn,p1,p2);
|
||||
pd:=ppointerdef(pd)^.definition;
|
||||
end;
|
||||
stringdef : begin
|
||||
p2:=comp_expr(true);
|
||||
p1:=gennode(vecn,p1,p2);
|
||||
pd:=cchardef
|
||||
end;
|
||||
arraydef : begin
|
||||
p2:=comp_expr(true);
|
||||
{$ifdef i386}
|
||||
{ support SEG:OFS for go32v2 Mem[] }
|
||||
if (target_info.target=target_GO32V2) and
|
||||
(p1^.treetype=loadn) and
|
||||
assigned(p1^.symtableentry) and
|
||||
assigned(p1^.symtableentry^.owner^.name) and
|
||||
(p1^.symtableentry^.owner^.name^='SYSTEM') and
|
||||
((p1^.symtableentry^.name='MEM') or
|
||||
(p1^.symtableentry^.name='MEMW') or
|
||||
(p1^.symtableentry^.name='MEML')) then
|
||||
begin
|
||||
if (token=COLON) then
|
||||
begin
|
||||
consume(COLON);
|
||||
p3:=gennode(muln,genordinalconstnode($10,s32bitdef),p2);
|
||||
p2:=comp_expr(true);
|
||||
p2:=gennode(addn,p2,p3);
|
||||
p1:=gennode(vecn,p1,p2);
|
||||
p1^.memseg:=true;
|
||||
p1^.memindex:=true;
|
||||
end
|
||||
else
|
||||
begin
|
||||
p1:=gennode(vecn,p1,p2);
|
||||
p1^.memindex:=true;
|
||||
end;
|
||||
end
|
||||
else
|
||||
{$endif}
|
||||
p1:=gennode(vecn,p1,p2);
|
||||
pd:=parraydef(pd)^.definition;
|
||||
end;
|
||||
else
|
||||
begin
|
||||
Message(cg_e_invalid_qualifier);
|
||||
disposetree(p1);
|
||||
p1:=genzeronode(errorn);
|
||||
again:=false;
|
||||
end;
|
||||
end;
|
||||
if token=COMMA then
|
||||
consume(COMMA)
|
||||
else
|
||||
break;
|
||||
until false;
|
||||
consume(RECKKLAMMER);
|
||||
end;
|
||||
end;
|
||||
POINT : begin
|
||||
consume(POINT);
|
||||
case pd^.deftype of
|
||||
recorddef : begin
|
||||
sym:=pvarsym(precdef(pd)^.symtable^.search(pattern));
|
||||
consume(ID);
|
||||
if sym=nil then
|
||||
begin
|
||||
Message(sym_e_illegal_field);
|
||||
disposetree(p1);
|
||||
p1:=genzeronode(errorn);
|
||||
end
|
||||
else
|
||||
begin
|
||||
p1:=gensubscriptnode(sym,p1);
|
||||
pd:=sym^.definition;
|
||||
end;
|
||||
end;
|
||||
classrefdef : begin
|
||||
classh:=pobjectdef(pclassrefdef(pd)^.definition);
|
||||
sym:=nil;
|
||||
while assigned(classh) do
|
||||
begin
|
||||
sym:=pvarsym(classh^.publicsyms^.search(pattern));
|
||||
srsymtable:=classh^.publicsyms;
|
||||
if assigned(sym) then
|
||||
break;
|
||||
classh:=classh^.childof;
|
||||
end;
|
||||
consume(ID);
|
||||
do_member_read(false,sym,p1,pd,again);
|
||||
end;
|
||||
objectdef : begin
|
||||
classh:=pobjectdef(pd);
|
||||
sym:=nil;
|
||||
while assigned(classh) do
|
||||
begin
|
||||
sym:=pvarsym(classh^.publicsyms^.search(pattern));
|
||||
srsymtable:=classh^.publicsyms;
|
||||
if assigned(sym) then
|
||||
break;
|
||||
classh:=classh^.childof;
|
||||
end;
|
||||
consume(ID);
|
||||
do_member_read(false,sym,p1,pd,again);
|
||||
end;
|
||||
pointerdef : begin
|
||||
Message(cg_e_invalid_qualifier);
|
||||
if ppointerdef(pd)^.definition^.deftype in [recorddef,objectdef,classrefdef] then
|
||||
Message(parser_h_maybe_deref_caret_missing);
|
||||
end;
|
||||
else
|
||||
begin
|
||||
Message(cg_e_invalid_qualifier);
|
||||
disposetree(p1);
|
||||
p1:=genzeronode(errorn);
|
||||
end;
|
||||
end;
|
||||
end;
|
||||
else
|
||||
begin
|
||||
{ is this a procedure variable ? }
|
||||
if assigned(pd) then
|
||||
begin
|
||||
if (pd^.deftype=procvardef) then
|
||||
begin
|
||||
if getprocvar and proc_to_procvar_equal(pprocvardef(pd),getprocvardef) then
|
||||
again:=false
|
||||
else
|
||||
if (token=LKLAMMER) or
|
||||
((pprocvardef(pd)^.para1=nil) and
|
||||
(not((token in [ASSIGNMENT,UNEQUAL,EQUAL]))) and
|
||||
(not afterassignment) and
|
||||
(not in_args)) then
|
||||
begin
|
||||
{ do this in a strange way }
|
||||
{ it's not a clean solution }
|
||||
p2:=p1;
|
||||
p1:=gencallnode(nil,nil);
|
||||
p1^.right:=p2;
|
||||
p1^.unit_specific:=unit_specific;
|
||||
p1^.symtableprocentry:=sym;
|
||||
if token=LKLAMMER then
|
||||
begin
|
||||
consume(LKLAMMER);
|
||||
p1^.left:=parse_paras(false,false);
|
||||
consume(RKLAMMER);
|
||||
end;
|
||||
pd:=pprocvardef(pd)^.retdef;
|
||||
{ proc():= is never possible }
|
||||
if token=ASSIGNMENT then
|
||||
begin
|
||||
Message(cg_e_illegal_expression);
|
||||
p1:=genzeronode(errorn);
|
||||
again:=false;
|
||||
end;
|
||||
p1^.resulttype:=pd;
|
||||
end
|
||||
else
|
||||
again:=false;
|
||||
p1^.resulttype:=pd;
|
||||
end
|
||||
else
|
||||
again:=false;
|
||||
end
|
||||
else
|
||||
again:=false;
|
||||
end;
|
||||
end;
|
||||
check_tokenpos;
|
||||
end; { while again }
|
||||
end;
|
||||
|
||||
|
||||
{---------------------------------------------
|
||||
Factor (Main)
|
||||
---------------------------------------------}
|
||||
|
||||
begin
|
||||
oldp1:=nil;
|
||||
filepos:=tokenpos;
|
||||
if token=ID then
|
||||
begin
|
||||
factor_read_id;
|
||||
{ handle post fix operators }
|
||||
postfixoperators;
|
||||
end;
|
||||
end
|
||||
else
|
||||
case token of
|
||||
_NEW : begin
|
||||
consume(_NEW);
|
||||
consume(LKLAMMER);
|
||||
@ -1855,7 +1873,10 @@ unit pexpr;
|
||||
end.
|
||||
{
|
||||
$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
|
||||
compile with _dTEST_FUNCRET
|
||||
|
||||
|
||||
@ -366,6 +366,7 @@ unit pstatmnt;
|
||||
|
||||
withsymtable:=new(psymtable,init(symtable.withsymtable));
|
||||
withsymtable^.root:=obj^.publicsyms^.root;
|
||||
withsymtable^.defowner:=obj;
|
||||
symtab:=withsymtable;
|
||||
levelcount:=1;
|
||||
obj:=obj^.childof;
|
||||
@ -386,6 +387,7 @@ unit pstatmnt;
|
||||
withsymtable:=new(psymtable,init(symtable.withsymtable));
|
||||
withsymtable^.root:=symtab^.root;
|
||||
withsymtable^.next:=symtablestack;
|
||||
withsymtable^.defowner:=obj;
|
||||
symtablestack:=withsymtable;
|
||||
end;
|
||||
else
|
||||
@ -1236,7 +1238,10 @@ unit pstatmnt;
|
||||
end.
|
||||
{
|
||||
$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
|
||||
compile with _dTEST_FUNCRET
|
||||
|
||||
|
||||
Loading…
Reference in New Issue
Block a user