* refactor the forward type declaration handling, remove

    global typecanbeforward and move 'class of ..' parsing
    to ptype

git-svn-id: trunk@12045 -

compiler/fmodule.pas

@@ -125,6 +125,7 @@ interface
         derefmapsize  : longint;  { number of units in the map }
         derefdataintflen : longint;
         derefdata     : tdynamicarray;
+        checkforwarddefs,
         deflist,
         symlist       : TFPObjectList;
         globalsymtable,           { pointer to the global symtable of this unit }
@@ -487,6 +488,7 @@ implementation
         derefdataintflen:=0;
         deflist:=TFPObjectList.Create(false);
         symlist:=TFPObjectList.Create(false);
+        checkforwarddefs:=TFPObjectList.Create(false);
         globalsymtable:=nil;
         localsymtable:=nil;
         globalmacrosymtable:=nil;
@@ -593,6 +595,7 @@ implementation
         derefdata.free;
         deflist.free;
         symlist.free;
+        checkforwarddefs.free;
         if assigned(globalsymtable) then
           globalsymtable.free;
         if assigned(localsymtable) then
@@ -667,6 +670,8 @@ implementation
         deflist:=TFPObjectList.Create(false);
         symlist.free;
         symlist:=TFPObjectList.Create(false);
+        checkforwarddefs.free;
+        checkforwarddefs:=TFPObjectList.Create(false);
         derefdata.free;
         derefdata:=TDynamicArray.Create(1024);
         if assigned(unitmap) then

compiler/globtype.pas

@@ -262,7 +262,7 @@ interface
 
        { currently parsed block type }
        tblock_type = (bt_none,
-         bt_general,bt_type,bt_const,bt_except,bt_body
+         bt_general,bt_type,bt_const,bt_const_type,bt_var,bt_var_type,bt_except,bt_body
        );
 
        { Temp types }

compiler/nadd.pas

@@ -774,11 +774,10 @@ implementation
            end;
 
 
-         { Kylix allows enum+ordconstn in an enum declaration (blocktype
-           is bt_type), we need to do the conversion here before the
-           constant folding }
+         { Kylix allows enum+ordconstn in an enum type declaration, we need to do
+           the conversion here before the constant folding }
          if (m_delphi in current_settings.modeswitches) and
-            (blocktype=bt_type) then
+            (blocktype in [bt_type,bt_const_type,bt_var_type]) then
           begin
             if (left.resultdef.typ=enumdef) and
                (right.resultdef.typ=orddef) then

compiler/ncal.pas

@@ -2360,7 +2360,7 @@ implementation
 
           { handle predefined procedures }
           is_const:=(po_internconst in procdefinition.procoptions) and
-                    ((block_type in [bt_const,bt_type]) or
+                    ((block_type in [bt_const,bt_type,bt_const_type,bt_var_type]) or
                      (assigned(left) and (tcallparanode(left).left.nodetype in [realconstn,ordconstn])));
           if (procdefinition.proccalloption=pocall_internproc) or is_const then
            begin
@@ -2765,7 +2765,7 @@ implementation
          if assigned(callcleanupblock) then
            firstpass(callcleanupblock);
 
-         if not (block_type in [bt_const,bt_type]) then
+         if not (block_type in [bt_const,bt_type,bt_const_type,bt_var_type]) then
            include(current_procinfo.flags,pi_do_call);
 
          { order parameters }

compiler/pdecl.pas

@@ -194,7 +194,7 @@ implementation
                 begin
                    { set the blocktype first so a consume also supports a
                      caret, to support const s : ^string = nil }
-                   block_type:=bt_type;
+                   block_type:=bt_const_type;
                    consume(_COLON);
                    read_anon_type(hdef,false);
                    block_type:=bt_const;
@@ -302,6 +302,7 @@ implementation
          hdef     : tdef;
          defpos,storetokenpos : tfileposinfo;
          old_block_type : tblock_type;
+         objecttype : tobjecttyp;
          isgeneric,
          isunique,
          istyperenaming : boolean;
@@ -311,7 +312,6 @@ implementation
       begin
          old_block_type:=block_type;
          block_type:=bt_type;
-         typecanbeforward:=true;
          repeat
            defpos:=current_tokenpos;
            istyperenaming:=false;
@@ -366,11 +366,22 @@ implementation
                     is_class_or_interface_or_dispinterface(ttypesym(sym).typedef) and
                     (oo_is_forward in tobjectdef(ttypesym(sym).typedef).objectoptions) then
                   begin
-                    { we can ignore the result   }
-                    { 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.checkforwardtype(sym);
+                    case token of
+                      _CLASS :
+                        objecttype:=odt_class;
+                      _INTERFACE :
+                        if current_settings.interfacetype=it_interfacecom then
+                          objecttype:=odt_interfacecom
+                        else
+                          objecttype:=odt_interfacecorba;
+                      _DISPINTERFACE :
+                        objecttype:=odt_dispinterface;
+                      else
+                        internalerror(200811072);
+                    end;
+                    consume(token);
+                    { we can ignore the result, the definition is modified }
+                    object_dec(objecttype,orgtypename,nil,nil,tobjectdef(ttypesym(sym).typedef));
                     newtype:=ttypesym(sym);
                     hdef:=newtype.typedef;
                   end
@@ -498,8 +509,7 @@ implementation
            if assigned(generictypelist) then
              generictypelist.free;
          until token<>_ID;
-         typecanbeforward:=false;
-         tstoredsymtable(symtablestack.top).resolve_forward_types;
+         resolve_forward_types;
          block_type:=old_block_type;
       end;
 

compiler/pdecobj.pas

@@ -27,19 +27,19 @@ interface
 
     uses
       cclasses,
-      globtype,symtype,symdef;
+      globtype,symconst,symtype,symdef;
 
     { parses a object declaration }
-    function object_dec(const n:tidstring;genericdef:tstoreddef;genericlist:TFPObjectList;fd : tobjectdef) : tdef;
+    function object_dec(objecttype:tobjecttyp;const n:tidstring;genericdef:tstoreddef;genericlist:TFPObjectList;fd : tobjectdef) : tdef;
 
 implementation
 
     uses
       cutils,
       globals,verbose,systems,tokens,
-      symconst,symbase,symsym,symtable,
+      symbase,symsym,symtable,
       node,nld,nmem,ncon,ncnv,ncal,
-      scanner,
+      fmodule,scanner,
       pbase,pexpr,pdecsub,pdecvar,ptype,pdecl
       ;
 
@@ -155,57 +155,6 @@ implementation
       end;
 
 
-    function readobjecttype : tobjecttyp;
-      begin
-        result:=odt_none;
-        { distinguish classes and objects }
-        case token of
-          _OBJECT:
-            begin
-              result:=odt_object;
-              consume(_OBJECT)
-            end;
-          _CPPCLASS:
-            begin
-              result:=odt_cppclass;
-              consume(_CPPCLASS);
-            end;
-          _DISPINTERFACE:
-            begin
-              { need extra check here since interface is a keyword
-                in all pascal modes }
-              if not(m_class in current_settings.modeswitches) then
-                Message(parser_f_need_objfpc_or_delphi_mode);
-              result:=odt_dispinterface;
-              consume(_DISPINTERFACE);
-            end;
-          _INTERFACE:
-            begin
-              { need extra check here since interface is a keyword
-                in all pascal modes }
-              if not(m_class in current_settings.modeswitches) then
-                Message(parser_f_need_objfpc_or_delphi_mode);
-              if current_settings.interfacetype=it_interfacecom then
-                result:=odt_interfacecom
-              else {it_interfacecorba}
-                result:=odt_interfacecorba;
-              consume(_INTERFACE);
-            end;
-          _CLASS:
-            begin
-              result:=odt_class;
-              consume(_CLASS);
-            end;
-          else
-            begin
-              { this is error but try to recover }
-              result:=odt_class;
-              consume(_OBJECT);
-            end;
-        end;
-      end;
-
-
     procedure handleImplementedInterface(intfdef : tobjectdef);
       begin
         if not is_interface(intfdef) then
@@ -392,68 +341,6 @@ implementation
       end;
 
 
-    function try_parse_class_forward_decl:boolean;
-      begin
-        result:=false;
-        if (token<>_SEMICOLON) then
-          exit;
-
-        if (cs_compilesystem in current_settings.moduleswitches) then
-          begin
-            case current_objectdef.objecttype of
-              odt_interfacecom :
-                if (current_objectdef.objname^='IUNKNOWN') then
-                  interface_iunknown:=current_objectdef;
-              odt_class :
-                if (current_objectdef.objname^='TOBJECT') then
-                  class_tobject:=current_objectdef;
-            end;
-          end;
-
-        { enable published? }
-        if (cs_generate_rtti in current_settings.localswitches) and
-           (current_objectdef.objecttype in [odt_interfacecom,odt_class]) then
-          include(current_objectdef.objectoptions,oo_can_have_published);
-
-        { all classes must have a vmt at offset zero }
-        if current_objectdef.objecttype=odt_class then
-          current_objectdef.insertvmt;
-
-        result:=true;
-      end;
-
-
-    function try_parse_class_reference:tdef;
-      var
-        hdef : tdef;
-      begin
-        result:=nil;
-        { Delphi only allows class of in type blocks.
-          Note that when parsing the type of a variable declaration
-          the blocktype is bt_type so the check for typecanbeforward
-          is also necessary (PFV) }
-        if (token<>_OF) or
-           (
-            (m_delphi in current_settings.modeswitches) and
-            not((block_type=bt_type) and typecanbeforward)
-           ) then
-          exit;
-
-        consume(_OF);
-        single_type(hdef,typecanbeforward);
-
-        { must be a forward def or a class }
-        if (hdef.typ=forwarddef) or
-           is_class(hdef) then
-          result:=tclassrefdef.create(hdef)
-        else
-          begin
-            Message1(type_e_class_type_expected,generrordef.typename);
-            result:=generrordef;
-          end;
-      end;
-
-
     procedure insert_generic_parameter_types(genericdef:tstoreddef;genericlist:TFPObjectList);
       var
         i : longint;
@@ -745,18 +632,15 @@ implementation
       end;
 
 
-    function object_dec(const n:tidstring;genericdef:tstoreddef;genericlist:TFPObjectList;fd : tobjectdef) : tdef;
+    function object_dec(objecttype:tobjecttyp;const n:tidstring;genericdef:tstoreddef;genericlist:TFPObjectList;fd : tobjectdef) : tdef;
       label
         myexit;
       var
-        objecttype : tobjecttyp;
         old_object_option : tsymoptions;
-        old_typecanbeforward : boolean;
         old_current_objectdef : tobjectdef;
       begin
         old_object_option:=current_object_option;
         old_current_objectdef:=current_objectdef;
-        old_typecanbeforward:=typecanbeforward;
 
         current_objectdef:=nil;
 
@@ -765,13 +649,6 @@ implementation
            not assigned(genericlist) then
           Message(parser_e_no_local_objects);
 
-        { for tp7 don't allow forward types }
-        if (m_tp7 in current_settings.modeswitches) then
-          typecanbeforward:=false;
-
-        { get type of objectdef }
-        objecttype:=readobjecttype;
-
         { reuse forward objectdef? }
         if assigned(fd) then
           begin
@@ -787,14 +664,6 @@ implementation
           end
         else
           begin
-            { Handle class of ... class references }
-            if objecttype=odt_class then
-              begin
-                result:=try_parse_class_reference;
-                if assigned(result) then
-                  goto myexit;
-              end;
-
             { anonym objects aren't allow (o : object a : longint; end;) }
             if n='' then
               Message(parser_f_no_anonym_objects);
@@ -806,30 +675,47 @@ implementation
               added. This is to prevent circular childof loops }
             include(current_objectdef.objectoptions,oo_is_forward);
 
-            { is this a forward declaration? }
-            if try_parse_class_forward_decl then
+            if (cs_compilesystem in current_settings.moduleswitches) then
               begin
-                result:=current_objectdef;
-                goto myexit;
+                case current_objectdef.objecttype of
+                  odt_interfacecom :
+                    if (current_objectdef.objname^='IUNKNOWN') then
+                      interface_iunknown:=current_objectdef;
+                  odt_class :
+                    if (current_objectdef.objname^='TOBJECT') then
+                      class_tobject:=current_objectdef;
+                end;
               end;
           end;
 
         { set published flag in $M+ mode, it can also be inherited and will
           be added when the parent class set with tobjectdef.set_parent (PFV) }
-        if (cs_generate_rtti in current_settings.localswitches) then
+        if (cs_generate_rtti in current_settings.localswitches) and
+           (current_objectdef.objecttype in [odt_interfacecom,odt_class]) then
           include(current_objectdef.objectoptions,oo_can_have_published);
 
-        { parse list of parent classes }
-        parse_parent_classes;
+        { forward def? }
+        if not assigned(fd) and
+           (token=_SEMICOLON) then
+          begin
+            { add to the list of definitions to check that the forward
+              is resolved. this is required for delphi mode }
+            current_module.checkforwarddefs.add(current_objectdef);
+          end
+        else
+          begin
+            { parse list of parent classes }
+            parse_parent_classes;
 
-        { parse optional GUID for interfaces }
-        parse_guid;
+            { parse optional GUID for interfaces }
+            parse_guid;
 
-        { parse and insert object members }
-        symtablestack.push(current_objectdef.symtable);
-        insert_generic_parameter_types(genericdef,genericlist);
-        parse_object_members;
-        symtablestack.pop(current_objectdef.symtable);
+            { parse and insert object members }
+            symtablestack.push(current_objectdef.symtable);
+            insert_generic_parameter_types(genericdef,genericlist);
+            parse_object_members;
+            symtablestack.pop(current_objectdef.symtable);
+          end;
 
         { generate vmt space if needed }
         if not(oo_has_vmt in current_objectdef.objectoptions) and
@@ -848,7 +734,6 @@ implementation
       myexit:
         { restore old state }
         current_objectdef:=old_current_objectdef;
-        typecanbeforward:=old_typecanbeforward;
         current_object_option:=old_object_option;
       end;
 

compiler/pdecsub.pas

@@ -409,7 +409,7 @@ implementation
         { the variables are always public }
         current_object_option:=[sp_public];
         inc(testcurobject);
-        block_type:=bt_type;
+        block_type:=bt_var;
         repeat
           parseprocvar:=pv_none;
           if try_to_consume(_VAR) then
@@ -467,8 +467,10 @@ implementation
                parse_parameter_dec(pv);
              if parseprocvar=pv_func then
               begin
+                block_type:=bt_var_type;
                 consume(_COLON);
                 single_type(pv.returndef,false);
+                block_type:=bt_var;
               end;
              hdef:=pv;
              { possible proc directives }
@@ -517,7 +519,11 @@ implementation
                 if try_to_consume(_TYPE) then
                   hdef:=ctypedformaltype
                 else
-                  single_type(hdef,false);
+                  begin
+                    block_type:=bt_var_type;
+                    single_type(hdef,false);
+                    block_type:=bt_var;
+                  end;
 
                 { open string ? }
                 if (varspez in [vs_out,vs_var]) and
@@ -2269,9 +2275,9 @@ const
                     if s<>'' then
                       begin
                         { Replace ? and @ in import name }
-                        { these replaces broke existing code on i386-win32 at least, while fixed 
+                        { these replaces broke existing code on i386-win32 at least, while fixed
                           bug 8391 on arm-wince so limit this to arm-wince (KB) }
-                        if target_info.system in [system_arm_wince] then 
+                        if target_info.system in [system_arm_wince] then
                           begin
                             Replace(s,'?','__q$$');
                             Replace(s,'@','__a$$');
@@ -2437,7 +2443,7 @@ const
              because a constant/default value follows }
            if res then
             begin
-              if (block_type in [bt_const,bt_type]) and
+              if (block_type=bt_const_type) and
                  (token=_EQUAL) then
                break;
               { support procedure proc;stdcall export; }

compiler/pdecvar.pas

@@ -633,7 +633,7 @@ implementation
            begin
               p.default:=longint($80000000);
            end;
-  
+
          { Parse possible "implements" keyword }
          if try_to_consume(_IMPLEMENTS) then
            begin
@@ -1065,7 +1065,7 @@ implementation
          { all variables are public if not in a object declaration }
          current_object_option:=[sp_public];
          old_block_type:=block_type;
-         block_type:=bt_type;
+         block_type:=bt_var;
          { Force an expected ID error message }
          if not (token in [_ID,_CASE,_END]) then
            consume(_ID);
@@ -1098,6 +1098,9 @@ implementation
                  end;
                consume(_ID);
              until not try_to_consume(_COMMA);
+
+             { read variable type def }
+             block_type:=bt_var_type;
              consume(_COLON);
 
 {$ifdef gpc_mode}
@@ -1107,13 +1110,13 @@ implementation
                read_gpc_name(sc);
 {$endif}
 
-             { read variable type def }
              read_anon_type(hdef,false);
              for i:=0 to sc.count-1 do
                begin
                  vs:=tabstractvarsym(sc[i]);
                  vs.vardef:=hdef;
                end;
+             block_type:=bt_var;
 
              { Process procvar directives }
              if maybe_parse_proc_directives(hdef) then
@@ -1218,7 +1221,6 @@ implementation
       var
          sc : TFPObjectList;
          i  : longint;
-         old_block_type : tblock_type;
          old_current_object_option : tsymoptions;
          hs,sorg : string;
          hdef,casetype : tdef;
@@ -1253,8 +1255,6 @@ implementation
          { all variables are public if not in a object declaration }
          if not(vd_object in options) then
           current_object_option:=[sp_public];
-         old_block_type:=block_type;
-         block_type:=bt_type;
          { Force an expected ID error message }
          if not (token in [_ID,_CASE,_END]) then
           consume(_ID);
@@ -1519,7 +1519,6 @@ implementation
               trecordsymtable(recst).insertunionst(Unionsymtable,offset);
               uniondef.owner.deletedef(uniondef);
            end;
-         block_type:=old_block_type;
          current_object_option:=old_current_object_option;
          { free the list }
          sc.free;

compiler/pexpr.pas

@@ -1485,7 +1485,7 @@ implementation
                                 { For a type block we simply return only
                                   the type. For all other blocks we return
                                   a loadvmt node }
-                                if not(block_type in [bt_type]) then
+                                if not(block_type in [bt_type,bt_const_type,bt_var_type]) then
                                   p1:=cloadvmtaddrnode.create(p1);
                               end;
                            end
@@ -2159,7 +2159,7 @@ implementation
            again:=true;
            { Handle references to self }
            if (idtoken=_SELF) and
-              not(block_type in [bt_const,bt_type]) and
+              not(block_type in [bt_const,bt_type,bt_const_type,bt_var_type]) and
               assigned(current_procinfo) and
               assigned(current_procinfo.procdef._class) then
              begin

compiler/ptype.pas

@@ -29,15 +29,13 @@ interface
        globtype,cclasses,
        symtype,symdef,symbase;
 
-    const
-       { forward types should only be possible inside a TYPE statement }
-       typecanbeforward : boolean = false;
-
     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 }
     procedure id_type(var def : tdef;isforwarddef:boolean);
 
@@ -77,6 +75,72 @@ implementation
        pbase,pexpr,pdecsub,pdecvar,pdecobj;
 
 
+    procedure resolve_forward_types;
+      var
+        i: longint;
+        hpd,
+        def : tdef;
+        srsym  : tsym;
+        srsymtable : TSymtable;
+        hs : string;
+      begin
+        for i:=0 to current_module.checkforwarddefs.Count-1 do
+          begin
+            def:=tdef(current_module.checkforwarddefs[i]);
+            case def.typ of
+              pointerdef,
+              classrefdef :
+                begin
+                  { classrefdef inherits from pointerdef }
+                  hpd:=tabstractpointerdef(def).pointeddef;
+                  { still a forward def ? }
+                  if hpd.typ=forwarddef then
+                   begin
+                     { try to resolve the forward }
+                     if not assigned(tforwarddef(hpd).tosymname) then
+                       internalerror(200211201);
+                     hs:=tforwarddef(hpd).tosymname^;
+                     searchsym(upper(hs),srsym,srsymtable);
+                     { we don't need the forwarddef anymore, dispose it }
+                     hpd.free;
+                     tabstractpointerdef(def).pointeddef:=nil; { if error occurs }
+                     { was a type sym found ? }
+                     if assigned(srsym) and
+                        (srsym.typ=typesym) then
+                      begin
+                        tabstractpointerdef(def).pointeddef:=ttypesym(srsym).typedef;
+                        { avoid wrong unused warnings web bug 801 PM }
+                        inc(ttypesym(srsym).refs);
+                        { we need a class type for classrefdef }
+                        if (def.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
+                        Message1(sym_e_forward_type_not_resolved,hs);
+                        { try to recover }
+                        tabstractpointerdef(def).pointeddef:=generrordef;
+                      end;
+                   end;
+                end;
+              objectdef :
+                begin
+                  { give an error as the implementation may follow in an
+                    other type block which is allowed by FPC modes }
+                  if not(m_fpc in current_settings.modeswitches) and
+                     (oo_is_forward in tobjectdef(def).objectoptions) then
+                    MessagePos1(def.typesym.fileinfo,type_e_type_is_not_completly_defined,def.typename);
+                 end;
+              else
+                internalerror(200811071);
+            end;
+          end;
+        current_module.checkforwarddefs.clear;
+      end;
+
+
+
     procedure generate_specialization(var tt:tdef);
       var
         st  : TSymtable;
@@ -321,10 +385,10 @@ implementation
          { are we parsing a possible forward def ? }
          if isforwarddef and
             not(is_unit_specific) then
-          begin
-            def:=tforwarddef.create(s,pos);
-            exit;
-          end;
+           begin
+             def:=tforwarddef.create(sorg,pos);
+             exit;
+           end;
          { unknown sym ? }
          if not assigned(srsym) then
           begin
@@ -431,7 +495,6 @@ implementation
 
       var
          recst : trecordsymtable;
-         storetypecanbeforward : boolean;
          old_object_option : tsymoptions;
       begin
          { create recdef }
@@ -443,13 +506,8 @@ implementation
          consume(_RECORD);
          old_object_option:=current_object_option;
          current_object_option:=[sp_public];
-         storetypecanbeforward:=typecanbeforward;
-         { for tp7 don't allow forward types }
-         if m_tp7 in current_settings.modeswitches then
-           typecanbeforward:=false;
          read_record_fields([vd_record]);
          consume(_END);
-         typecanbeforward:=storetypecanbeforward;
          current_object_option:=old_object_option;
          { make the record size aligned }
          recst.addalignmentpadding;
@@ -764,6 +822,7 @@ implementation
 
       var
         p  : tnode;
+        hdef : tdef;
         pd : tabstractprocdef;
         is_func,
         enumdupmsg, first : boolean;
@@ -848,8 +907,10 @@ implementation
            _CARET:
               begin
                 consume(_CARET);
-                single_type(tt2,typecanbeforward);
+                single_type(tt2,(block_type=bt_type));
                 def:=tpointerdef.create(tt2);
+                if tt2.typ=forwarddef then
+                  current_module.checkforwarddefs.add(def);
               end;
             _RECORD:
               begin
@@ -874,20 +935,79 @@ implementation
                       current_settings.packrecords:=1
                     else
                       current_settings.packrecords:=bit_alignment;
-                    if token in [_CLASS,_OBJECT] then
-                      def:=object_dec(name,genericdef,genericlist,nil)
-                    else
-                      def:=record_dec;
+                    case token of
+                      _CLASS :
+                        begin
+                          consume(_CLASS);
+                          def:=object_dec(odt_class,name,genericdef,genericlist,nil);
+                        end;
+                      _OBJECT :
+                        begin
+                          consume(_OBJECT);
+                          def:=object_dec(odt_object,name,genericdef,genericlist,nil);
+                        end;
+                      else
+                        def:=record_dec;
+                    end;
                     current_settings.packrecords:=oldpackrecords;
                   end;
               end;
-            _DISPINTERFACE,
-            _CLASS,
-            _CPPCLASS,
-            _INTERFACE,
-            _OBJECT:
+            _DISPINTERFACE :
+              begin
+                { need extra check here since interface is a keyword
+                  in all pascal modes }
+                if not(m_class in current_settings.modeswitches) then
+                  Message(parser_f_need_objfpc_or_delphi_mode);
+                consume(token);
+                def:=object_dec(odt_dispinterface,name,genericdef,genericlist,nil);
+              end;
+            _CLASS :
+              begin
+                consume(token);
+                { Delphi only allows class of in type blocks }
+                if (token=_OF) and
+                   (
+                    not(m_delphi in current_settings.modeswitches) or
+                    (block_type=bt_type)
+                   ) then
+                  begin
+                    consume(_OF);
+                    single_type(hdef,(block_type=bt_type));
+                    if is_class(hdef) then
+                      def:=tclassrefdef.create(hdef)
+                    else
+                      if hdef.typ=forwarddef then
+                        begin
+                          def:=tclassrefdef.create(hdef);
+                          current_module.checkforwarddefs.add(def);
+                        end
+                    else
+                      Message1(type_e_class_type_expected,hdef.typename);
+                  end
+                else
+                  def:=object_dec(odt_class,name,genericdef,genericlist,nil);
+              end;
+            _CPPCLASS :
               begin
-                def:=object_dec(name,genericdef,genericlist,nil);
+                consume(token);
+                def:=object_dec(odt_cppclass,name,genericdef,genericlist,nil);
+              end;
+            _INTERFACE :
+              begin
+                { need extra check here since interface is a keyword
+                  in all pascal modes }
+                if not(m_class in current_settings.modeswitches) then
+                  Message(parser_f_need_objfpc_or_delphi_mode);
+                consume(token);
+                if current_settings.interfacetype=it_interfacecom then
+                  def:=object_dec(odt_interfacecom,name,genericdef,genericlist,nil)
+                else {it_interfacecorba}
+                  def:=object_dec(odt_interfacecorba,name,genericdef,genericlist,nil);
+              end;
+            _OBJECT :
+              begin
+                consume(token);
+                def:=object_dec(odt_object,name,genericdef,genericlist,nil);
               end;
             _PROCEDURE,
             _FUNCTION:

compiler/scanner.pas

@@ -3615,7 +3615,7 @@ In case not, the value returned can be arbitrary.
                   begin
                     readchar;
                     c:=upcase(c);
-                    if (block_type in [bt_type]) or
+                    if (block_type in [bt_type,bt_const_type,bt_var_type]) or
                        (lasttoken=_ID) or (lasttoken=_NIL) or (lasttoken=_OPERATOR) or
                        (lasttoken=_RKLAMMER) or (lasttoken=_RECKKLAMMER) or (lasttoken=_CARET) then
                      begin
@@ -3855,7 +3855,7 @@ In case not, the value returned can be arbitrary.
              '>' :
                begin
                  readchar;
-                 if (block_type in [bt_type]) then
+                 if (block_type in [bt_type,bt_var_type,bt_const_type]) then
                    token:=_RSHARPBRACKET
                  else
                    begin
@@ -3887,7 +3887,7 @@ In case not, the value returned can be arbitrary.
              '<' :
                begin
                  readchar;
-                 if (block_type in [bt_type]) then
+                 if (block_type in [bt_type,bt_var_type,bt_const_type]) then
                    token:=_LSHARPBRACKET
                  else
                    begin

compiler/symbase.pas

@@ -87,8 +87,6 @@ interface
 ************************************************}
 
        TSymtable = class
-       protected
-          forwardchecksyms : TFPObjectList;
        public
           name      : pshortstring;
           realname  : pshortstring;
@@ -106,7 +104,6 @@ interface
           function  getcopy:TSymtable;
           procedure clear;virtual;
           function  checkduplicate(var s:THashedIDString;sym:TSymEntry):boolean;virtual;
-          procedure checkforwardtype(sym:TSymEntry);
           procedure insert(sym:TSymEntry;checkdup:boolean=true);virtual;
           procedure Delete(sym:TSymEntry);virtual;
           function  Find(const s:TIDString) : TSymEntry;
@@ -222,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;
 
@@ -238,7 +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 +263,6 @@ implementation
       var
         i : integer;
       begin
-         forwardchecksyms.clear;
          SymList.Clear;
          { Prevent recursive calls between TDef.destroy and TSymtable.Remove }
          if DefList.OwnsObjects then
@@ -287,12 +280,6 @@ implementation
       end;
 
 
-    procedure TSymtable.checkforwardtype(sym:TSymEntry);
-      begin
-        forwardchecksyms.add(sym);
-      end;
-
-
     procedure TSymtable.insert(sym:TSymEntry;checkdup:boolean=true);
       var
         hashedid : THashedIDString;

compiler/symsym.pas

@@ -46,7 +46,6 @@ 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;
 
@@ -383,96 +382,6 @@ 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

@@ -72,7 +72,6 @@ interface
           procedure allsymbolsused;
           procedure allprivatesused;
           procedure check_forwards;
-          procedure resolve_forward_types;
           procedure checklabels;
           function  needs_init_final : boolean;
           procedure unchain_overloaded;
@@ -288,19 +287,11 @@ implementation
     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;
 
@@ -744,17 +735,6 @@ 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
 ****************************************************************************}
@@ -1094,11 +1074,6 @@ implementation
             def:=TDef(unionst.DefList[i]);
             def.ChangeOwner(self);
           end;
-        { add the types that may need to be forward-checked }
-        forwardchecksyms.capacity:=forwardchecksyms.capacity+unionst.forwardchecksyms.count;
-        for i:=0 to unionst.forwardchecksyms.count-1 do
-          forwardchecksyms.add(tsym(unionst.forwardchecksyms[i]));
-        unionst.forwardchecksyms.clear;
         _datasize:=storesize;
         fieldalignment:=storealign;
       end;