Added first version of class helper support (not fully working and not fully featured)

- tokens: added support for "helper" token
- symconst.tobjecttyp: added a new entry "odt_classhelper"
- symdef: added two functions to check whether a "tdef" instance is a class helper in general ("is_classhelper") or an Object Pascal class helper in particular ("is_objectpascal_classhelper")
- symdef.tobjectdef: added a new method "finish_classhelper" which calls "create_class_helper_for_procdef" for every method (maybe this can be used for Objective-C categories as well)
- symdef.tobjectdef.create: "ImplementedInterfaces" must be created for class helpers as well
- symtable.searchsym_in_class: class helper methods must be searched for Object Pascal classes as well (this is currently wrong, as those must be searched before the class symbols, but for a first test it's sufficient)
- ptype.read_named_type: "helper for" currently indicates a class helper ("for" should be checked inside "object_dec" though, as after "helper" there might be a parent class helper)
- pdecobj.parse_parent_classes: parse the name of the extended class and disable sealed check for those
- pdecobj.object_dec: "odt_classhelper" are changed to "odt_class" and "oo_is_classhelper" is added to the object options
- pdecl.types_dec: create class helper symbols by using "finish_classhelper"

git-svn-id: branches/svenbarth/classhelpers@16729 -

compiler/pdecl.pas

@@ -667,6 +667,9 @@ implementation
 
                     if is_cppclass(hdef) then
                       tobjectdef(hdef).finish_cpp_data;
+
+                    if is_objectpascal_classhelper(hdef) then
+                      tobjectdef(hdef).finish_classhelper;
                   end;
                 recorddef :
                   begin

compiler/pdecobj.pas

@@ -373,9 +373,11 @@ implementation
 
         { reads the parent class }
         if (token=_LKLAMMER) or
-           is_objccategory(current_objectdef) then
+           is_objccategory(current_objectdef) or
+           is_objectpascal_classhelper(current_objectdef) then
           begin
-            consume(_LKLAMMER);
+            if not is_objectpascal_classhelper(current_objectdef) then
+              consume(_LKLAMMER);
             { use single_type instead of id_type for specialize support }
             single_type(hdef,false,false);
             if (not assigned(hdef)) or
@@ -385,7 +387,10 @@ implementation
                   Message1(type_e_class_type_expected,hdef.typename)
                 else if is_objccategory(current_objectdef) then
                   { a category must specify the class to extend }
-                  Message(type_e_objcclass_type_expected);
+                  Message(type_e_objcclass_type_expected)
+                else if is_objectpascal_classhelper(current_objectdef) then
+                  { a class helper must specify the class to extend }
+                  Message(type_e_class_type_expected);
               end
             else
               begin
@@ -408,7 +413,8 @@ implementation
                             Message(parser_e_mix_of_classes_and_objects);
                        end
                      else
-                       if oo_is_sealed in childof.objectoptions then
+                       if (oo_is_sealed in childof.objectoptions) and
+                           not is_objectpascal_classhelper(current_objectdef) then
                          Message1(parser_e_sealed_descendant,childof.typename);
                    odt_interfacecorba,
                    odt_interfacecom:
@@ -512,7 +518,8 @@ implementation
                     handleImplementedProtocol(intfchildof);
                 readImplementedInterfacesAndProtocols(current_objectdef.objecttype=odt_class);
               end;
-            consume(_RKLAMMER);
+            if not is_objectpascal_classhelper(current_objectdef) then
+              consume(_RKLAMMER);
           end;
       end;
 
@@ -1049,6 +1056,13 @@ implementation
                 include(current_objectdef.objectoptions,oo_is_classhelper);
               end;
 
+            { change classhepers into Delphi type class helpers }
+            if (objecttype=odt_classhelper) then
+              begin
+                current_objectdef.objecttype:=odt_class;
+                include(current_objectdef.objectoptions,oo_is_classhelper);
+              end;
+
             { parse list of options (abstract / sealed) }
             parse_object_options;
 

compiler/ptype.pas

@@ -1368,6 +1368,13 @@ implementation
                     else
                       Message1(type_e_class_or_objcclass_type_expected,hdef.typename);
                   end
+                else
+                if (idtoken=_HELPER) then
+                  begin
+                    consume(_HELPER);
+                    consume(_FOR);
+                    def:=object_dec(odt_classhelper,name,genericdef,genericlist,nil);
+                  end
                 else
                   def:=object_dec(odt_class,name,genericdef,genericlist,nil);
               end;

compiler/symconst.pas

@@ -326,7 +326,8 @@ type
     odt_dispinterface,
     odt_objcclass,
     odt_objcprotocol,
-    odt_objccategory { note that these are changed into odt_class afterwards }
+    odt_objccategory, { note that these are changed into odt_class afterwards }
+    odt_classhelper
   );
 
   { Variations in interfaces implementation }

compiler/symdef.pas

@@ -311,6 +311,7 @@ interface
           procedure set_parent(c : tobjectdef);
           function find_destructor: tprocdef;
           function implements_any_interfaces: boolean;
+          procedure finish_classhelper;
           { dispinterface support }
           function get_next_dispid: longint;
           { enumerator support }
@@ -773,12 +774,14 @@ interface
     function is_object(def: tdef): boolean;
     function is_class(def: tdef): boolean;
     function is_cppclass(def: tdef): boolean;
+    function is_objectpascal_classhelper(def: tdef): boolean;
     function is_objcclass(def: tdef): boolean;
     function is_objcclassref(def: tdef): boolean;
     function is_objcprotocol(def: tdef): boolean;
     function is_objccategory(def: tdef): boolean;
     function is_objc_class_or_protocol(def: tdef): boolean;
     function is_objc_protocol_or_category(def: tdef): boolean;
+    function is_classhelper(def: tdef): boolean;
     function is_class_or_interface(def: tdef): boolean;
     function is_class_or_interface_or_objc(def: tdef): boolean;
     function is_class_or_interface_or_object(def: tdef): boolean;
@@ -4024,7 +4027,7 @@ implementation
         if objecttype in [odt_interfacecorba,odt_interfacecom,odt_dispinterface] then
           prepareguid;
         { setup implemented interfaces }
-        if objecttype in [odt_class,odt_objcclass,odt_objcprotocol] then
+        if objecttype in [odt_class,odt_objcclass,odt_objcprotocol,odt_classhelper] then
           ImplementedInterfaces:=TFPObjectList.Create(true)
         else
           ImplementedInterfaces:=nil;
@@ -4591,6 +4594,11 @@ implementation
           (assigned(childof) and childof.implements_any_interfaces);
       end;
 
+    procedure tobjectdef.finish_classhelper;
+      begin
+        self.symtable.DefList.foreachcall(@create_class_helper_for_procdef,nil);
+      end;
+
     function tobjectdef.size : aint;
       begin
         if objecttype in [odt_class,odt_interfacecom,odt_interfacecorba,odt_dispinterface,odt_objcclass,odt_objcprotocol] then
@@ -5418,6 +5426,19 @@ implementation
       end;
 
 
+    function is_objectpascal_classhelper(def: tdef): boolean;
+      begin
+        result:=
+          assigned(def) and
+          (def.typ=objectdef) and
+          { if used as a forward type }
+          ((tobjectdef(def).objecttype=odt_classhelper) or
+          { if used as after it has been resolved }
+           ((tobjectdef(def).objecttype=odt_class) and
+            (oo_is_classhelper in tobjectdef(def).objectoptions)));
+      end;
+
+
     function is_objcclassref(def: tdef): boolean;
       begin
         is_objcclassref:=
@@ -5467,6 +5488,12 @@ implementation
              (oo_is_classhelper in tobjectdef(def).objectoptions)));
       end;
 
+    function is_classhelper(def: tdef): boolean;
+      begin
+         result:=
+           is_objectpascal_classhelper(def) or
+           is_objccategory(def);
+      end;
 
     function is_class_or_interface(def: tdef): boolean;
       begin

compiler/symtable.pas

@@ -2135,7 +2135,7 @@ implementation
                 classh:=classh.childof;
               end;
           end;
-        if is_objcclass(orgclass) then
+        if is_objcclass(orgclass) or is_class(orgclass) then
           result:=search_class_helper(orgclass,s,srsym,srsymtable)
         else
           begin

compiler/tokens.pas

@@ -170,6 +170,7 @@ type
     _DOWNTO,
     _EXCEPT,
     _EXPORT,
+    _HELPER,
     _INLINE,
     _LEGACY,
     _NESTED,
@@ -464,6 +465,7 @@ const
       (str:'DOWNTO'        ;special:false;keyword:m_all;op:NOTOKEN),
       (str:'EXCEPT'        ;special:false;keyword:m_except;op:NOTOKEN),
       (str:'EXPORT'        ;special:false;keyword:m_none;op:NOTOKEN),
+      (str:'HELPER'        ;special:false;keyword:m_none;op:NOTOKEN),
       (str:'INLINE'        ;special:false;keyword:m_none;op:NOTOKEN),
       (str:'LEGACY'        ;special:false;keyword:m_none;op:NOTOKEN),   { Syscall variation on MorphOS }
       (str:'NESTED'        ;special:false;keyword:m_none;op:NOTOKEN),