- removed global "resolving_forward" variable (was no longer used)

  * moved forward type checking from pdecl/symbase to symtable/symsym

git-svn-id: trunk@11763 -

compiler/globals.pas

@@ -244,7 +244,6 @@ interface
        block_type : tblock_type;         { type of currently parsed block }
 
        compile_level : word;
-       resolving_forward : boolean;      { used to add forward reference as second ref }
        exceptblockcounter    : integer;  { each except block gets a unique number check gotos      }
        current_exceptblock        : integer;  { the exceptblock number of the current block (0 if none) }
        LinkLibraryAliases : TLinkStrMap;
@@ -1255,7 +1254,6 @@ implementation
         do_make:=true;
         compile_level:=0;
         DLLsource:=false;
-        resolving_forward:=false;
         paratarget:=system_none;
         paratargetasm:=as_none;
         paratargetdbg:=dbg_none;

compiler/pdecl.pas

@@ -276,109 +276,6 @@ implementation
       end;
 
 
-    { search in symtablestack used, but not defined type }
-    procedure resolve_type_forward(p:TObject;arg:pointer);
-      var
-        hpd,pd : tdef;
-        stpos  : tfileposinfo;
-        again  : boolean;
-        srsym  : tsym;
-        srsymtable : TSymtable;
-
-      begin
-         { Check only typesyms or record/object fields }
-         case tsym(p).typ of
-           typesym :
-             pd:=ttypesym(p).typedef;
-           fieldvarsym :
-             pd:=tfieldvarsym(p).vardef
-           else
-             internalerror(2008090702);
-         end;
-         repeat
-           again:=false;
-           case pd.typ of
-             arraydef :
-               begin
-                 { elementdef could also be defined using a forwarddef }
-                 pd:=tarraydef(pd).elementdef;
-                 again:=true;
-               end;
-             pointerdef,
-             classrefdef :
-               begin
-                 { classrefdef inherits from pointerdef }
-                 hpd:=tabstractpointerdef(pd).pointeddef;
-                 { still a forward def ? }
-                 if hpd.typ=forwarddef then
-                  begin
-                    { try to resolve the forward }
-                    { get the correct position for it }
-                    stpos:=current_tokenpos;
-                    current_tokenpos:=tforwarddef(hpd).forwardpos;
-                    resolving_forward:=true;
-                    if not assigned(tforwarddef(hpd).tosymname) then
-                      internalerror(20021120);
-                    searchsym(tforwarddef(hpd).tosymname^,srsym,srsymtable);
-                    resolving_forward:=false;
-                    current_tokenpos:=stpos;
-                    { we don't need the forwarddef anymore, dispose it }
-                    hpd.free;
-                    tabstractpointerdef(pd).pointeddef:=nil; { if error occurs }
-                    { was a type sym found ? }
-                    if assigned(srsym) and
-                       (srsym.typ=typesym) then
-                     begin
-                       tabstractpointerdef(pd).pointeddef:=ttypesym(srsym).typedef;
-                       { avoid wrong unused warnings web bug 801 PM }
-                       inc(ttypesym(srsym).refs);
-                       { we need a class type for classrefdef }
-                       if (pd.typ=classrefdef) and
-                          not(is_class(ttypesym(srsym).typedef)) then
-                         Message1(type_e_class_type_expected,ttypesym(srsym).typedef.typename);
-                     end
-                    else
-                     begin
-                       MessagePos1(tsym(p).fileinfo,sym_e_forward_type_not_resolved,tsym(p).realname);
-                       { try to recover }
-                       tabstractpointerdef(pd).pointeddef:=generrordef;
-                     end;
-                  end;
-               end;
-             recorddef :
-               begin
-                 trecorddef(pd).symtable.forwardchecksyms.ForEachCall(@resolve_type_forward,nil);
-                 { don't free, may still be reused }
-                 trecorddef(pd).symtable.forwardchecksyms.clear;
-               end;
-             objectdef :
-               begin
-                 if not(m_fpc in current_settings.modeswitches) and
-                    (oo_is_forward in tobjectdef(pd).objectoptions) then
-                  begin
-                    { only give an error as the implementation may follow in an
-                      other type block which is allowed by FPC modes }
-                    MessagePos1(tsym(p).fileinfo,sym_e_forward_type_not_resolved,tsym(p).realname);
-                  end
-                 else
-                  begin
-                    { Check all fields of the object declaration, but don't
-                      check objectdefs in objects/records, because these
-                      can't exist (anonymous objects aren't allowed) }
-                    if not(tsym(p).owner.symtabletype in [ObjectSymtable,recordsymtable]) then
-                      begin
-                        tobjectdef(pd).symtable.forwardchecksyms.ForEachCall(@resolve_type_forward,nil);
-                        { don't free, may still be reused }
-                        tobjectdef(pd).symtable.forwardchecksyms.clear;
-                      end;
-                     
-                  end;
-               end;
-          end;
-        until not again;
-      end;
-
-
     procedure types_dec;
 
         function parse_generic_parameters:TFPObjectList;
@@ -473,7 +370,7 @@ implementation
                     { the definition is modified }
                     object_dec(orgtypename,nil,nil,tobjectdef(ttypesym(sym).typedef));
                     { since the definition is modified, there may be new forwarddefs }
-                    symtablestack.top.forwardchecksyms.add(sym);
+                    tstoredsymtable(symtablestack.top).checkforwardtype(sym);
                     newtype:=ttypesym(sym);
                     hdef:=newtype.typedef;
                   end
@@ -602,9 +499,7 @@ implementation
              generictypelist.free;
          until token<>_ID;
          typecanbeforward:=false;
-         symtablestack.top.forwardchecksyms.ForEachCall(@resolve_type_forward,nil);
-         { don't free, may still be reused }
-         symtablestack.top.forwardchecksyms.clear;
+         tstoredsymtable(symtablestack.top).resolve_forward_types;
          block_type:=old_block_type;
       end;
 

compiler/symbase.pas

@@ -92,7 +92,6 @@ interface
           realname  : pshortstring;
           DefList   : TFPObjectList;
           SymList   : TFPHashObjectList;
-          forwardchecksyms : TFPObjectList;
           defowner  : TDefEntry; { for records and objects }
           moduleid  : longint;
           refcount  : smallint;
@@ -105,8 +104,8 @@ interface
           function  getcopy:TSymtable;
           procedure clear;virtual;
           function  checkduplicate(var s:THashedIDString;sym:TSymEntry):boolean;virtual;
-          procedure insert(sym:TSymEntry;checkdup:boolean=true);
-          procedure Delete(sym:TSymEntry);
+          procedure insert(sym:TSymEntry;checkdup:boolean=true);virtual;
+          procedure Delete(sym:TSymEntry);virtual;
           function  Find(const s:TIDString) : TSymEntry;
           function  FindWithHash(const s:THashedIDString) : TSymEntry;virtual;
           procedure insertdef(def:TDefEntry);virtual;
@@ -220,8 +219,6 @@ implementation
          defowner:=nil;
          DefList:=TFPObjectList.Create(true);
          SymList:=TFPHashObjectList.Create(true);
-         { the syms are owned by symlist, so don't free }
-         forwardchecksyms:=TFPObjectList.Create(false);
          refcount:=1;
       end;
 
@@ -236,8 +233,6 @@ implementation
         { SymList can already be disposed or set to nil for withsymtable, }
         { but in that case Free does nothing                              }
         SymList.Free;
-        forwardchecksyms.free;
-        
         stringdispose(name);
         stringdispose(realname);
       end;
@@ -269,7 +264,6 @@ implementation
         i : integer;
       begin
          SymList.Clear;
-         forwardchecksyms.clear;
          { Prevent recursive calls between TDef.destroy and TSymtable.Remove }
          if DefList.OwnsObjects then
            begin
@@ -306,9 +300,6 @@ implementation
            sym.ChangeOwnerAndName(SymList,Copy(sym.realname,2,255))
          else
            sym.ChangeOwnerAndName(SymList,Upper(sym.realname));
-         { keep track of syms whose type may need forward resolving later on }
-         if (sym.typ in [typesym,fieldvarsym]) then
-           forwardchecksyms.add(sym);
          sym.Owner:=self;
       end;
 
@@ -317,8 +308,6 @@ implementation
       begin
         if sym.Owner<>self then
           internalerror(200611121);
-        if (sym.typ in [typesym,fieldvarsym]) then
-          forwardchecksyms.remove(sym);
         SymList.Remove(sym);
       end;
 

compiler/symsym.pas

@@ -46,6 +46,7 @@ interface
           constructor create(st:tsymtyp;const n : string);
           constructor ppuload(st:tsymtyp;ppufile:tcompilerppufile);
           destructor destroy;override;
+          procedure resolve_type_forward;
           procedure ppuwrite(ppufile:tcompilerppufile);virtual;
        end;
 
@@ -382,6 +383,96 @@ implementation
       end;
 
 
+    { Resolve forward defined types and give errors for non-resolved ones }
+    procedure tstoredsym.resolve_type_forward;
+      var
+        hpd,pd : tdef;
+        srsym  : tsym;
+        srsymtable : TSymtable;
+        again  : boolean;
+
+      begin
+         { Check only typesyms or record/object fields }
+         case typ of
+           typesym :
+             pd:=ttypesym(self).typedef;
+           fieldvarsym :
+             pd:=tfieldvarsym(self).vardef
+           else
+             internalerror(2008090702);
+         end;
+         repeat
+           again:=false;
+           case pd.typ of
+             arraydef :
+               begin
+                 { elementdef could also be defined using a forwarddef }
+                 pd:=tarraydef(pd).elementdef;
+                 again:=true;
+               end;
+             pointerdef,
+             classrefdef :
+               begin
+                 { classrefdef inherits from pointerdef }
+                 hpd:=tabstractpointerdef(pd).pointeddef;
+                 { still a forward def ? }
+                 if hpd.typ=forwarddef then
+                  begin
+                    { try to resolve the forward }
+                    if not assigned(tforwarddef(hpd).tosymname) then
+                      internalerror(20021120);
+                    searchsym(tforwarddef(hpd).tosymname^,srsym,srsymtable);
+                    { we don't need the forwarddef anymore, dispose it }
+                    hpd.free;
+                    tabstractpointerdef(pd).pointeddef:=nil; { if error occurs }
+                    { was a type sym found ? }
+                    if assigned(srsym) and
+                       (srsym.typ=typesym) then
+                     begin
+                       tabstractpointerdef(pd).pointeddef:=ttypesym(srsym).typedef;
+                       { avoid wrong unused warnings web bug 801 PM }
+                       inc(ttypesym(srsym).refs);
+                       { we need a class type for classrefdef }
+                       if (pd.typ=classrefdef) and
+                          not(is_class(ttypesym(srsym).typedef)) then
+                         MessagePos1(tsym(srsym).fileinfo,type_e_class_type_expected,ttypesym(srsym).typedef.typename);
+                     end
+                    else
+                     begin
+                       MessagePos1(fileinfo,sym_e_forward_type_not_resolved,realname);
+                       { try to recover }
+                       tabstractpointerdef(pd).pointeddef:=generrordef;
+                     end;
+                  end;
+               end;
+             recorddef :
+               begin
+                 tstoredsymtable(trecorddef(pd).symtable).resolve_forward_types;
+               end;
+             objectdef :
+               begin
+                 if not(m_fpc in current_settings.modeswitches) and
+                    (oo_is_forward in tobjectdef(pd).objectoptions) then
+                  begin
+                    { only give an error as the implementation may follow in an
+                      other type block which is allowed by FPC modes }
+                    MessagePos1(fileinfo,sym_e_forward_type_not_resolved,realname);
+                  end
+                 else
+                  begin
+                    { Check all fields of the object declaration, but don't
+                      check objectdefs in objects/records, because these
+                      can't exist (anonymous objects aren't allowed) }
+                    if not(owner.symtabletype in [ObjectSymtable,recordsymtable]) then
+                      tstoredsymtable(tobjectdef(pd).symtable).resolve_forward_types;
+                  end;
+               end;
+          end;
+        until not again;
+      end;
+
+
+
 {****************************************************************************
                                  TLABELSYM
 ****************************************************************************}

compiler/symtable.pas

@@ -46,6 +46,7 @@ interface
        tstoredsymtable = class(TSymtable)
        private
           b_needs_init_final : boolean;
+          forwardchecksyms : TFPObjectList;
           procedure _needs_init_final(sym:TObject;arg:pointer);
           procedure check_forward(sym:TObject;arg:pointer);
           procedure labeldefined(sym:TObject;arg:pointer);
@@ -58,6 +59,12 @@ interface
           procedure writedefs(ppufile:tcompilerppufile);
           procedure writesyms(ppufile:tcompilerppufile);
        public
+          constructor create(const s:string); reintroduce;
+          destructor destroy; override;
+          procedure clear;override;
+          procedure insert(sym:TSymEntry;checkdup:boolean=true);override;
+          procedure delete(sym:TSymEntry);override;
+          procedure checkforwardtype(sym:TSymEntry);
           { load/write }
           procedure ppuload(ppufile:tcompilerppufile);virtual;
           procedure ppuwrite(ppufile:tcompilerppufile);virtual;
@@ -70,6 +77,7 @@ interface
           procedure allsymbolsused;
           procedure allprivatesused;
           procedure check_forwards;
+          procedure resolve_forward_types;
           procedure checklabels;
           function  needs_init_final : boolean;
           procedure unchain_overloaded;
@@ -282,6 +290,56 @@ implementation
                              TStoredSymtable
 *****************************************************************************}
 
+    constructor tstoredsymtable.create(const s:string);
+      begin
+        inherited create(s);
+         { the syms are owned by symlist, so don't free }
+         forwardchecksyms:=TFPObjectList.Create(false);
+      end;
+
+
+    destructor tstoredsymtable.destroy;
+      begin
+        inherited destroy;
+        { must be after inherited destroy, because that one calls }
+        { clear which also clears forwardchecksyms                }
+        forwardchecksyms.free;
+      end;
+
+
+    procedure tstoredsymtable.clear;
+      begin
+        forwardchecksyms.clear;
+        inherited clear;
+      end;
+
+
+    procedure tstoredsymtable.insert(sym:TSymEntry;checkdup:boolean=true);
+      begin
+        inherited insert(sym,checkdup);
+        { keep track of syms whose type may need forward resolving later on }
+        if (sym.typ in [typesym,fieldvarsym]) then
+          forwardchecksyms.add(sym);
+      end;
+
+
+    procedure tstoredsymtable.delete(sym:TSymEntry);
+      begin
+        { this must happen before inherited() is called, because }
+        { the sym is owned by symlist and will consequently be   }
+        { freed and invalid afterwards                           }
+        if (sym.typ in [typesym,fieldvarsym]) then
+          forwardchecksyms.remove(sym);
+        inherited delete(sym);
+      end;
+
+
+    procedure tstoredsymtable.checkforwardtype(sym:TSymEntry);
+      begin
+        forwardchecksyms.add(sym);
+      end;
+
+
     procedure tstoredsymtable.ppuload(ppufile:tcompilerppufile);
       begin
         { load definitions }
@@ -721,6 +779,17 @@ implementation
       end;
 
 
+    procedure tstoredsymtable.resolve_forward_types;
+      var
+        i: longint;
+      begin
+        for i:=0 to forwardchecksyms.Count-1 do
+          tstoredsym(forwardchecksyms[i]).resolve_type_forward;
+        { don't free, may still be reused }
+        forwardchecksyms.clear;
+      end;
+
+
 {****************************************************************************
                           TAbstractRecordSymtable
 ****************************************************************************}