From 210e78e4fa183484fd44b5db6bd5abbbae7cbf9c Mon Sep 17 00:00:00 2001 From: paul Date: Mon, 27 Dec 2010 05:47:25 +0000 Subject: [PATCH] compiler: allow objects and records to have members which point to themself. only don't permit this to regular fields. - remove testcurobject hack and perform a check only for regular fields - move is_holded_by to interface and rename it to is_owned_by - don't check static symbols in _needs_init_final because they always point to symbols registered on unit level - don't check object type in id_type, read_named_type when we are looking for type of structure member - the only check will be performed for record/object fields now + tests git-svn-id: trunk@16646 - --- .gitattributes | 2 ++ compiler/parser.pas | 4 ---- compiler/pdecobj.pas | 2 -- compiler/pdecsub.pas | 4 ---- compiler/pdecvar.pas | 13 +++++++++--- compiler/ptype.pas | 48 +++++++++++++++---------------------------- compiler/symconst.pas | 4 ++-- compiler/symtable.pas | 26 +++++++++++++---------- tests/test/terecs8.pp | 21 +++++++++++++++++++ tests/test/terecs9.pp | 20 ++++++++++++++++++ 10 files changed, 86 insertions(+), 58 deletions(-) create mode 100644 tests/test/terecs8.pp create mode 100644 tests/test/terecs9.pp diff --git a/.gitattributes b/.gitattributes index b7460cb2a1..f2447bccf1 100644 --- a/.gitattributes +++ b/.gitattributes @@ -9330,6 +9330,8 @@ tests/test/terecs4.pp svneol=native#text/pascal tests/test/terecs5.pp svneol=native#text/pascal tests/test/terecs6.pp svneol=native#text/pascal tests/test/terecs7.pp svneol=native#text/pascal +tests/test/terecs8.pp svneol=native#text/pascal +tests/test/terecs9.pp svneol=native#text/pascal tests/test/terecs_u1.pp svneol=native#text/pascal tests/test/testcmem.pp svneol=native#text/plain tests/test/testda1.pp svneol=native#text/plain diff --git a/compiler/parser.pas b/compiler/parser.pas index c0a0431d69..652f67cfc7 100644 --- a/compiler/parser.pas +++ b/compiler/parser.pas @@ -55,10 +55,6 @@ implementation procedure initparser; begin - { we didn't parse a object or class declaration } - { and no function header } - testcurobject:=0; - { Current compiled module/proc } set_current_module(nil); current_module:=nil; diff --git a/compiler/pdecobj.pas b/compiler/pdecobj.pas index 1696599e28..fb72628099 100644 --- a/compiler/pdecobj.pas +++ b/compiler/pdecobj.pas @@ -607,7 +607,6 @@ implementation current_objectdef.symtable.currentvisibility:=vis_published else current_objectdef.symtable.currentvisibility:=vis_public; - testcurobject:=1; has_destructor:=false; fields_allowed:=true; is_classdef:=false; @@ -948,7 +947,6 @@ implementation until false; { restore } - testcurobject:=0; parse_generic:=old_parse_generic; end; diff --git a/compiler/pdecsub.pas b/compiler/pdecsub.pas index 2a6c3a1906..6e3870041f 100644 --- a/compiler/pdecsub.pas +++ b/compiler/pdecsub.pas @@ -528,7 +528,6 @@ implementation sc:=TFPObjectList.create(false); defaultrequired:=false; paranr:=0; - inc(testcurobject); block_type:=bt_var; is_univ:=false; repeat @@ -782,7 +781,6 @@ implementation { remove parasymtable from stack } sc.free; { reset object options } - dec(testcurobject); block_type:=old_block_type; consume(_RKLAMMER); end; @@ -1196,7 +1194,6 @@ implementation old_current_specializedef: tobjectdef; begin old_parse_generic:=parse_generic; - inc(testcurobject); { Add ObjectSymtable to be able to find generic type definitions } popclass:=0; if assigned(pd.struct) and @@ -1228,7 +1225,6 @@ implementation if popclass<>0 then internalerror(201012020); end; - dec(testcurobject); parse_generic:=old_parse_generic; end; diff --git a/compiler/pdecvar.pas b/compiler/pdecvar.pas index ab8ab8caad..a752507ce7 100644 --- a/compiler/pdecvar.pas +++ b/compiler/pdecvar.pas @@ -357,7 +357,6 @@ implementation { create a list of the parameters } symtablestack.push(readprocdef.parast); sc:=TFPObjectList.create(false); - inc(testcurobject); repeat if try_to_consume(_VAR) then varspez:=vs_var @@ -403,7 +402,6 @@ implementation end; until not try_to_consume(_SEMICOLON); sc.free; - dec(testcurobject); symtablestack.pop(readprocdef.parast); consume(_RECKKLAMMER); @@ -1406,7 +1404,7 @@ implementation {$endif powerpc or powerpc64} { Force an expected ID error message } if not (token in [_ID,_CASE,_END]) then - consume(_ID); + consume(_ID); { read vars } sc:=TFPObjectList.create(false); recstlist:=TFPObjectList.create(false);; @@ -1447,6 +1445,15 @@ implementation end; end; read_anon_type(hdef,false); + { allow only static fields reference to struct where they are declared } + if not (vd_class in options) and + (is_object(hdef) or is_record(hdef)) and + is_owned_by(tabstractrecorddef(recst.defowner),tabstractrecorddef(hdef)) then + begin + Message1(type_e_type_is_not_completly_defined, tabstractrecorddef(hdef).RttiName); + { for error recovery or compiler will crash later } + hdef:=generrordef; + end; { restore stack } for i:=recstlist.count-1 downto 0 do begin diff --git a/compiler/ptype.pas b/compiler/ptype.pas index de6c6428ae..137f7341f4 100644 --- a/compiler/ptype.pas +++ b/compiler/ptype.pas @@ -29,11 +29,6 @@ interface globtype,cclasses, symtype,symdef,symbase; - var - { hack, which allows to use the current parsed } - { object type as function argument type } - testcurobject : byte; - procedure resolve_forward_types; { reads a type identifier } @@ -382,18 +377,14 @@ implementation - classes can be used also in classes - objects can be parameters } structdef:=current_structdef; - while Assigned(structdef) and (structdef.typ in [objectdef,recorddef]) do + while assigned(structdef) and (structdef.typ in [objectdef,recorddef]) do begin - if (structdef.objname^=pattern) and - ( - (testcurobject=2) or - is_class_or_interface_or_objc(structdef) - ) then - begin - consume(_ID); - def:=structdef; - exit; - end; + if (structdef.objname^=pattern) then + begin + consume(_ID); + def:=structdef; + exit; + end; structdef:=tabstractrecorddef(structdef.owner.defowner); end; { Use the special searchsym_type that ignores records and parameters } @@ -583,7 +574,6 @@ implementation Exit; current_structdef.symtable.currentvisibility:=vis_public; - testcurobject:=1; fields_allowed:=true; is_classdef:=false; classfields:=false; @@ -842,8 +832,6 @@ implementation consume(_ID); { Give a ident expected message, like tp7 } end; until false; - - testcurobject:=0; end; { reads a record declaration } @@ -895,7 +883,7 @@ implementation lv,hv : TConstExprInt; old_block_type : tblock_type; dospecialize : boolean; - structdef: TDef; + structdef: tabstractrecorddef; begin old_block_type:=block_type; dospecialize:=false; @@ -905,19 +893,15 @@ implementation if (token=_ID) then begin structdef:=current_structdef; - while Assigned(structdef) and (structdef.typ in [objectdef,recorddef]) do + while assigned(structdef) and (structdef.typ in [objectdef,recorddef]) do begin - if (tabstractrecorddef(structdef).objname^=pattern) and - ( - (testcurobject=2) or - is_class_or_interface_or_objc(structdef) - ) then - begin - consume(_ID); - def:=structdef; - exit; - end; - structdef:=tdef(tabstractrecorddef(structdef).owner.defowner); + if (structdef.objname^=pattern) then + begin + consume(_ID); + def:=structdef; + exit; + end; + structdef:=tabstractrecorddef(structdef.owner.defowner); end; end; { Generate a specialization? } diff --git a/compiler/symconst.pas b/compiler/symconst.pas index 7b00fac472..a4cc332ffd 100644 --- a/compiler/symconst.pas +++ b/compiler/symconst.pas @@ -156,13 +156,13 @@ type { symbol options } tsymoption=(sp_none, - sp_static, + sp_static, { static symbol in class/object/record } sp_hint_deprecated, sp_hint_platform, sp_hint_library, sp_hint_unimplemented, sp_has_overloaded, - sp_internal, { internal symbol, not reported as unused } + sp_internal, { internal symbol, not reported as unused } sp_implicitrename, sp_hint_experimental, sp_generic_para, diff --git a/compiler/symtable.pas b/compiler/symtable.pas index b8052914ac..8a07a28e03 100644 --- a/compiler/symtable.pas +++ b/compiler/symtable.pas @@ -200,6 +200,7 @@ interface {*** Search ***} procedure addsymref(sym:tsym); + function is_owned_by(childdef,ownerdef:tabstractrecorddef):boolean; function is_visible_for_object(symst:tsymtable;symvisibility:tvisibility;contextobjdef:tabstractrecorddef):boolean; function is_visible_for_object(pd:tprocdef;contextobjdef:tabstractrecorddef):boolean; function is_visible_for_object(sym:tsym;contextobjdef:tabstractrecorddef):boolean; @@ -747,7 +748,11 @@ implementation procedure TStoredSymtable._needs_init_final(sym:TObject;arg:pointer); begin if b_needs_init_final then - exit; + exit; + { don't check static symbols - they can be present in structures only and + always have a reference to a symbol defined on unit level } + if sp_static in tsym(sym).symoptions then + exit; case tsym(sym).typ of fieldvarsym, staticvarsym, @@ -1714,15 +1719,14 @@ implementation end; + function is_owned_by(childdef,ownerdef:tabstractrecorddef):boolean; + begin + result:=childdef=ownerdef; + if not result and (childdef.owner.symtabletype in [ObjectSymtable,recordsymtable]) then + result:=is_owned_by(tabstractrecorddef(childdef.owner.defowner),ownerdef); + end; + function is_visible_for_object(symst:tsymtable;symvisibility:tvisibility;contextobjdef:tabstractrecorddef):boolean; - - function is_holded_by(childdef,ownerdef: tabstractrecorddef): boolean; - begin - result:=childdef=ownerdef; - if not result and (childdef.owner.symtabletype in [ObjectSymtable,recordsymtable]) then - result:=is_holded_by(tabstractrecorddef(childdef.owner.defowner),ownerdef); - end; - var symownerdef : tabstractrecorddef; begin @@ -1760,13 +1764,13 @@ implementation vis_strictprivate : begin result:=assigned(current_structdef) and - is_holded_by(current_structdef,symownerdef); + is_owned_by(current_structdef,symownerdef); end; vis_strictprotected : begin result:=assigned(current_structdef) and (current_structdef.is_related(symownerdef) or - is_holded_by(current_structdef,symownerdef)); + is_owned_by(current_structdef,symownerdef)); end; vis_protected : begin diff --git a/tests/test/terecs8.pp b/tests/test/terecs8.pp new file mode 100644 index 0000000000..424b25cb1f --- /dev/null +++ b/tests/test/terecs8.pp @@ -0,0 +1,21 @@ +program terecs8; + +{$mode delphi} + +// allow refence owner type for record and object static fields and class properties +type + TFoo = record + class var + FFoo: TFoo; + class property Foo: TFoo read FFoo write FFoo; + end; + + TBar = record + class var + FBar: TBar; + class property Bar: TBar read FBar write FBar; + end; + +begin +end. + diff --git a/tests/test/terecs9.pp b/tests/test/terecs9.pp new file mode 100644 index 0000000000..3ff668813a --- /dev/null +++ b/tests/test/terecs9.pp @@ -0,0 +1,20 @@ +{ %fail} +program terecs9; + +{$mode delphi} + +// don't allow refence owner type for record and object fields and properties +type + TFoo = record + var + FFoo: TFoo; + end; + + TBar = record + var + FBar: TBar; + end; + +begin +end. +