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

@@ -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

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;

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;
 

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;
 

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

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? }

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,

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_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;
+    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;
       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

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.
+

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.
+