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

* problems with properties fixed

Browse Source 
* crash fixed:  i:=l when i and l are undefined, was a problem with
    implementation of private/protected
This commit is contained in:
florian 1998-05-05 12:05:42 +00:00
parent c9b07a8a3a
commit a965360572
4 changed files with 120 additions and 98 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

13
compiler/pdecl.pas
View File

@ -93,7 +93,7 @@ unit pdecl;
EQUAL: EQUAL:
begin begin
consume(EQUAL); consume(EQUAL);
p:=expr; p:=comp_expr(true);
do_firstpass(p); do_firstpass(p);
case p^.treetype of case p^.treetype of
ordconstn: ordconstn:
@ -185,7 +185,7 @@ unit pdecl;
if token=LECKKLAMMER then if token=LECKKLAMMER then
begin begin
consume(LECKKLAMMER); consume(LECKKLAMMER);
p:=expr; p:=comp_expr(true);
do_firstpass(p); do_firstpass(p);
if not is_constintnode(p) then if not is_constintnode(p) then
Message(cg_e_illegal_expression); Message(cg_e_illegal_expression);
@ -1708,7 +1708,7 @@ unit pdecl;
startvarrec:=symtablestack^.datasize; startvarrec:=symtablestack^.datasize;
repeat repeat
repeat repeat
pt:=expr; pt:=comp_expr(true);
do_firstpass(pt); do_firstpass(pt);
if not(pt^.treetype=ordconstn) then if not(pt^.treetype=ordconstn) then
Message(cg_e_illegal_expression); Message(cg_e_illegal_expression);
@ -1792,7 +1792,12 @@ unit pdecl;
end. end.
{ {
$Log$ $Log$
Revision 1.15 1998-05-01 09:01:23 florian Revision 1.16 1998-05-05 12:05:42 florian
* problems with properties fixed
* crash fixed: i:=l when i and l are undefined, was a problem with
implementation of private/protected
Revision 1.15 1998/05/01 09:01:23 florian
+ correct semantics of private and protected + correct semantics of private and protected
* small fix in variable scope: * small fix in variable scope:
a id can be used in a parameter list of a method, even it is used in a id can be used in a parameter list of a method, even it is used in

99
compiler/pexpr.pas
View File

@ -79,20 +79,20 @@ unit pexpr;
inc(parsing_para_level); inc(parsing_para_level);
while true do while true do
begin begin
p1:=expr; p1:=comp_expr(true);
p2:=gencallparanode(p1,p2); p2:=gencallparanode(p1,p2);
{ it's for the str(l:5,s); } { it's for the str(l:5,s); }
if _colon and (token=COLON) then if _colon and (token=COLON) then
begin begin
consume(COLON); consume(COLON);
p1:=expr; p1:=comp_expr(true);
p2:=gencallparanode(p1,p2); p2:=gencallparanode(p1,p2);
p2^.is_colon_para:=true; p2^.is_colon_para:=true;
if token=COLON then if token=COLON then
begin begin
consume(COLON); consume(COLON);
p1:=expr; p1:=comp_expr(true);
p2:=gencallparanode(p1,p2); p2:=gencallparanode(p1,p2);
p2^.is_colon_para:=true; p2^.is_colon_para:=true;
end end
@ -125,7 +125,7 @@ unit pexpr;
consume(LKLAMMER); consume(LKLAMMER);
in_args:=true; in_args:=true;
Must_be_valid:=true; Must_be_valid:=true;
p1:=expr; p1:=comp_expr(true);
consume(RKLAMMER); consume(RKLAMMER);
do_firstpass(p1); do_firstpass(p1);
p1:=geninlinenode(in_ord_x,p1); p1:=geninlinenode(in_ord_x,p1);
@ -146,7 +146,7 @@ unit pexpr;
in_typeof_x : begin in_typeof_x : begin
consume(LKLAMMER); consume(LKLAMMER);
in_args:=true; in_args:=true;
p1:=expr; p1:=comp_expr(true);
consume(RKLAMMER); consume(RKLAMMER);
pd:=voidpointerdef; pd:=voidpointerdef;
if p1^.treetype=typen then if p1^.treetype=typen then
@ -187,7 +187,7 @@ unit pexpr;
in_sizeof_x : begin in_sizeof_x : begin
consume(LKLAMMER); consume(LKLAMMER);
in_args:=true; in_args:=true;
p1:=expr; p1:=comp_expr(true);
consume(RKLAMMER); consume(RKLAMMER);
pd:=s32bitdef; pd:=s32bitdef;
if p1^.treetype=typen then if p1^.treetype=typen then
@ -217,7 +217,7 @@ unit pexpr;
in_assigned_x : begin in_assigned_x : begin
consume(LKLAMMER); consume(LKLAMMER);
in_args:=true; in_args:=true;
p1:=expr; p1:=comp_expr(true);
Must_be_valid:=true; Must_be_valid:=true;
do_firstpass(p1); do_firstpass(p1);
case p1^.resulttype^.deftype of case p1^.resulttype^.deftype of
@ -238,7 +238,7 @@ unit pexpr;
in_ofs_x : begin in_ofs_x : begin
consume(LKLAMMER); consume(LKLAMMER);
in_args:=true; in_args:=true;
p1:=expr; p1:=comp_expr(true);
p1:=gensinglenode(addrn,p1); p1:=gensinglenode(addrn,p1);
Must_be_valid:=false; Must_be_valid:=false;
do_firstpass(p1); do_firstpass(p1);
@ -251,7 +251,7 @@ unit pexpr;
in_seg_x : begin in_seg_x : begin
consume(LKLAMMER); consume(LKLAMMER);
in_args:=true; in_args:=true;
p1:=expr; p1:=comp_expr(true);
do_firstpass(p1); do_firstpass(p1);
if p1^.location.loc<>LOC_REFERENCE then if p1^.location.loc<>LOC_REFERENCE then
Message(cg_e_illegal_expression); Message(cg_e_illegal_expression);
@ -265,7 +265,7 @@ unit pexpr;
in_low_x : begin in_low_x : begin
consume(LKLAMMER); consume(LKLAMMER);
in_args:=true; in_args:=true;
p1:=expr; p1:=comp_expr(true);
do_firstpass(p1); do_firstpass(p1);
Must_be_valid:=false; Must_be_valid:=false;
p2:=geninlinenode(l,p1); p2:=geninlinenode(l,p1);
@ -277,7 +277,7 @@ unit pexpr;
in_pred_x : begin in_pred_x : begin
consume(LKLAMMER); consume(LKLAMMER);
in_args:=true; in_args:=true;
p1:=expr; p1:=comp_expr(true);
do_firstpass(p1); do_firstpass(p1);
Must_be_valid:=false; Must_be_valid:=false;
p2:=geninlinenode(l,p1); p2:=geninlinenode(l,p1);
@ -289,13 +289,13 @@ unit pexpr;
in_dec_x : begin in_dec_x : begin
consume(LKLAMMER); consume(LKLAMMER);
in_args:=true; in_args:=true;
p1:=expr; p1:=comp_expr(true);
p2:=gencallparanode(p1,nil); p2:=gencallparanode(p1,nil);
Must_be_valid:=false; Must_be_valid:=false;
if token=COMMA then if token=COMMA then
begin begin
consume(COMMA); consume(COMMA);
p1:=expr; p1:=comp_expr(true);
p2:=gencallparanode(p1,p2); p2:=gencallparanode(p1,p2);
end; end;
statement_syssym:=geninlinenode(l,p2); statement_syssym:=geninlinenode(l,p2);
@ -308,7 +308,7 @@ unit pexpr;
p2:=nil; p2:=nil;
while true do while true do
begin begin
p1:=expr; p1:=comp_expr(true);
Must_be_valid:=true; Must_be_valid:=true;
do_firstpass(p1); do_firstpass(p1);
if not((p1^.resulttype^.deftype=stringdef) or if not((p1^.resulttype^.deftype=stringdef) or
@ -376,10 +376,10 @@ unit pexpr;
begin begin
consume(LKLAMMER); consume(LKLAMMER);
in_args:=true; in_args:=true;
p1:=expr; p1:=comp_expr(true);
Must_be_valid:=false; Must_be_valid:=false;
consume(COMMA); consume(COMMA);
p2:=expr; p2:=comp_expr(true);
{ just a bit lisp feeling } { just a bit lisp feeling }
statement_syssym:=geninlinenode(l, statement_syssym:=geninlinenode(l,
gencallparanode(p1,gencallparanode(p2,nil))); gencallparanode(p1,gencallparanode(p2,nil)));
@ -484,14 +484,10 @@ unit pexpr;
force the usage of that procedure } force the usage of that procedure }
p1^.procdefinition:=pprocdef(ppropertysym(sym)^.writeaccessdef); p1^.procdefinition:=pprocdef(ppropertysym(sym)^.writeaccessdef);
p1^.left:=paras; p1^.left:=paras;
{ to be on the save side }
oldafterassignment:=afterassignment;
consume(ASSIGNMENT); consume(ASSIGNMENT);
{ read the expression } { read the expression }
afterassignment:=true; p2:=comp_expr(true);
p2:=expr;
p1^.left:=gencallparanode(p2,p1^.left); p1^.left:=gencallparanode(p2,p1^.left);
afterassignment:=oldafterassignment;
end end
else if ppropertysym(sym)^.writeaccesssym^.typ=varsym then else if ppropertysym(sym)^.writeaccesssym^.typ=varsym then
begin begin
@ -506,14 +502,10 @@ unit pexpr;
else else
p1:=gensubscriptnode(pvarsym( p1:=gensubscriptnode(pvarsym(
ppropertysym(sym)^.readaccesssym),p1); ppropertysym(sym)^.readaccesssym),p1);
{ to be on the save side }
oldafterassignment:=afterassignment;
consume(ASSIGNMENT); consume(ASSIGNMENT);
{ read the expression } { read the expression }
afterassignment:=true; p2:=comp_expr(true);
p2:=expr;
p1:=gennode(assignn,p1,p2); p1:=gennode(assignn,p1,p2);
afterassignment:=oldafterassignment;
end end
else else
begin begin
@ -724,13 +716,13 @@ unit pexpr;
end end
else if (pd^.deftype=pointerdef) then else if (pd^.deftype=pointerdef) then
begin begin
p2:=expr; p2:=comp_expr(true);
p1:=gennode(vecn,p1,p2); p1:=gennode(vecn,p1,p2);
pd:=ppointerdef(pd)^.definition; pd:=ppointerdef(pd)^.definition;
end end
else else
begin begin
p2:=expr; p2:=comp_expr(true);
{ support SEG:OFS for go32v2 Mem[] } { support SEG:OFS for go32v2 Mem[] }
if (target_info.target=target_GO32V2) and if (target_info.target=target_GO32V2) and
(p1^.treetype=loadn) and (p1^.treetype=loadn) and
@ -745,7 +737,7 @@ unit pexpr;
begin begin
consume(COLON); consume(COLON);
p3:=gennode(muln,genordinalconstnode($10,s32bitdef),p2); p3:=gennode(muln,genordinalconstnode($10,s32bitdef),p2);
p2:=expr; p2:=comp_expr(true);
p2:=gennode(addn,p2,p3); p2:=gennode(addn,p2,p3);
p1:=gennode(vecn,p1,p2); p1:=gennode(vecn,p1,p2);
p1^.memseg:=true; p1^.memseg:=true;
@ -970,7 +962,8 @@ unit pexpr;
else else
unit_specific:=false; unit_specific:=false;
{ check semantics of private } { check semantics of private }
if srsymtable^.symtabletype=objectsymtable then if (srsym^.typ in [propertysym,procsym,varsym]) and
(srsymtable^.symtabletype=objectsymtable) then
begin begin
if ((srsym^.properties and sp_private)<>0) and if ((srsym^.properties and sp_private)<>0) and
(pobjectdef(srsym^.owner^.defowner)^. (pobjectdef(srsym^.owner^.defowner)^.
@ -1030,7 +1023,7 @@ unit pexpr;
if token=LKLAMMER then if token=LKLAMMER then
begin begin
consume(LKLAMMER); consume(LKLAMMER);
p1:=expr; p1:=comp_expr(true);
consume(RKLAMMER); consume(RKLAMMER);
p1:=gentypeconvnode(p1,pd); p1:=gentypeconvnode(p1,pd);
p1^.explizit:=true; p1^.explizit:=true;
@ -1347,7 +1340,7 @@ unit pexpr;
begin begin
pd:=stringtype; pd:=stringtype;
consume(LKLAMMER); consume(LKLAMMER);
p1:=expr; p1:=comp_expr(true);
consume(RKLAMMER); consume(RKLAMMER);
p1:=gentypeconvnode(p1,pd); p1:=gentypeconvnode(p1,pd);
p1^.explizit:=true; p1^.explizit:=true;
@ -1360,7 +1353,7 @@ unit pexpr;
pd:=cfiledef; pd:=cfiledef;
consume(_FILE); consume(_FILE);
consume(LKLAMMER); consume(LKLAMMER);
p1:=expr; p1:=comp_expr(true);
consume(RKLAMMER); consume(RKLAMMER);
p1:=gentypeconvnode(p1,pd); p1:=gentypeconvnode(p1,pd);
p1^.explizit:=true; p1^.explizit:=true;
@ -1385,7 +1378,7 @@ unit pexpr;
end; end;
LKLAMMER : begin LKLAMMER : begin
consume(LKLAMMER); consume(LKLAMMER);
p1:=expr; p1:=comp_expr(true);
consume(RKLAMMER); consume(RKLAMMER);
{ it's not a good solution } { it's not a good solution }
{ but (a+b)^ makes some problems } { but (a+b)^ makes some problems }
@ -1412,7 +1405,7 @@ unit pexpr;
if token<>RECKKLAMMER then if token<>RECKKLAMMER then
while true do while true do
begin begin
p1:=expr; p1:=comp_expr(true);
do_firstpass(p1); do_firstpass(p1);
case p1^.treetype of case p1^.treetype of
ordconstn : begin ordconstn : begin
@ -1421,17 +1414,20 @@ unit pexpr;
if not(is_equal(pd,p1^.resulttype)) then if not(is_equal(pd,p1^.resulttype)) then
Message(parser_e_typeconflict_in_set) Message(parser_e_typeconflict_in_set)
else else
do_set(constset,p1^.value); if token=POINTPOINT then
disposetree(p1); begin
end; consume(POINTPOINT);
rangen : begin p3:=comp_expr(true);
if pd=nil then do_firstpass(p3);
pd:=p1^.left^.resulttype; if not(is_equal(pd,p3^.resulttype)) then
if not(is_equal(pd,p1^.left^.resulttype)) then
Message(parser_e_typeconflict_in_set) Message(parser_e_typeconflict_in_set)
else else
for l:=p1^.left^.value to p1^.right^.value do for l:=p1^.value to p3^.value do
do_set(constset,l); do_set(constset,l);
disposetree(p3);
end
else
do_set(constset,p1^.value);
disposetree(p1); disposetree(p1);
end; end;
stringconstn : begin stringconstn : begin
@ -1563,8 +1559,14 @@ unit pexpr;
function comp_expr(accept_equal : boolean):Ptree; function comp_expr(accept_equal : boolean):Ptree;
var
oldafterassignment : boolean;
begin begin
oldafterassignment:=afterassignment;
afterassignment:=true;
comp_expr:=sub_expr(opcompare,accept_equal); comp_expr:=sub_expr(opcompare,accept_equal);
afterassignment:=oldafterassignment;
end; end;
function expr : ptree; function expr : ptree;
@ -1641,7 +1643,7 @@ unit pexpr;
var p:Ptree; var p:Ptree;
begin begin
p:=expr; p:=comp_expr(true);
do_firstpass(p); do_firstpass(p);
if (p^.treetype<>ordconstn) and if (p^.treetype<>ordconstn) and
(p^.resulttype^.deftype=orddef) and (p^.resulttype^.deftype=orddef) and
@ -1662,7 +1664,7 @@ unit pexpr;
begin begin
get_stringconst:=''; get_stringconst:='';
p:=expr; p:=comp_expr(true);
do_firstpass(p); do_firstpass(p);
if p^.treetype<>stringconstn then if p^.treetype<>stringconstn then
if (p^.treetype=ordconstn) and if (p^.treetype=ordconstn) and
@ -1679,7 +1681,12 @@ unit pexpr;
end. end.
{ {
$Log$ $Log$
Revision 1.11 1998-05-04 11:22:26 florian Revision 1.12 1998-05-05 12:05:42 florian
* problems with properties fixed
* crash fixed: i:=l when i and l are undefined, was a problem with
implementation of private/protected
Revision 1.11 1998/05/04 11:22:26 florian
* problem with DOM solved: it crashes when accessing a property in a method * problem with DOM solved: it crashes when accessing a property in a method
Revision 1.10 1998/05/01 16:38:45 florian Revision 1.10 1998/05/01 16:38:45 florian

33
compiler/pstatmnt.pas
View File

@ -71,7 +71,7 @@ unit pstatmnt;
begin begin
consume(_IF); consume(_IF);
ex:=expr; ex:=comp_expr(true);
consume(_THEN); consume(_THEN);
if token<>_ELSE then if token<>_ELSE then
if_a:=statement if_a:=statement
@ -167,7 +167,7 @@ unit pstatmnt;
begin begin
consume(_CASE); consume(_CASE);
caseexpr:=expr; caseexpr:=comp_expr(true);
{ determines result type } { determines result type }
cleartempgen; cleartempgen;
do_firstpass(caseexpr); do_firstpass(caseexpr);
@ -184,7 +184,7 @@ unit pstatmnt;
getlabel(aktcaselabel); getlabel(aktcaselabel);
{aktcaselabel^.is_used:=true; } {aktcaselabel^.is_used:=true; }
{ an instruction has may be more case labels } { may be an instruction has more case labels }
repeat repeat
p:=expr; p:=expr;
cleartempgen; cleartempgen;
@ -278,7 +278,7 @@ unit pstatmnt;
end; end;
consume(_UNTIL); consume(_UNTIL);
first:=gensinglenode(blockn,first); first:=gensinglenode(blockn,first);
p_e:=expr; p_e:=comp_expr(true);
repeat_statement:=genloopnode(repeatn,p_e,first,nil,false); repeat_statement:=genloopnode(repeatn,p_e,first,nil,false);
end; end;
@ -289,7 +289,7 @@ unit pstatmnt;
begin begin
consume(_WHILE); consume(_WHILE);
p_e:=expr; p_e:=comp_expr(true);
consume(_DO); consume(_DO);
p_a:=statement; p_a:=statement;
while_statement:=genloopnode(whilen,p_e,p_a,nil,false); while_statement:=genloopnode(whilen,p_e,p_a,nil,false);
@ -315,7 +315,7 @@ unit pstatmnt;
consume(_TO); consume(_TO);
backward:=false; backward:=false;
end; end;
tovalue:=expr; tovalue:=comp_expr(true);
consume(_DO); consume(_DO);
{ ... now the instruction } { ... now the instruction }
@ -333,7 +333,7 @@ unit pstatmnt;
begin begin
Must_be_valid:=false; Must_be_valid:=false;
p:=expr; p:=comp_expr(true);
do_firstpass(p); do_firstpass(p);
right:=nil; right:=nil;
case p^.resulttype^.deftype of case p^.resulttype^.deftype of
@ -424,11 +424,11 @@ unit pstatmnt;
consume(_RAISE); consume(_RAISE);
if token<>SEMICOLON then if token<>SEMICOLON then
begin begin
p1:=expr; p1:=comp_expr(true);
if (token=ID) and (pattern='AT') then if (token=ID) and (pattern='AT') then
begin begin
consume(ID); consume(ID);
p2:=expr; p2:=comp_expr(true);
end; end;
end end
else else
@ -490,11 +490,11 @@ unit pstatmnt;
begin begin
repeat repeat
consume(_ON); consume(_ON);
e1:=expr; e1:=comp_expr(true);
if token=COLON then if token=COLON then
begin begin
consume(COLON); consume(COLON);
e2:=expr; e2:=comp_expr(true);
{ !!!!! } { !!!!! }
end end
else else
@ -534,7 +534,7 @@ unit pstatmnt;
if token=LKLAMMER then if token=LKLAMMER then
begin begin
consume(LKLAMMER); consume(LKLAMMER);
p:=expr; p:=comp_expr(true);
consume(RKLAMMER); consume(RKLAMMER);
if procinfo.retdef=pdef(voiddef) then if procinfo.retdef=pdef(voiddef) then
Message(parser_e_void_function) Message(parser_e_void_function)
@ -656,7 +656,7 @@ unit pstatmnt;
else else
tt:=hdisposen; tt:=hdisposen;
consume(LKLAMMER); consume(LKLAMMER);
p:=expr; p:=comp_expr(true);
{ calc return type } { calc return type }
cleartempgen; cleartempgen;
@ -1077,7 +1077,12 @@ unit pstatmnt;
end. end.
{ {
$Log$ $Log$
Revision 1.7 1998-05-01 16:38:46 florian Revision 1.8 1998-05-05 12:05:42 florian
* problems with properties fixed
* crash fixed: i:=l when i and l are undefined, was a problem with
implementation of private/protected
Revision 1.7 1998/05/01 16:38:46 florian
* handling of private and protected fixed * handling of private and protected fixed
+ change_keywords_to_tp implemented to remove + change_keywords_to_tp implemented to remove
keywords which aren't supported by tp keywords which aren't supported by tp

21
compiler/ptconst.pas
View File

@ -78,7 +78,7 @@ unit ptconst;
case def^.deftype of case def^.deftype of
orddef: orddef:
begin begin
p:=expr; p:=comp_expr(true);
do_firstpass(p); do_firstpass(p);
case porddef(def)^.typ of case porddef(def)^.typ of
s8bit, s8bit,
@ -129,7 +129,7 @@ unit ptconst;
end; end;
floatdef: floatdef:
begin begin
p:=expr; p:=comp_expr(true);
do_firstpass(p); do_firstpass(p);
if is_constrealnode(p) then if is_constrealnode(p) then
value:=p^.valued value:=p^.valued
@ -150,7 +150,7 @@ unit ptconst;
end; end;
pointerdef: pointerdef:
begin begin
p:=expr; p:=comp_expr(true);
do_firstpass(p); do_firstpass(p);
{ nil pointer ? } { nil pointer ? }
if p^.treetype=niln then if p^.treetype=niln then
@ -206,7 +206,7 @@ unit ptconst;
end; end;
setdef: setdef:
begin begin
p:=expr; p:=comp_expr(true);
do_firstpass(p); do_firstpass(p);
if p^.treetype=setconstrn then if p^.treetype=setconstrn then
begin begin
@ -226,7 +226,7 @@ unit ptconst;
end; end;
enumdef: enumdef:
begin begin
p:=expr; p:=comp_expr(true);
do_firstpass(p); do_firstpass(p);
if p^.treetype=ordconstn then if p^.treetype=ordconstn then
begin begin
@ -243,7 +243,7 @@ unit ptconst;
end; end;
stringdef: stringdef:
begin begin
p:=expr; p:=comp_expr(true);
do_firstpass(p); do_firstpass(p);
{ first take care of prefixes for long and ansi strings } { first take care of prefixes for long and ansi strings }
{$ifdef UseLongString} {$ifdef UseLongString}
@ -323,7 +323,7 @@ unit ptconst;
end end
else else
begin begin
p:=expr; p:=comp_expr(true);
do_firstpass(p); do_firstpass(p);
if p^.treetype=stringconstn then if p^.treetype=stringconstn then
s:=p^.values^ s:=p^.values^
@ -450,7 +450,12 @@ unit ptconst;
end. end.
{ {
$Log$ $Log$
Revision 1.3 1998-04-29 10:34:00 pierre Revision 1.4 1998-05-05 12:05:42 florian
* problems with properties fixed
* crash fixed: i:=l when i and l are undefined, was a problem with
implementation of private/protected
Revision 1.3 1998/04/29 10:34:00 pierre
+ added some code for ansistring (not complete nor working yet) + added some code for ansistring (not complete nor working yet)
* corrected operator overloading * corrected operator overloading
* corrected nasm output * corrected nasm output