* correctly deal with writing debug information in the Stabs writer for class

hierarchies from other units that were compiled without debug information
    in case not all classes from the hierarchy are explicitly used
    (mantis #22495, #21503, #21259)

git-svn-id: trunk@21972 -

.gitattributes

@@ -10287,6 +10287,8 @@ tests/test/packages/fcl-db/tdb6.pp svneol=native#text/plain
 tests/test/packages/fcl-db/toolsunit.pas svneol=native#text/plain
 tests/test/packages/fcl-registry/tregistry1.pp svneol=native#text/plain
 tests/test/packages/fcl-xml/thtmlwriter.pp svneol=native#text/plain
+tests/test/packages/fcl-xml/tw22495.pp svneol=native#text/plain
+tests/test/packages/fcl-xml/uw22495.pp svneol=native#text/plain
 tests/test/packages/hash/sha1test.pp svneol=native#text/plain
 tests/test/packages/hash/tmdtest.pp svneol=native#text/plain
 tests/test/packages/webtbs/tw10045.pp svneol=native#text/plain

compiler/dbgbase.pas

@@ -311,8 +311,32 @@ implementation
                     internalerror(200610053);
                   dbg_state_used:
                     appenddef(list,def);
-                else
+                  dbg_state_queued:
-                  internalerror(200610054);
+                    begin
+                      { can happen in case an objectdef was used from another
+                        unit that was compiled without debug info, and we are
+                        using Stabs (which means that parent types have to be
+                        written before child types). In this case, the child
+                        objectdef will be queued and never written, because its
+                        definition is not inside the current unit and hence will
+                        not be encountered }
+                      if def.typ<>objectdef then
+                        internalerror(2012072401);
+                      if not assigned(tobjectdef(def).childof) or
+                         (tobjectdef(def).childof.dbg_state=dbg_state_written) then
+                        appenddef(list,def)
+                      else if tobjectdef(def).childof.dbg_state=dbg_state_queued then
+                        deftowritelist.add(def)
+                      else if tobjectdef(def).childof.dbg_state=dbg_state_used then
+                        { comes somewhere after the current def in the looplist
+                          and will be written at that point, so we will have to
+                          wait until the next iteration }
+                        deftowritelist.add(def)
+                      else
+                        internalerror(2012072402);
+                    end;
+                  else
+                    internalerror(200610054);
                 end;
               end;
             looplist.clear;

compiler/dbgstabs.pas

@@ -1038,22 +1038,23 @@ implementation
               while assigned(anc.childof) do
                 begin
                   anc:=anc.childof;
-                  if (anc.dbg_state=dbg_state_writing) then
+                  case anc.dbg_state of
-                    { happens in case a field of a parent is of the (forward }
+                    dbg_state_writing:
-                    { defined) child type                                    }
+                      { happens in case a field of a parent is of the (forward
-                    begin
+                        defined) child type
-                      { We don't explicitly requeue it, but the fact that  }
+                      }
-                      { a child type was used in a parent before the child }
+                      begin
-                      { type was fully defined means that it was forward   }
+                        { We don't explicitly requeue it, but the fact that
-                      { declared, and will still be encountered later (it  }
+                          a child type was used in a parent before the child
-                      { cannot have been declared in another unit, because }
+                          type was fully defined means that it was forward
-                      { then this and that other unit would depend on      }
+                          declared, and will still be encountered later.
-                      { eachother's interface)                             }
+                          Setting the state to queued however allows us to
-                      { Setting the state to queued however allows us to   }
+                          get the def number already without an IE
-                      { get the def number already without an IE           }
+                        }
-                      def.dbg_state:=dbg_state_queued;
+                        def.dbg_state:=dbg_state_queued;
-                      exit;
+                        break;
-                    end;
+                      end;
+                  end;
                 end;
               appenddef(list,vmtarraytype);
               if assigned(tobjectdef(def).ImplementedInterfaces) then
@@ -1064,6 +1065,16 @@ implementation
               while assigned(anc.childof) do
                 begin
                   anc:=anc.childof;
+                  { in case this is an object family declared in another unit
+                    that was compiled without debug info, this ancestor may not
+                    yet have a stabs number and not yet be added to defstowrite
+                    -> take care of that now, while its dbg_state is still
+                    dbg_state_unused in case the aforementioned things haven't
+                    happened yet (afterwards it will become dbg_state_writing,
+                    and then def_stab_number() won't do anything anymore because
+                    it assumes it's already happened
+                  }
+                  def_stab_number(anc);
                   appenddef(list,anc);
                   if assigned(anc.ImplementedInterfaces) then
                     for i:=0 to anc.ImplementedInterfaces.Count-1 do

tests/test/packages/fcl-xml/tw22495.pp

@@ -0,0 +1,17 @@
+{ %norun }
+{ %cpu=i386,powerpc,arm,sparc,mips }
+{ %opt=-gs }
+
+{ Stabs is only supported for 32 bit targets }
+
+{$mode objfpc}
+
+program tw22495;
+
+uses uw22495;
+
+var cl:INode;
+
+begin
+end.
+

tests/test/packages/fcl-xml/uw22495.pp

@@ -0,0 +1,49 @@
+{$mode objfpc}
+
+unit uw22495;
+
+interface
+
+uses
+  DOM;
+
+type
+  TNode = class;
+
+  INode = interface
+  ['{DCE90E41-4D14-4BAE-9AFC-BA10FF643EA0}']
+    function GetChildNodes: TNode;           // if you delete this line, then the error disappears
+  end;
+
+  TNode = class(TInterfacedObject, INode)
+  protected
+    function GetChildNodes: TNode;
+    function xxx:TDomNode;                    // if you do either of the next points, then the error disappears:
+                                              // - exchange this line with the next one, or
+                                              // - delete this procedure (along with its body), or
+                                              // - make this procedure public
+    function getOwnerDocument: TDOMDocument;  // if you delete this procedure, then the error disappears
+  public
+  end;
+
+implementation
+
+{ TNode }
+
+function TNode.GetChildNodes: TNode;
+begin
+  Result:=nil;
+end;
+
+function TNode.xxx:TDomNode;
+begin
+  Result:=nil;
+end;
+
+function TNode.getOwnerDocument:TDOMDocument;
+begin
+  Result:=nil;
+end;
+
+end.
+