compiler: push to the stack not only nested hierarchy but also class hierarchy for each nested entry both in method declaration and for method body, also push child hierarchy while parsing object members because in other case parent types are invisible for descendants (fixes mantis #0018124, mantis #0018127 and more) + extended test

git-svn-id: trunk@16491 -

.gitattributes

@@ -10776,6 +10776,7 @@ tests/webtbs/tw18075.pp svneol=native#text/pascal
 tests/webtbs/tw18082.pp svneol=native#text/plain
 tests/webtbs/tw18085.pp svneol=native#text/pascal
 tests/webtbs/tw18086.pp svneol=native#text/pascal
+tests/webtbs/tw18127.pp svneol=native#text/pascal
 tests/webtbs/tw1820.pp svneol=native#text/plain
 tests/webtbs/tw1825.pp svneol=native#text/plain
 tests/webtbs/tw1850.pp svneol=native#text/plain

compiler/pdecobj.pas

@@ -1047,11 +1047,13 @@ implementation
             { parse optional GUID for interfaces }
             parse_guid;
 
-            { parse and insert object members }
-            symtablestack.push(current_objectdef.symtable);
+            //symtablestack.push(current_objectdef.symtable);
+            push_child_hierarcy(current_objectdef);
             insert_generic_parameter_types(genericdef,genericlist);
+            { parse and insert object members }
             parse_object_members;
-            symtablestack.pop(current_objectdef.symtable);
+            //symtablestack.pop(current_objectdef.symtable);
+            pop_child_hierarchy(current_objectdef);
           end;
 
         { generate vmt space if needed }

compiler/pdecsub.pas

@@ -62,6 +62,14 @@ interface
     function  parse_proc_head(aclass:tobjectdef;potype:tproctypeoption;var pd:tprocdef):boolean;
     function  parse_proc_dec(isclassmethod:boolean; aclass:tobjectdef):tprocdef;
 
+    { helper functions - they insert nested objects hierarcy to the symtablestack
+      with object hierarchy
+    }
+    function push_child_hierarcy(obj:tobjectdef):integer;
+    function pop_child_hierarchy(obj:tobjectdef):integer;
+    function push_nested_hierarchy(obj:tobjectdef):integer;
+    function pop_nested_hierarchy(obj:tobjectdef):integer;
+
 implementation
 
     uses
@@ -89,6 +97,51 @@ implementation
         Declaring it as string here results in an error when compiling (PFV) }
       current_procinfo = 'error';
 
+    function push_child_hierarcy(obj:tobjectdef):integer;
+      var
+        _class,hp : tobjectdef;
+      begin
+        result:=0;
+        { insert class hierarchy in the reverse order }
+        hp:=nil;
+        repeat
+          _class:=obj;
+          while _class.childof<>hp do
+            _class:=_class.childof;
+          hp:=_class;
+          symtablestack.push(_class.symtable);
+          inc(result);
+        until hp=obj;
+      end;
+
+    function push_nested_hierarchy(obj:tobjectdef):integer;
+      begin
+        result:=0;
+        if obj.owner.symtabletype=ObjectSymtable then
+          inc(result,push_nested_hierarchy(tobjectdef(obj.owner.defowner)));
+        inc(result,push_child_hierarcy(obj));
+      end;
+
+    function pop_child_hierarchy(obj:tobjectdef):integer;
+      var
+        _class : tobjectdef;
+      begin
+        result:=0;
+        _class:=obj;
+        while assigned(_class) do
+          begin
+            symtablestack.pop(_class.symtable);
+            _class:=_class.childof;
+            inc(result);
+          end;
+      end;
+
+    function pop_nested_hierarchy(obj:tobjectdef):integer;
+      begin
+        result:=pop_child_hierarchy(obj);
+        if obj.owner.symtabletype=ObjectSymtable then
+          inc(result,pop_nested_hierarchy(tobjectdef(obj.owner.defowner)));
+      end;
 
     procedure insert_funcret_para(pd:tabstractprocdef);
       var
@@ -720,23 +773,6 @@ implementation
 
 
     function parse_proc_head(aclass:tobjectdef;potype:tproctypeoption;var pd:tprocdef):boolean;
-
-      function push_objects(obj:tobjectdef):integer;
-        begin
-          result:=1;
-          if obj.owner.symtabletype=ObjectSymtable then
-            inc(result,push_objects(tobjectdef(obj.owner.defowner)));
-          symtablestack.push(obj.symtable);
-        end;
-
-      function pop_objects(obj:tobjectdef):integer;
-        begin
-          result:=1;
-          symtablestack.pop(obj.symtable);
-          if obj.owner.symtabletype=ObjectSymtable then
-            inc(result,pop_objects(tobjectdef(obj.owner.defowner)));
-        end;
-
       var
         hs       : string;
         orgsp,sp : TIDString;
@@ -1020,7 +1056,7 @@ implementation
                (pd.parast.symtablelevel=normal_function_level) and
                (symtablestack.top.symtabletype<>ObjectSymtable) then
               begin
-                popclass:=push_objects(pd._class);
+                popclass:=push_nested_hierarchy(pd._class);
                 old_current_objectdef:=current_objectdef;
                 old_current_genericdef:=current_genericdef;
                 old_current_specializedef:=current_specializedef;
@@ -1041,7 +1077,7 @@ implementation
                 current_objectdef:=old_current_objectdef;
                 current_genericdef:=old_current_genericdef;
                 current_specializedef:=old_current_specializedef;
-                dec(popclass, pop_objects(pd._class));
+                dec(popclass,pop_nested_hierarchy(pd._class));
                 if popclass<>0 then
                   internalerror(201011260); // 11 nov 2010 index 0
               end;
@@ -1056,8 +1092,8 @@ implementation
       var
         pd : tprocdef;
         locationstr: string;
-        old_parse_generic,
-        popclass: boolean;
+        old_parse_generic: boolean;
+        popclass: integer;
         old_current_objectdef,
         old_current_genericdef,
         old_current_specializedef: tobjectdef;
@@ -1078,13 +1114,12 @@ implementation
                          old_parse_generic:=parse_generic;
                          inc(testcurobject);
                          { Add ObjectSymtable to be able to find generic type definitions }
-                         popclass:=false;
+                         popclass:=0;
                          if assigned(pd._class) and
                             (pd.parast.symtablelevel=normal_function_level) and
                             (symtablestack.top.symtabletype<>ObjectSymtable) then
                            begin
-                             symtablestack.push(pd._class.symtable);
-                             popclass:=true;
+                             popclass:=push_nested_hierarchy(pd._class);
                              parse_generic:=(df_generic in pd._class.defoptions);
                              old_current_objectdef:=current_objectdef;
                              old_current_genericdef:=current_genericdef;
@@ -1100,12 +1135,14 @@ implementation
                          if is_dispinterface(pd._class) and not is_automatable(pd.returndef) then
                            Message1(type_e_not_automatable,pd.returndef.typename);
 
-                         if popclass then
+                         if popclass>0 then
                            begin
                              current_objectdef:=old_current_objectdef;
                              current_genericdef:=old_current_genericdef;
                              current_specializedef:=old_current_specializedef;
-                             symtablestack.pop(pd._class.symtable);
+                             dec(popclass,pop_nested_hierarchy(pd._class));
+                             if popclass<>0 then
+                               internalerror(201012020);
                            end;
                          dec(testcurobject);
                          parse_generic:=old_parse_generic;

compiler/psub.pas

@@ -1271,25 +1271,13 @@ implementation
 
 
     procedure tcgprocinfo.add_to_symtablestack;
-      var
-        _class,hp : tobjectdef;
       begin
         { insert symtables for the class, but only if it is no nested function }
         if assigned(procdef._class) and
            not(assigned(parent) and
                assigned(parent.procdef) and
                assigned(parent.procdef._class)) then
-          begin
-            { insert them in the reverse order }
-            hp:=nil;
-            repeat
-              _class:=procdef._class;
-              while _class.childof<>hp do
-                _class:=_class.childof;
-              hp:=_class;
-              symtablestack.push(_class.symtable);
-            until hp=procdef._class;
-          end;
+          push_nested_hierarchy(procdef._class);
 
         { insert parasymtable in symtablestack when parsing
           a function }
@@ -1305,8 +1293,6 @@ implementation
 
 
     procedure tcgprocinfo.remove_from_symtablestack;
-      var
-        _class : tobjectdef;
       begin
         { remove localsymtable }
         if procdef.localst.symtablelevel>=normal_function_level then
@@ -1321,14 +1307,7 @@ implementation
            not(assigned(parent) and
                assigned(parent.procdef) and
                assigned(parent.procdef._class)) then
-          begin
-            _class:=procdef._class;
-            while assigned(_class) do
-              begin
-                symtablestack.pop(_class.symtable);
-                _class:=_class.childof;
-              end;
-          end;
+          pop_nested_hierarchy(procdef._class);
       end;
 
 

tests/webtbs/tw18127.pp

@@ -0,0 +1,31 @@
+{ %norun% }
+program tw18127;
+
+{$mode objfpc}{$H+}
+
+type
+  TBar = class
+  public
+    type
+      TSomeInt = integer;
+  end;
+
+  TFoo1 = class(TBar)
+  public
+    const
+      one = 1;
+    type
+      TFoo2 = TSomeInt; // was error: Identifier not found "TSomeInt"
+      TFoo3 = class
+        function Func: TFoo2;
+      end;
+  end;
+
+  function TFoo1.TFoo3.Func: TFoo2; // was error: Identifier not found "TFoo2"
+  begin
+    Result := one; // was error: Identifier not found "one"
+  end;
+
+begin
+end.
+