* extract the code to parse a forward declaration out from types_dec into its own function parse_forward_declaration

compiler/pdecl.pas

@@ -31,7 +31,7 @@ interface
       { global }
       globtype,
       { symtable }
-      symsym,symdef,
+      symsym,symdef,symtype,
       { pass_1 }
       node;
 
@@ -47,6 +47,7 @@ interface
     procedure property_dec;
     procedure resourcestring_dec(out had_generic:boolean);
     procedure parse_rttiattributes(var rtti_attrs_def:trtti_attribute_list);
+    function parse_forward_declaration(sym:tsym;gentypename,genorgtypename:tidstring;generictypelist:tfphashobjectlist;out newtype:ttypesym):tdef;
 
 implementation
 
@@ -58,7 +59,7 @@ implementation
        globals,tokens,verbose,widestr,constexp,
        systems,aasmdata,fmodule,compinnr,
        { symtable }
-       symconst,symbase,symtype,symcpu,symcreat,defutil,defcmp,symtable,
+       symconst,symbase,symcpu,symcreat,defutil,defcmp,symtable,
        { pass 1 }
        ninl,ncon,nobj,ngenutil,nld,nmem,ncal,pass_1,
        { parser }
@@ -566,6 +567,67 @@ implementation
       end;
 
 
+    function parse_forward_declaration(sym:tsym;gentypename,genorgtypename:tidstring;generictypelist:tfphashobjectlist;out newtype:ttypesym):tdef;
+      var
+        wasforward : boolean;
+        objecttype : tobjecttyp;
+        gendef : tstoreddef;
+      begin
+        newtype:=nil;
+        wasforward:=false;
+        if ((token=_CLASS) or
+            (token=_INTERFACE) or
+            (token=_DISPINTERFACE) or
+            (token=_OBJCCLASS) or
+            (token=_OBJCPROTOCOL) or
+            (token=_OBJCCATEGORY)) and
+           (assigned(ttypesym(sym).typedef)) and
+           is_implicit_pointer_object_type(ttypesym(sym).typedef) and
+           (oo_is_forward in tobjectdef(ttypesym(sym).typedef).objectoptions) then
+         begin
+           wasforward:=true;
+           objecttype:=odt_none;
+           case token of
+             _CLASS :
+               objecttype:=default_class_type;
+             _INTERFACE :
+               case current_settings.interfacetype of
+                 it_interfacecom:
+                   objecttype:=odt_interfacecom;
+                 it_interfacecorba:
+                   objecttype:=odt_interfacecorba;
+                 it_interfacejava:
+                   objecttype:=odt_interfacejava;
+               end;
+             _DISPINTERFACE :
+               objecttype:=odt_dispinterface;
+             _OBJCCLASS,
+             _OBJCCATEGORY :
+               objecttype:=odt_objcclass;
+             _OBJCPROTOCOL :
+               objecttype:=odt_objcprotocol;
+             else
+               internalerror(200811072);
+           end;
+           consume(token);
+           { determine the generic def in case we are in a nested type
+             of a specialization }
+           gendef:=determine_generic_def(gentypename);
+           { we can ignore the result, the definition is modified }
+           object_dec(objecttype,genorgtypename,newtype,gendef,generictypelist,tobjectdef(ttypesym(sym).typedef),ht_none);
+           if wasforward and
+             (tobjectdef(ttypesym(sym).typedef).objecttype<>objecttype) then
+             Message1(type_e_forward_interface_type_does_not_match,tobjectdef(ttypesym(sym).typedef).GetTypeName);
+           newtype:=ttypesym(sym);
+           result:=newtype.typedef;
+         end
+        else
+          begin
+            message1(parser_h_type_redef,genorgtypename);
+            result:=generrordef;
+          end;
+      end;
+
     { From http://clang.llvm.org/docs/LanguageExtensions.html#objective-c-features :
       To determine whether a method has an inferred related result type, the first word in the camel-case selector
       (e.g., “init” in “initWithObjects”) is considered, and the method will have a related result type if its return
@@ -633,12 +695,10 @@ implementation
          defpos,storetokenpos : tfileposinfo;
          old_block_type : tblock_type;
          old_checkforwarddefs: TFPObjectList;
-         objecttype : tobjecttyp;
          first,
          isgeneric,
          isunique,
-         istyperenaming,
-         wasforward: boolean;
+         istyperenaming : boolean;
          generictypelist : tfphashobjectlist;
          localgenerictokenbuf : tdynamicarray;
          p:tnode;
@@ -745,55 +805,7 @@ implementation
                    (sp_generic_dummy in sym.symoptions)
                  ) then
                begin
-                 wasforward:=false;
-                 if ((token=_CLASS) or
-                     (token=_INTERFACE) or
-                     (token=_DISPINTERFACE) or
-                     (token=_OBJCCLASS) or
-                     (token=_OBJCPROTOCOL) or
-                     (token=_OBJCCATEGORY)) and
-                    (assigned(ttypesym(sym).typedef)) and
-                    is_implicit_pointer_object_type(ttypesym(sym).typedef) and
-                    (oo_is_forward in tobjectdef(ttypesym(sym).typedef).objectoptions) then
-                  begin
-                    wasforward:=true;
-                    objecttype:=odt_none;
-                    case token of
-                      _CLASS :
-                        objecttype:=default_class_type;
-                      _INTERFACE :
-                        case current_settings.interfacetype of
-                          it_interfacecom:
-                            objecttype:=odt_interfacecom;
-                          it_interfacecorba:
-                            objecttype:=odt_interfacecorba;
-                          it_interfacejava:
-                            objecttype:=odt_interfacejava;
-                        end;
-                      _DISPINTERFACE :
-                        objecttype:=odt_dispinterface;
-                      _OBJCCLASS,
-                      _OBJCCATEGORY :
-                        objecttype:=odt_objcclass;
-                      _OBJCPROTOCOL :
-                        objecttype:=odt_objcprotocol;
-                      else
-                        internalerror(200811072);
-                    end;
-                    consume(token);
-                    { determine the generic def in case we are in a nested type
-                      of a specialization }
-                    gendef:=determine_generic_def(gentypename);
-                    { we can ignore the result, the definition is modified }
-                    object_dec(objecttype,genorgtypename,newtype,gendef,generictypelist,tobjectdef(ttypesym(sym).typedef),ht_none);
-                    if wasforward and
-                      (tobjectdef(ttypesym(sym).typedef).objecttype<>objecttype) then
-                      Message1(type_e_forward_interface_type_does_not_match,tobjectdef(ttypesym(sym).typedef).GetTypeName);
-                    newtype:=ttypesym(sym);
-                    hdef:=newtype.typedef;
-                  end
-                 else
-                  message1(parser_h_type_redef,genorgtypename);
+                 hdef:=parse_forward_declaration(sym,gentypename,genorgtypename,generictypelist,newtype);
                end;
             end;
            { no old type reused ? Then insert this new type }