Commit of a completely restructured helper implementation. Instead of changing objectdefs with odt_classhelper to odt_class, they'll have the odt_helper type assigned to and this will be kept. This also implies that the parent of a helper is its true parent while the extended type is set to a field in tobjectdef (extendeddef).

This change became necessary of the following reasons:
- Records don't support inheritance, thus for "record helpers" some creativity would have been necessary to implement them; with the new implementation this is more easily
- the new approach allows for easy checks regarding virtual methods and their overrides which would have been more complicated in the old variant
- if someone feels the need the types of helpers (object, interface) can be added rather easily
- unnecessary things like VMT generation can be disabled now

details:
- msg*: 
* moved some messages from parser to type
* adjusted a message ("class helper" => "helper")
- symdef.pas:
* renamed "helperparent" to "extendeddef" and changed its type from "tobjectdef" to "tabstractrecorddef", so records can be extended as well (somewhen in the near future)
* removed "finish_class_helper" method as it isn't necessary (luckily I haven't yet adjusted the ObjC variant)
* changed name of "is_objectpascal_classhelper" to "is_objectpascal_helper" to reflect that this function applies to all helper types
* tobjectdef.create: ImplementedInterfaces isn't created for odt_helper anymore
* tobjectdef.alignment: for helpers it's the same as for classes although this shouldn't be used anywhere...
* tobjectdef.vmtmethodoffset: set to 0 for helpers to be sure...
* tobjectdef.needs_inittable: not needed for helpers (no fields allowed)
* is_objectpascal_helper: only needs check for "odt_helper" object type
- symconst.pas:
* changed odt_classhelper to more general odt_helper
* added new type "thelpertype" which is used to check that "(record|class) helper" corresponds with the given extended type (as Delphi XE checks this as well this strict solution can be kept for modes Delphi and ObjFPC)
- symtable.pas:
* extended "searchsym_in_class" with the possibility to disable the search for helper methods (needed for inherited) => this implies changing all occurences of "searchsym_in_class" with a "true" except some special locations
* renamed "search_objectpascal_classhelper" to "search_objectpascal_helper"
* searchsym_in_class: 
** when an extended method is defined with "overload" it can be that a same named method of the extended class might be called (sadly this means that this search was unnecessary...)
** contextclassh is the def of the helper in the case of an inherited call inside the helper's implementation
** when methods inside a helper are searched, it must be searched in the extended type first
- ptype.pas:
* single_type is used to parse the parent of a helper as well, so allow a helper if the stoParseClassParent is given (needs check in pdecobj.pas/parse_class_parents for normal classes)
* read_named_type: currently the only case when something <> ht_none is passed to the modified parse_objdec (see below) is when the combination "class helper" is encountered ("record helper" will be another one)
- pinline.pas: adjustment for extended "searchsym_in_class"
- pexpr.pas:
* adjustments regarding "searchsym_in_class" and "is_objectpascal_helper"
* factor/factor_read_id: moved the check for "TSomeClassType.SomeMethod" outside of the "is_class" check
* factor: 
** in case of an inherited we need to search inside the extended type first (Note: this needs to be extended to find methods in the helper parent if no method is found in the extended type)
** we also need to disable the search for helper methods when searching for an inherited method (Note: it might be better to introduce a enum to decide whether a helper method should search before or after the methods of the extended type or even never)
- pdecsub.pas:
* insert_self_and_vmt_para: in a helper the type of Self is of the extended type
* pd_abstract, pd_final: more nice error message
* pd_override, pd_message, pd_reintroduce: adjusted checks because now "is_class" is no longer true for helpers
* proc_direcdata: allowed "abstract" for helpers (only to produce a more nice error message)
* parse_proc_direc: adjustment because of "is_objectpascal_helper"
- pdecobj.pas:
* adjustments regarding "is_objectpascal_helper"
* adjusted object_dec to take the type of the helper (class, record) as a parameter to be able to check whether the correct extended type was given
* struct_property_dec: properties are allowed in helpers
* parse_object_options: nothing to be parsed for helpers (at least I hope so ^^)
* parse_parent_classes: 
** the parent of a helper is now parsed as a normal parent, the extended type is parsed in an extra procedure
** check for "sealed" no longer needed
** added check that the parsed parent of a helper is indeed a helper
** allow to parse the closing ")" of the helper's parent
* parse_extended_class:
** new procedure that parses the type which is extended
** it checks that the extended type is a class for "class helper" and a record for "record helper"
** it checks that a helper extends the same class or a subclass for class helpers
** it checks that a helper extends the same record for record helpers
* parse_object_members:
** "type", "const", "var" is allowed in helpers
** don't exclude flags regarding virtual methods, they are needed for the checks in mode Delphi (this implies that VMT loading must be disabled for helpers)
* object_dec:
** don't change "odt_helper" to "odt_class", but still include the "oo_is_classhelper" flag
** allow the parsing of object options (there are none)
** parse the extended type for helpers
- pdecl.pas
* adjustment because of extension of object_dec
* types_dec: remove the call to finish_classhelper
- objcdef.pas
* objcaddencodedtype, objcdochecktype: add references to helpers as implicit pointers although that should not be used in any way...
- nld.pas
* tloadnode.pass_typecheck: self is a reference to the extended type
- nflw.pas
* create_for_in_loop: adjustment because of changed procedure and inheritance type
- ncgrtti.pas
* TRTTIWriter.write_rtti_data: disable for helpers for now (I need to check what Delphi does here)
- ncgld.pas
* tcgloadnode.pass_generate_code: virtual methods of helpers are treated as normal methods
- ncgcal.pas
* tcgcallnode.pass_generate_code: virtual methods of helpers are treated as normal methods
- ncal.pas
* tcallnode.pass_typecheck: adjust for extension of tcallcandidates constructor
- htypechk.pas
* tcallcandidates declaration: extend some methods to (dis)allow the search for helper methods (needed for inherited)
* tcallcandidates.collect_overloads_in_struct: 
** search first in helpers for methods and stop if none carries the "overload" flag
** move the addition of the procsyms to an extra nested procedure because it's used for helper methods and normal struct methods

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

compiler/htypechk.pas

@@ -67,12 +67,12 @@ interface
         FParaNode   : tnode;
         FParaLength : smallint;
         FAllowVariant : boolean;
-        procedure collect_overloads_in_struct(structdef:tabstractrecorddef;ProcdefOverloadList:TFPObjectList);
+        procedure collect_overloads_in_struct(structdef:tabstractrecorddef;ProcdefOverloadList:TFPObjectList;searchhelpers:boolean);
         procedure collect_overloads_in_units(ProcdefOverloadList:TFPObjectList; objcidcall,explicitunit: boolean);
-        procedure create_candidate_list(ignorevisibility,allowdefaultparas,objcidcall,explicitunit:boolean);
+        procedure create_candidate_list(ignorevisibility,allowdefaultparas,objcidcall,explicitunit,searchhelpers:boolean);
         function  proc_add(st:tsymtable;pd:tprocdef;objcidcall: boolean):pcandidate;
       public
-        constructor create(sym:tprocsym;st:TSymtable;ppn:tnode;ignorevisibility,allowdefaultparas,objcidcall,explicitunit:boolean);
+        constructor create(sym:tprocsym;st:TSymtable;ppn:tnode;ignorevisibility,allowdefaultparas,objcidcall,explicitunit,searchhelpers:boolean);
         constructor create_operator(op:ttoken;ppn:tnode);
         destructor destroy;override;
         procedure list(all:boolean);
@@ -1758,7 +1758,7 @@ implementation
                            TCallCandidates
 ****************************************************************************}
 
-    constructor tcallcandidates.create(sym:tprocsym;st:TSymtable;ppn:tnode;ignorevisibility,allowdefaultparas,objcidcall,explicitunit:boolean);
+    constructor tcallcandidates.create(sym:tprocsym;st:TSymtable;ppn:tnode;ignorevisibility,allowdefaultparas,objcidcall,explicitunit,searchhelpers:boolean);
       begin
         if not assigned(sym) then
           internalerror(200411015);
@@ -1766,7 +1766,7 @@ implementation
         FProcsym:=sym;
         FProcsymtable:=st;
         FParanode:=ppn;
-        create_candidate_list(ignorevisibility,allowdefaultparas,objcidcall,explicitunit);
+        create_candidate_list(ignorevisibility,allowdefaultparas,objcidcall,explicitunit,searchhelpers);
       end;
 
 
@@ -1776,7 +1776,7 @@ implementation
         FProcsym:=nil;
         FProcsymtable:=nil;
         FParanode:=ppn;
-        create_candidate_list(false,false,false,false);
+        create_candidate_list(false,false,false,false,false);
       end;
 
 
@@ -1795,19 +1795,63 @@ implementation
       end;
 
 
-    procedure tcallcandidates.collect_overloads_in_struct(structdef:tabstractrecorddef;ProcdefOverloadList:TFPObjectList);
+    procedure tcallcandidates.collect_overloads_in_struct(structdef:tabstractrecorddef;ProcdefOverloadList:TFPObjectList;searchhelpers:boolean);
+
+      function processprocsym(srsym:tprocsym):boolean;
+        var
+          j  : integer;
+          pd : tprocdef;
+        begin
+          { Store first procsym found }
+          if not assigned(FProcsym) then
+            FProcsym:=srsym;
+          { add all definitions }
+          result:=false;
+          for j:=0 to srsym.ProcdefList.Count-1 do
+            begin
+              pd:=tprocdef(srsym.ProcdefList[j]);
+              if po_overload in pd.procoptions then
+                result:=true;
+              ProcdefOverloadList.Add(srsym.ProcdefList[j]);
+            end;
+        end;
+
       var
-        j          : integer;
-        pd         : tprocdef;
         srsym      : tsym;
         hashedid   : THashedIDString;
         hasoverload : boolean;
+        helperdef  : tobjectdef;
       begin
         if FOperator=NOTOKEN then
           hashedid.id:=FProcsym.name
         else
           hashedid.id:=overloaded_names[FOperator];
         hasoverload:=false;
+        { first search for potential symbols in the class helpers (this is
+          disabled in an inherited call if the method is available in the
+          extended class) }
+        if is_class(structdef) then
+          if search_last_objectpascal_helper(tobjectdef(structdef), helperdef) and searchhelpers then
+            begin
+              srsym:=nil;
+              while assigned(helperdef) do
+                begin
+                  srsym:=tsym(helperdef.symtable.FindWithHash(hashedid));
+                  if assigned(srsym) and
+                      { Delphi allows hiding a property by a procedure with the same name }
+                      (srsym.typ=procsym) then
+                    begin
+                      hasoverload := processprocsym(tprocsym(srsym));
+                      { when there is no explicit overload we stop searching }
+                      if not hasoverload then
+                        break;
+                    end;
+                  helperdef:=helperdef.childof;
+                end;
+              if not hasoverload and assigned(srsym) then
+                exit;
+            end;
+        { now search in the class and its parents or the record }
         while assigned(structdef) do
          begin
            srsym:=tprocsym(structdef.symtable.FindWithHash(hashedid));
@@ -1815,18 +1859,7 @@ implementation
               { Delphi allows hiding a property by a procedure with the same name }
               (srsym.typ=procsym) then
              begin
-               { Store first procsym found }
+               hasoverload:=processprocsym(tprocsym(srsym));
-               if not assigned(FProcsym) then
-                 FProcsym:=tprocsym(srsym);
-               { add all definitions }
-               hasoverload:=false;
-               for j:=0 to tprocsym(srsym).ProcdefList.Count-1 do
-                 begin
-                   pd:=tprocdef(tprocsym(srsym).ProcdefList[j]);
-                   if po_overload in pd.procoptions then
-                     hasoverload:=true;
-                   ProcdefOverloadList.Add(tprocsym(srsym).ProcdefList[j]);
-                 end;
                { when there is no explicit overload we stop searching }
                if not hasoverload then
                  break;
@@ -1911,7 +1944,7 @@ implementation
       end;
 
 
-    procedure tcallcandidates.create_candidate_list(ignorevisibility,allowdefaultparas,objcidcall,explicitunit:boolean);
+    procedure tcallcandidates.create_candidate_list(ignorevisibility,allowdefaultparas,objcidcall,explicitunit,searchhelpers:boolean);
       var
         j     : integer;
         pd    : tprocdef;
@@ -1929,7 +1962,7 @@ implementation
         if not objcidcall and
            (FOperator=NOTOKEN) and
            (FProcsym.owner.symtabletype in [objectsymtable,recordsymtable]) then
-          collect_overloads_in_struct(tabstractrecorddef(FProcsym.owner.defowner),ProcdefOverloadList)
+          collect_overloads_in_struct(tabstractrecorddef(FProcsym.owner.defowner),ProcdefOverloadList,searchhelpers)
         else
         if (FOperator<>NOTOKEN) then
           begin
@@ -1939,7 +1972,7 @@ implementation
             while assigned(pt) do
               begin
                 if (pt.resultdef.typ=recorddef) then
-                  collect_overloads_in_struct(tabstractrecorddef(pt.resultdef),ProcdefOverloadList);
+                  collect_overloads_in_struct(tabstractrecorddef(pt.resultdef),ProcdefOverloadList,searchhelpers);
                 pt:=tcallparanode(pt.right);
               end;
             collect_overloads_in_units(ProcdefOverloadList,objcidcall,explicitunit);

compiler/msg/errore.msg

@@ -368,7 +368,7 @@ scanner_w_illegal_warn_identifier=02087_W_Illegal identifier "$1" for $WARN dire
 #
 # Parser
 #
-# 03307 is the last used one
+# 03305 is the last used one
 #
 % \section{Parser messages}
 % This section lists all parser messages. The parser takes care of the
@@ -917,9 +917,9 @@ parser_e_no_access_specifier_in_interfaces=03172_E_Access specifiers can't be us
 % The access specifiers \var{public}, \var{private}, \var{protected} and
 % \var{published} can't be used in interfaces, Objective-C protocols and categories because all methods
 % of an interface/protocol/category must be public.
-parser_e_no_vars_in_interfaces=03173_E_An interface or class helper or Objective-C protocol or category cannot contain fields
+parser_e_no_vars_in_interfaces=03173_E_An interface, helper or Objective-C protocol or category cannot contain fields
-% Declarations of fields are not allowed in interfaces, class helpers and Objective-C protocols and categories.
+% Declarations of fields are not allowed in interfaces, helpers and Objective-C protocols and categories.
-% An interface/class helper/protocol/category can contain only methods and properties with method read/write specifiers.
+% An interface/helper/protocol/category can contain only methods and properties with method read/write specifiers.
 parser_e_no_local_proc_external=03174_E_Can't declare local procedure as EXTERNAL
 % Declaring local procedures as external is not possible. Local procedures
 % get hidden parameters that will make the chance of errors very high.
@@ -1368,18 +1368,13 @@ parser_e_at_least_one_argument_must_be_of_type=03303_E_Either the result or at l
 parser_e_cant_use_type_parameters_here=03304_E_Type parameters may require initialization/finalization - can't be used in variant records
 % Type parameters may be specialized with types which (e.g. \var{ansistring}) need initialization/finalization
 % code which is implicitly generated by the compiler.
-parser_e_classhelper_id_expected=03305_E_Class helper identifier expected
+parser_e_not_allowed_in_classhelper=03305_E_"$1" is not allowed in class helpers
-% A class helper can only inherit from another class helper.
-parser_e_classhelper_must_extend_subclass=03306_E_Derived class helper must extend a subclass of the class extended by the parent class helper
-% When a class helper inherits from another class helper the extended class must
-% extend either the same class as the parent class helper or a subclass of it
-parser_e_not_allowed_in_classhelper=03307_E_"$1" is not allowed in class helpers
 % Some directives and specifiers like "virtual", "dynamic", "published" aren't
 % allowed inside class helpers in mode ObjFPC (they are ignored in mode Delphi).
 % \end{description}
 # Type Checking
 #
-# 04095 is the last used one
+# 04100 is the last used one
 #
 % \section{Type checking errors}
 % This section lists all errors that can occur when type checking is
@@ -1727,6 +1722,16 @@ type_e_type_parameters_are_not_allowed_here=04097_E_Type parameters are not allo
 % Type parameters are only allowed for methods of generic classes, records or objects
 type_e_generic_declaration_does_not_match=04098_E_Generic declaration of "$1" differs from previous declaration
 % Generic declaration does not match the previous declaration
+type_e_helper_type_expected=04099_E_Helper type expected
+% The compiler expected a \var{class helper} type.
+type_e_record_type_expected=04100_E_Record type expected
+% The compiler expected a \var{record} type.
+type_e_class_helper_must_extend_subclass=04101_E_Derived class helper must extend a subclass of "$1" or the class itself
+% If a class helper inherits from another class helper the extended class must
+% extend either the same class as the parent class helper or a subclass of it
+type_e_record_helper_must_extend_same_record=04102_E_Derived record helper must extend "$1"
+% If a record helper inherits from another record helper it must extend the same
+% record that the parent record helper extended.
 %
 % \end{description}
 #

compiler/msgidx.inc

@@ -393,9 +393,7 @@ const
   parser_e_no_constructor_in_records=03302;
   parser_e_at_least_one_argument_must_be_of_type=03303;
   parser_e_cant_use_type_parameters_here=03304;
-  parser_e_classhelper_id_expected=03305;
+  parser_e_not_allowed_in_classhelper=03305;
-  parser_e_classhelper_must_extend_subclass=03306;
-  parser_e_not_allowed_in_classhelper=03307;
   type_e_mismatch=04000;
   type_e_incompatible_types=04001;
   type_e_not_equal_types=04002;
@@ -485,6 +483,10 @@ const
   type_e_generics_cannot_reference_itself=04096;
   type_e_type_parameters_are_not_allowed_here=04097;
   type_e_generic_declaration_does_not_match=04098;
+  type_e_helper_type_expected=04099;
+  type_e_record_type_expected=04100;
+  type_e_class_helper_must_extend_subclass=04101;
+  type_e_record_helper_must_extend_same_record=04102;
   sym_e_id_not_found=05000;
   sym_f_internal_error_in_symtablestack=05001;
   sym_e_duplicate_id=05002;
@@ -885,9 +887,9 @@ const
   option_info=11024;
   option_help_pages=11025;
 
-  MsgTxtSize = 58938;
+  MsgTxtSize = 58973;
 
   MsgIdxMax : array[1..20] of longint=(
-    24,88,308,99,84,54,111,22,202,63,
+    24,88,306,103,84,54,111,22,202,63,
     49,20,1,1,1,1,1,1,1,1
   );

compiler/ncal.pas

@@ -2693,7 +2693,7 @@ implementation
                   { ignore possible private for properties or in delphi mode for anon. inherited (FK) }
                   ignorevisibility:=(nf_isproperty in flags) or
                                     ((m_delphi in current_settings.modeswitches) and (cnf_anon_inherited in callnodeflags));
-                  candidates:=tcallcandidates.create(symtableprocentry,symtableproc,left,ignorevisibility,not(nf_isproperty in flags),cnf_objc_id_call in callnodeflags,cnf_unit_specified in callnodeflags);
+                  candidates:=tcallcandidates.create(symtableprocentry,symtableproc,left,ignorevisibility,not(nf_isproperty in flags),cnf_objc_id_call in callnodeflags,cnf_unit_specified in callnodeflags,callnodeflags*[cnf_anon_inherited,cnf_inherited]=[]);
 
                    { no procedures found? then there is something wrong
                      with the parameter size or the procedures are

compiler/ncgcal.pas

@@ -708,6 +708,7 @@ implementation
                a pointer. We can directly call the correct procdef (PFV) }
              if (name_to_call='') and
                 (po_virtualmethod in procdefinition.procoptions) and
+                not is_objectpascal_helper(tprocdef(procdefinition).struct) and
                 assigned(methodpointer) and
                 (methodpointer.nodetype<>typen) and
                 not wpoinfomanager.can_be_devirtualized(methodpointer.resultdef,procdefinition,name_to_call) then

compiler/ncgld.pas

@@ -496,7 +496,8 @@ implementation
 
                      { virtual method ? }
                      if (po_virtualmethod in procdef.procoptions) and
-                        not(nf_inherited in flags) then
+                        not(nf_inherited in flags) and
+                        not is_objectpascal_helper(procdef.struct) then
                        begin
                          if (not assigned(current_procinfo) or
                              wpoinfomanager.symbol_live(current_procinfo.procdef.mangledname)) then

compiler/ncgrtti.pas

@@ -920,7 +920,9 @@ implementation
                 recorddef_rtti(trecorddef(def));
             end;
           objectdef :
-            objectdef_rtti(tobjectdef(def));
+            // TODO : check whether Delphi generates RTTI for helpers
+            if not is_objectpascal_helper(def) then
+              objectdef_rtti(tobjectdef(def));
           else
             unknown_rtti(tstoreddef(def));
         end;

compiler/nflw.pas

@@ -866,10 +866,10 @@ implementation
                     { first search using the class helper hierarchy if it's a
                       class }
                     if (expr.resultdef.typ=objectdef) and
-                        search_last_objectpascal_classhelper(tobjectdef(expr.resultdef),classhelper) then
+                        search_last_objectpascal_helper(tobjectdef(expr.resultdef),classhelper) then
                       repeat
                         pd:=classhelper.search_enumerator_get;
-                        classhelper:=classhelper.helperparent;
+                        classhelper:=classhelper.childof;
                       until (pd<>nil) or (classhelper=nil);
                     { we didn't found a class helper, so search in the
                       class/record/object itself }

compiler/nld.pas

@@ -302,6 +302,8 @@ implementation
                if vo_is_self in tabstractvarsym(symtableentry).varoptions then
                  begin
                    resultdef:=tprocdef(symtableentry.owner.defowner).struct;
+                   if is_objectpascal_helper(resultdef) then
+                     resultdef:=tobjectdef(resultdef).extendeddef;
                    if (po_classmethod in tprocdef(symtableentry.owner.defowner).procoptions) or
                       (po_staticmethod in tprocdef(symtableentry.owner.defowner).procoptions) then
                      resultdef:=tclassrefdef.create(resultdef)

compiler/objcdef.pas

@@ -374,13 +374,14 @@ implementation
             encodedstr:=encodedstr+'^?';
           objectdef :
             case tobjectdef(def).objecttype of
+              odt_helper,
               odt_class,
               odt_object,
               odt_cppclass:
                 begin
                   newstate:=recordinfostate;
                   { implicit pointer for classes }
-                  if (tobjectdef(def).objecttype=odt_class) then
+                  if (tobjectdef(def).objecttype in [odt_class,odt_helper]) then
                     begin
                       encodedstr:=encodedstr+'^';
                       { make all classes opaque, so even if they contain a
@@ -593,13 +594,14 @@ implementation
             ;
           objectdef :
             case tobjectdef(def).objecttype of
+              odt_helper,
               odt_class,
               odt_object,
               odt_cppclass:
                 begin
                   newstate:=recordinfostate;
                   { implicit pointer for classes }
-                  if (tobjectdef(def).objecttype=odt_class) then
+                  if (tobjectdef(def).objecttype in [odt_class,odt_helper]) then
                     begin
                       { make all classes opaque, so even if they contain a
                         reference-counted field there is no problem. Since a

compiler/pdecl.pas

@@ -500,7 +500,7 @@ implementation
                     end;
                     consume(token);
                     { we can ignore the result, the definition is modified }
-                    object_dec(objecttype,orgtypename,nil,nil,tobjectdef(ttypesym(sym).typedef));
+                    object_dec(objecttype,orgtypename,nil,nil,tobjectdef(ttypesym(sym).typedef),ht_none);
                     newtype:=ttypesym(sym);
                     hdef:=newtype.typedef;
                   end
@@ -630,9 +630,6 @@ 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

@@ -30,7 +30,7 @@ interface
       globtype,symconst,symtype,symdef;
 
     { parses a object declaration }
-    function object_dec(objecttype:tobjecttyp;const n:tidstring;genericdef:tstoreddef;genericlist:TFPObjectList;fd : tobjectdef) : tobjectdef;
+    function object_dec(objecttype:tobjecttyp;const n:tidstring;genericdef:tstoreddef;genericlist:TFPObjectList;fd : tobjectdef;helpertype:thelpertype) : tobjectdef;
 
     function class_constructor_head:tprocdef;
     function class_destructor_head:tprocdef;
@@ -118,8 +118,8 @@ implementation
       var
         p : tpropertysym;
       begin
-        { check for a class or record }
+        { check for a class, record or helper }
-        if not((is_class_or_interface_or_dispinterface(current_structdef) or is_record(current_structdef)) or
+        if not((is_class_or_interface_or_dispinterface(current_structdef) or is_record(current_structdef) or is_objectpascal_helper(current_structdef)) or
            (not(m_tp7 in current_settings.modeswitches) and (is_object(current_structdef)))) then
           Message(parser_e_syntax_error);
         consume(_PROPERTY);
@@ -422,6 +422,7 @@ implementation
             get_cpp_class_external_status(current_objectdef);
           odt_objcclass,odt_objcprotocol,odt_objccategory:
             get_objc_class_or_protocol_external_status(current_objectdef);
+          odt_helper: ; // nothing
         end;
       end;
 
@@ -436,31 +437,11 @@ implementation
         intfchildof:=nil;
         hasparentdefined:=false;
 
-        { the "parent" of a class helper is not really treated as its parent;
-          it's only used to extend the searched scope }
-        if is_objectpascal_classhelper(current_structdef) then
-          begin
-            if try_to_consume(_LKLAMMER) then
-              begin
-                { TODO : check what these flags mean }
-                single_type(hdef,[stoAllowTypeDef, stoParseClassParent]);
-                if not is_objectpascal_classhelper(hdef) then
-                  begin
-                    Message(parser_e_classhelper_id_expected);
-                    hdef:=nil;
-                  end;
-                current_objectdef.helperparent:=tobjectdef(hdef);
-                consume(_RKLAMMER);
-              end;
-            consume(_FOR);
-          end;
-
         { reads the parent class }
         if (token=_LKLAMMER) or
-           is_classhelper(current_structdef) then
+           is_objccategory(current_structdef) then
           begin
-            if not is_objectpascal_classhelper(current_structdef) then
+            consume(_LKLAMMER);
-              consume(_LKLAMMER);
             { use single_type instead of id_type for specialize support }
             single_type(hdef,[stoAllowSpecialization, stoParseClassParent]);
             if (not assigned(hdef)) or
@@ -470,10 +451,7 @@ implementation
                   Message1(type_e_class_type_expected,hdef.typename)
                 else if is_objccategory(current_structdef) 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
@@ -496,8 +474,7 @@ implementation
                             Message(parser_e_mix_of_classes_and_objects);
                        end
                      else
-                       if (oo_is_sealed in childof.objectoptions) and
+                       if oo_is_sealed in childof.objectoptions then
-                           not is_objectpascal_classhelper(current_structdef) then
                          Message1(parser_e_sealed_descendant,childof.typename);
                    odt_interfacecorba,
                    odt_interfacecom:
@@ -545,6 +522,12 @@ implementation
                          Message1(parser_e_sealed_descendant,childof.typename);
                    odt_dispinterface:
                      Message(parser_e_dispinterface_cant_have_parent);
+                   odt_helper:
+                     if not is_objectpascal_helper(childof) then
+                       begin
+                         Message(type_e_helper_type_expected);
+                         childof:=nil;
+                       end;
                 end;
               end;
             hasparentdefined:=true;
@@ -584,8 +567,7 @@ implementation
         { remove forward flag, is resolved }
         exclude(current_structdef.objectoptions,oo_is_forward);
 
-        if hasparentdefined and
+        if hasparentdefined then
-            not is_objectpascal_classhelper(current_structdef) then
           begin
             if current_objectdef.objecttype in [odt_class,odt_objcclass,odt_objcprotocol] then
               begin
@@ -600,6 +582,62 @@ implementation
           end;
       end;
 
+    procedure parse_extended_class(helpertype:thelpertype);
+      var
+        hdef: tdef;
+      begin
+        if not is_objectpascal_helper(current_structdef) then
+          Internalerror(2011021103);
+        if helpertype=ht_none then
+          Internalerror(2011021001);
+
+        consume(_FOR);
+        single_type(hdef,[stoAllowTypeDef,stoParseClassParent]);
+        if (not assigned(hdef)) or
+           not (hdef.typ in [objectdef,recorddef]) then
+          begin
+            if helpertype=ht_class then
+              Message1(type_e_class_type_expected,hdef.typename)
+            else
+            if helpertype=ht_record then
+              Message1(type_e_record_type_expected,hdef.typename);
+          end
+        else
+          begin
+            case helpertype of
+              ht_class:
+                begin
+                  if not is_class(hdef) then
+                    Message1(type_e_class_type_expected,hdef.typename);
+                  { a class helper must extend the same class or a subclass
+                    of the class extended by the parent class helper }
+                  if assigned(current_objectdef.childof) then
+                    begin
+                      if not is_class(current_objectdef.childof.extendeddef) then
+                        Internalerror(2011021101);
+                      if not hdef.is_related(current_objectdef.childof.extendeddef) then
+                        Message1(type_e_class_helper_must_extend_subclass,current_objectdef.childof.extendeddef.typename);
+                    end;
+                end;
+              ht_record:
+                begin
+                  if not is_record(hdef) then
+                    Message1(type_e_record_type_expected,hdef.typename);
+                  { a record helper must extend the same record as the
+                    parent helper }
+                  if assigned(current_objectdef.childof) then
+                    begin
+                      if not is_record(current_objectdef.childof.extendeddef) then
+                        Internalerror(2011021102);
+                      if hdef<>current_objectdef.childof.extendeddef then
+                        Message1(type_e_record_helper_must_extend_same_record,current_objectdef.childof.extendeddef.typename);
+                    end;
+                end;
+            end;
+
+            current_objectdef.extendeddef:=tabstractrecorddef(hdef);
+          end;
+      end;
 
     procedure parse_guid;
       begin
@@ -675,14 +713,14 @@ implementation
           case token of
             _TYPE :
               begin
-                if not(current_objectdef.objecttype in [odt_class,odt_object]) then
+                if not(current_objectdef.objecttype in [odt_class,odt_object,odt_helper]) then
                   Message(parser_e_type_var_const_only_in_records_and_classes);
                 consume(_TYPE);
                 object_member_blocktype:=bt_type;
               end;
             _VAR :
               begin
-                if not(current_objectdef.objecttype in [odt_class,odt_object]) then
+                if not(current_objectdef.objecttype in [odt_class,odt_object,odt_helper]) then
                   Message(parser_e_type_var_const_only_in_records_and_classes);
                 consume(_VAR);
                 fields_allowed:=true;
@@ -692,7 +730,7 @@ implementation
               end;
             _CONST:
               begin
-                if not(current_objectdef.objecttype in [odt_class,odt_object]) then
+                if not(current_objectdef.objecttype in [odt_class,odt_object,odt_helper]) then
                   Message(parser_e_type_var_const_only_in_records_and_classes);
                 consume(_CONST);
                 object_member_blocktype:=bt_const;
@@ -801,7 +839,7 @@ implementation
                           begin
                             if is_interface(current_structdef) or
                                is_objc_protocol_or_category(current_structdef) or
-                               is_objectpascal_classhelper(current_structdef) then
+                               is_objectpascal_helper(current_structdef) then
                               Message(parser_e_no_vars_in_interfaces);
 
                             if (current_structdef.symtable.currentvisibility=vis_published) and
@@ -877,13 +915,6 @@ implementation
                     if (m_mac in current_settings.modeswitches) then
                       include(pd.procoptions,po_virtualmethod);
 
-                    { for class helpers virtual, final, override make no sense,
-                      so they are rejected in mode ObjFPC (in pdecsub) and
-                      ignored in mode Delphi (here)
-                    }
-                    if is_objectpascal_classhelper(current_structdef) then
-                      pd.procoptions:=pd.procoptions-[po_virtualmethod,po_finalmethod,po_overridingmethod];
-
                     handle_calling_convention(pd);
 
                     { add definition to procsym }
@@ -965,7 +996,7 @@ implementation
                   Message(parser_e_no_con_des_in_interfaces);
 
                 { (class) destructors are not allowed in class helpers }
-                if is_objectpascal_classhelper(current_structdef) then
+                if is_objectpascal_helper(current_structdef) then
                   Message(parser_e_no_destructor_in_records);
 
                 if not is_classdef and (current_structdef.symtable.currentvisibility<>vis_public) then
@@ -1014,7 +1045,7 @@ implementation
       end;
 
 
-    function object_dec(objecttype:tobjecttyp;const n:tidstring;genericdef:tstoreddef;genericlist:TFPObjectList;fd : tobjectdef) : tobjectdef;
+    function object_dec(objecttype:tobjecttyp;const n:tidstring;genericdef:tstoreddef;genericlist:TFPObjectList;fd : tobjectdef;helpertype:thelpertype) : tobjectdef;
       var
         old_current_structdef: tabstractrecorddef;
         old_current_genericdef,
@@ -1122,16 +1153,12 @@ implementation
                 include(current_structdef.objectoptions,oo_is_classhelper);
               end;
 
-            { change classhelpers into Object Pascal style class helpers }
+            { include the class helper flag for Object Pascal helpers }
-            if (objecttype=odt_classhelper) then
+            if (objecttype=odt_helper) then
-              begin
+              include(current_objectdef.objectoptions,oo_is_classhelper);
-                current_objectdef.objecttype:=odt_class;
-                include(current_objectdef.objectoptions,oo_is_classhelper);
-              end;
 
             { parse list of options (abstract / sealed) }
-            if not(objecttype in [odt_objcclass,odt_objcprotocol,odt_objccategory]) and
+            if not(objecttype in [odt_objcclass,odt_objcprotocol,odt_objccategory]) then
-                not is_objectpascal_classhelper(current_objectdef) then
               parse_object_options;
 
             symtablestack.push(current_structdef.symtable);
@@ -1141,6 +1168,10 @@ implementation
             { parse list of parent classes }
             parse_parent_classes;
 
+            { parse extended type for helpers }
+            if is_objectpascal_helper(current_structdef) then
+              parse_extended_class(helpertype);
+
             { parse optional GUID for interfaces }
             parse_guid;
 

compiler/pdecsub.pas

@@ -245,6 +245,7 @@ implementation
         storepos : tfileposinfo;
         vs       : tparavarsym;
         hdef     : tdef;
+        selfdef  : tabstractrecorddef;
         vsp      : tvarspez;
         aliasvs  : tabsolutevarsym;
         sl       : tpropaccesslist;
@@ -302,18 +303,24 @@ implementation
                    pd.parast.insert(vs);
                  end;
 
+                { for helpers the type of Self is equivalent to the extended
+                  type or equal to an instance of it }
+                if is_objectpascal_helper(tprocdef(pd).struct) then
+                  selfdef:=tobjectdef(tprocdef(pd).struct).extendeddef
+                else
+                  selfdef:=tprocdef(pd).struct;
                 { Generate self variable, for classes we need
                   to use the generic voidpointer to be compatible with
                   methodpointers }
                 vsp:=vs_value;
                 if (po_staticmethod in pd.procoptions) or
                    (po_classmethod in pd.procoptions) then
-                  hdef:=tclassrefdef.create(tprocdef(pd).struct)
+                  hdef:=tclassrefdef.create(selfdef)
                 else
                   begin
-                    if is_object(tprocdef(pd).struct) or is_record(tprocdef(pd).struct) then
+                    if is_object(selfdef) or is_record(selfdef) then
                       vsp:=vs_var;
-                    hdef:=tprocdef(pd).struct;
+                    hdef:=selfdef;
                   end;
                 vs:=tparavarsym.create('$self',paranr_self,vsp,hdef,[vo_is_self,vo_is_hidden_para]);
                 pd.parast.insert(vs);
@@ -1621,6 +1628,9 @@ procedure pd_abstract(pd:tabstractprocdef);
 begin
   if pd.typ<>procdef then
     internalerror(200304269);
+  if is_objectpascal_helper(tprocdef(pd).struct) and
+      (m_objfpc in current_settings.modeswitches) then
+    Message1(parser_e_not_allowed_in_classhelper, arraytokeninfo[_ABSTRACT].str);
   if assigned(tprocdef(pd).struct) and
     (oo_is_sealed in tprocdef(pd).struct.objectoptions) then
     Message(parser_e_sealed_class_cannot_have_abstract_methods)
@@ -1637,6 +1647,9 @@ procedure pd_final(pd:tabstractprocdef);
 begin
   if pd.typ<>procdef then
     internalerror(200910170);
+  if is_objectpascal_helper(tprocdef(pd).struct) and
+      (m_objfpc in current_settings.modeswitches) then
+    Message1(parser_e_not_allowed_in_classhelper, arraytokeninfo[_FINAL].str);
   if (po_virtualmethod in pd.procoptions) then
     include(pd.procoptions,po_finalmethod)
   else
@@ -1682,7 +1695,7 @@ begin
   if (pd.proctypeoption=potype_constructor) and
      is_object(tprocdef(pd).struct) then
     Message(parser_e_constructor_cannot_be_not_virtual);
-  if is_objectpascal_classhelper(tprocdef(pd).struct) and
+  if is_objectpascal_helper(tprocdef(pd).struct) and
       (m_objfpc in current_settings.modeswitches) then
     Message1(parser_e_not_allowed_in_classhelper, arraytokeninfo[_VIRTUAL].str);
 {$ifdef WITHDMT}
@@ -1734,9 +1747,11 @@ procedure pd_override(pd:tabstractprocdef);
 begin
   if pd.typ<>procdef then
     internalerror(2003042611);
-  if is_objectpascal_classhelper(tprocdef(pd).struct) and
+  if is_objectpascal_helper(tprocdef(pd).struct) then
-      (m_objfpc in current_settings.modeswitches) then
+    begin
-    Message1(parser_e_not_allowed_in_classhelper, arraytokeninfo[_OVERRIDE].str)
+      if m_objfpc in current_settings.modeswitches then
+        Message1(parser_e_not_allowed_in_classhelper, arraytokeninfo[_OVERRIDE].str)
+    end
   else if not(is_class_or_interface_or_objc(tprocdef(pd).struct)) then
     Message(parser_e_no_object_override)
   else if is_objccategory(tprocdef(pd).struct) then
@@ -1761,12 +1776,15 @@ var
 begin
   if pd.typ<>procdef then
     internalerror(2003042613);
-  if not is_class(tprocdef(pd).struct) and
+  if is_objectpascal_helper(tprocdef(pd).struct) then
-     not is_objc_class_or_protocol(tprocdef(pd).struct) then
+    begin
-    Message(parser_e_msg_only_for_classes);
+      if m_objfpc in current_settings.modeswitches then
-  if is_objectpascal_classhelper(tprocdef(pd).struct) and
+        Message1(parser_e_not_allowed_in_classhelper, arraytokeninfo[_MESSAGE].str);
-      (m_objfpc in current_settings.modeswitches) then
+    end
-    Message1(parser_e_not_allowed_in_classhelper, arraytokeninfo[_MESSAGE].str);
+  else
+    if not is_class(tprocdef(pd).struct) and
+       not is_objc_class_or_protocol(tprocdef(pd).struct) then
+      Message(parser_e_msg_only_for_classes);
   if ([po_msgstr,po_msgint]*pd.procoptions)<>[] then
     Message(parser_e_multiple_messages);
   { check parameter type }
@@ -1795,7 +1813,8 @@ begin
     end
   else
    if is_constintnode(pt) and
-      is_class(tprocdef(pd).struct) then
+      (is_class(tprocdef(pd).struct) or
+      is_objectpascal_helper(tprocdef(pd).struct)) then
     begin
       include(pd.procoptions,po_msgint);
       if (Tordconstnode(pt).value<int64(low(Tprocdef(pd).messageinf.i))) or
@@ -1819,12 +1838,15 @@ procedure pd_reintroduce(pd:tabstractprocdef);
 begin
   if pd.typ<>procdef then
     internalerror(200401211);
-  if not(is_class_or_interface_or_object(tprocdef(pd).struct)) and
+  if is_objectpascal_helper(tprocdef(pd).struct) then
-     not(is_objccategory(tprocdef(pd).struct)) then
+    begin
-    Message(parser_e_no_object_reintroduce);
+      if m_objfpc in current_settings.modeswitches then
-  if is_objectpascal_classhelper(tprocdef(pd).struct) and
+        Message1(parser_e_not_allowed_in_classhelper, arraytokeninfo[_REINTRODUCE].str);
-      (m_objfpc in current_settings.modeswitches) then
+    end
-    Message1(parser_e_not_allowed_in_classhelper, arraytokeninfo[_REINTRODUCE].str);
+  else
+    if not(is_class_or_interface_or_object(tprocdef(pd).struct)) and
+       not(is_objccategory(tprocdef(pd).struct)) then
+      Message(parser_e_no_object_reintroduce);
 end;
 
 
@@ -2104,7 +2126,7 @@ const
    (
     (
       idtok:_ABSTRACT;
-      pd_flags : [pd_interface,pd_object,pd_notobjintf,pd_notrecord,pd_nothelper];
+      pd_flags : [pd_interface,pd_object,pd_notobjintf,pd_notrecord];
       handler  : @pd_abstract;
       pocall   : pocall_none;
       pooption : [po_abstractmethod];
@@ -2639,7 +2661,7 @@ const
             exit;
 
            { check if method and directive not for record/class helper }
-           if is_objectpascal_classhelper(tprocdef(pd).struct) and
+           if is_objectpascal_helper(tprocdef(pd).struct) and
              (pd_nothelper in proc_direcdata[p].pd_flags) then
             exit;
 

compiler/pexpr.pas

@@ -1031,7 +1031,7 @@ implementation
             else
              static_name:=lower(generate_nested_name(sym.owner,'_'))+'_'+sym.name;
             if sym.owner.defowner.typ=objectdef then
-              searchsym_in_class(tobjectdef(sym.owner.defowner),tobjectdef(sym.owner.defowner),static_name,sym,srsymtable)
+              searchsym_in_class(tobjectdef(sym.owner.defowner),tobjectdef(sym.owner.defowner),static_name,sym,srsymtable,true)
             else
               searchsym_in_record(trecorddef(sym.owner.defowner),static_name,sym,srsymtable);
             if assigned(sym) then
@@ -1489,7 +1489,7 @@ implementation
                           p1:=comp_expr(true,false);
                           consume(_RKLAMMER);
                           { type casts to class helpers aren't allowed }
-                          if is_objectpascal_classhelper(hdef) then
+                          if is_objectpascal_helper(hdef) then
                             Message(parser_e_no_category_as_types)
                             { recovery by not creating a conversion node }
                           else
@@ -1508,7 +1508,7 @@ implementation
                              begin
                                p1:=ctypenode.create(hdef);
                                { search also in inherited methods }
-                               searchsym_in_class(tobjectdef(hdef),tobjectdef(current_structdef),pattern,srsym,srsymtable);
+                               searchsym_in_class(tobjectdef(hdef),tobjectdef(current_structdef),pattern,srsym,srsymtable,true);
                                if assigned(srsym) then
                                  check_hints(srsym,srsym.symoptions,srsym.deprecatedmsg);
                                consume(_ID);
@@ -1535,16 +1535,17 @@ implementation
                          end
                        else
                         begin
+                          { TClassHelper.Something is not allowed }
+                          if is_objectpascal_helper(hdef) then
+                            begin
+                              Message(parser_e_no_category_as_types);
+                              { for recovery we use the extended class }
+                              hdef:=tobjectdef(hdef).extendeddef;
+                            end;
                           { class reference ? }
                           if is_class(hdef) or
                              is_objcclass(hdef) then
                            begin
-                             if is_objectpascal_classhelper(hdef) then
-                               begin
-                                 Message(parser_e_no_category_as_types);
-                                 { for recovery we use the extended class }
-                                 hdef:=tobjectdef(hdef).childof;
-                               end;
                              if getaddr and (token=_POINT) then
                               begin
                                 consume(_POINT);
@@ -2140,7 +2141,7 @@ implementation
                            if token=_ID then
                              begin
                                structh:=tobjectdef(tclassrefdef(p1.resultdef).pointeddef);
-                               searchsym_in_class(tobjectdef(structh),tobjectdef(structh),pattern,srsym,srsymtable);
+                               searchsym_in_class(tobjectdef(structh),tobjectdef(structh),pattern,srsym,srsymtable,true);
                                if assigned(srsym) then
                                  begin
                                    check_hints(srsym,srsym.symoptions,srsym.deprecatedmsg);
@@ -2164,7 +2165,7 @@ implementation
                            if token=_ID then
                              begin
                                structh:=tobjectdef(p1.resultdef);
-                               searchsym_in_class(tobjectdef(structh),tobjectdef(structh),pattern,srsym,srsymtable);
+                               searchsym_in_class(tobjectdef(structh),tobjectdef(structh),pattern,srsym,srsymtable,true);
                                if assigned(srsym) then
                                  begin
                                     check_hints(srsym,srsym.symoptions,srsym.deprecatedmsg);
@@ -2354,7 +2355,16 @@ implementation
                     assigned(current_structdef) and
                     (current_structdef.typ=objectdef) then
                   begin
-                    hclassdef:=tobjectdef(current_structdef).childof;
+                    { In Object Pascal helpers "inherited" always calls a
+                      method of the extended class }
+                    if is_objectpascal_helper(current_structdef) then
+                      begin
+                        if not is_class(tobjectdef(current_structdef).extendeddef) then
+                          Internalerror(2011021701);
+                        hclassdef:=tobjectdef(tobjectdef(current_structdef).extendeddef);
+                      end
+                    else
+                      hclassdef:=tobjectdef(current_structdef).childof;
                     { Objective-C categories *replace* methods in the class
                       they extend, or add methods to it. So calling an
                       inherited method always calls the method inherited from
@@ -2378,7 +2388,8 @@ implementation
                         if (po_msgstr in pd.procoptions) then
                           searchsym_in_class_by_msgstr(hclassdef,pd.messageinf.str^,srsym,srsymtable)
                        else
-                         searchsym_in_class(hclassdef,tobjectdef(current_structdef),hs,srsym,srsymtable);
+                         { disable search for helpers }
+                         searchsym_in_class(hclassdef,tobjectdef(current_structdef),hs,srsym,srsymtable,false);
                      end
                     else
                      begin
@@ -2386,7 +2397,8 @@ implementation
                        hsorg:=orgpattern;
                        consume(_ID);
                        anon_inherited:=false;
-                       searchsym_in_class(hclassdef,tobjectdef(current_structdef),hs,srsym,srsymtable);
+                       { disable search for helpers }
+                       searchsym_in_class(hclassdef,tobjectdef(current_structdef),hs,srsym,srsymtable,false);
                      end;
                     if assigned(srsym) then
                      begin
@@ -2420,7 +2432,7 @@ implementation
                           if (po_msgint in pd.procoptions) or
                              (po_msgstr in pd.procoptions) then
                             begin
-                              searchsym_in_class(hclassdef,hclassdef,'DEFAULTHANDLER',srsym,srsymtable);
+                              searchsym_in_class(hclassdef,hclassdef,'DEFAULTHANDLER',srsym,srsymtable,true);
                               if not assigned(srsym) or
                                  (srsym.typ<>procsym) then
                                 internalerror(200303171);

compiler/pinline.pas

@@ -434,7 +434,7 @@ implementation
             { search the constructor also in the symbol tables of
               the parents }
             afterassignment:=false;
-            searchsym_in_class(classh,classh,pattern,srsym,srsymtable);
+            searchsym_in_class(classh,classh,pattern,srsym,srsymtable,true);
             consume(_ID);
             do_member_read(classh,false,srsym,p1,again,[cnf_new_call]);
             { we need to know which procedure is called }

compiler/ptype.pas

@@ -568,7 +568,8 @@ implementation
                 Message(parser_e_no_generics_as_types);
                 def:=generrordef;
               end
-            else if is_classhelper(def) then
+            else if is_classhelper(def) and
+                not (stoParseClassParent in options) then
               begin
                 Message(parser_e_no_category_as_types);
                 def:=generrordef
@@ -1498,12 +1499,12 @@ implementation
                       _CLASS :
                         begin
                           consume(_CLASS);
-                          def:=object_dec(odt_class,name,genericdef,genericlist,nil);
+                          def:=object_dec(odt_class,name,genericdef,genericlist,nil,ht_none);
                         end;
                       _OBJECT :
                         begin
                           consume(_OBJECT);
-                          def:=object_dec(odt_object,name,genericdef,genericlist,nil);
+                          def:=object_dec(odt_object,name,genericdef,genericlist,nil,ht_none);
                         end;
                       else
                         def:=record_dec(name,genericdef,genericlist);
@@ -1518,7 +1519,7 @@ implementation
                 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);
+                def:=object_dec(odt_dispinterface,name,genericdef,genericlist,nil,ht_none);
               end;
             _CLASS :
               begin
@@ -1548,15 +1549,15 @@ implementation
                 if (idtoken=_HELPER) then
                   begin
                     consume(_HELPER);
-                    def:=object_dec(odt_classhelper,name,genericdef,genericlist,nil);
+                    def:=object_dec(odt_helper,name,genericdef,genericlist,nil,ht_class);
                   end
                 else
-                  def:=object_dec(odt_class,name,genericdef,genericlist,nil);
+                  def:=object_dec(odt_class,name,genericdef,genericlist,nil,ht_none);
               end;
             _CPPCLASS :
               begin
                 consume(token);
-                def:=object_dec(odt_cppclass,name,genericdef,genericlist,nil);
+                def:=object_dec(odt_cppclass,name,genericdef,genericlist,nil,ht_none);
               end;
             _OBJCCLASS :
               begin
@@ -1564,7 +1565,7 @@ implementation
                   Message(parser_f_need_objc);
 
                 consume(token);
-                def:=object_dec(odt_objcclass,name,genericdef,genericlist,nil);
+                def:=object_dec(odt_objcclass,name,genericdef,genericlist,nil,ht_none);
               end;
             _INTERFACE :
               begin
@@ -1574,9 +1575,9 @@ implementation
                   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)
+                  def:=object_dec(odt_interfacecom,name,genericdef,genericlist,nil,ht_none)
                 else {it_interfacecorba}
-                  def:=object_dec(odt_interfacecorba,name,genericdef,genericlist,nil);
+                  def:=object_dec(odt_interfacecorba,name,genericdef,genericlist,nil,ht_none);
               end;
             _OBJCPROTOCOL :
                begin
@@ -1584,7 +1585,7 @@ implementation
                   Message(parser_f_need_objc);
 
                 consume(token);
-                def:=object_dec(odt_objcprotocol,name,genericdef,genericlist,nil);
+                def:=object_dec(odt_objcprotocol,name,genericdef,genericlist,nil,ht_none);
                end;
             _OBJCCATEGORY :
                begin
@@ -1592,12 +1593,12 @@ implementation
                   Message(parser_f_need_objc);
 
                 consume(token);
-                def:=object_dec(odt_objccategory,name,genericdef,genericlist,nil);
+                def:=object_dec(odt_objccategory,name,genericdef,genericlist,nil,ht_none);
                end;
             _OBJECT :
               begin
                 consume(token);
-                def:=object_dec(odt_object,name,genericdef,genericlist,nil);
+                def:=object_dec(odt_object,name,genericdef,genericlist,nil,ht_none);
               end;
             _PROCEDURE,
             _FUNCTION:

compiler/symconst.pas

@@ -329,7 +329,13 @@ type
     odt_objcclass,
     odt_objcprotocol,
     odt_objccategory, { note that these are changed into odt_class afterwards }
-    odt_classhelper
+    odt_helper
+  );
+
+  { defines the type of the extended "structure"; only used for parsing }
+  thelpertype=(ht_none,
+    ht_class,
+    ht_record
   );
 
   { Variations in interfaces implementation }

compiler/symdef.pas

@@ -259,12 +259,9 @@ interface
           childof        : tobjectdef;
           childofderef   : tderef;
 
-          { for Object Pascal class helpers: the parent class helper is only
+          { for Object Pascal helpers }
-            used to extend the scope of a used class helper by another class
+          extendeddef   : tabstractrecorddef;
-            helper for the same extended class or a superclass (which is defined
+          extendeddefderef: tderef;
-            by childof }
-          helperparent   : tobjectdef;
-          helperparentderef: tderef;
           { for C++ classes: name of the library this class is imported from }
           import_lib,
           { for Objective-C: protocols and classes can have the same name there }
@@ -322,7 +319,6 @@ 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 }
@@ -788,7 +784,7 @@ 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_objectpascal_helper(def: tdef): boolean;
     function is_objcclass(def: tdef): boolean;
     function is_objcclassref(def: tdef): boolean;
     function is_objcprotocol(def: tdef): boolean;
@@ -4153,7 +4149,7 @@ implementation
         fcurrent_dispid:=0;
         objecttype:=ot;
         childof:=nil;
-        if objecttype in [odt_classhelper] then
+        if objecttype=odt_helper then
           owner.includeoption(sto_has_classhelper);
         symtable:=tObjectSymtable.create(self,n,current_settings.packrecords);
         { create space for vmt !! }
@@ -4163,7 +4159,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,odt_classhelper] then
+        if objecttype in [odt_class,odt_objcclass,odt_objcprotocol] then
           ImplementedInterfaces:=TFPObjectList.Create(true)
         else
           ImplementedInterfaces:=nil;
@@ -4205,8 +4201,8 @@ implementation
               iidstr:=stringdup(ppufile.getstring);
            end;
 
-         if oo_is_classhelper in objectoptions then
+         if objecttype=odt_helper then
-           ppufile.getderef(helperparentderef);
+           ppufile.getderef(extendeddefderef);
 
          vmtentries:=TFPList.Create;
          vmtentries.count:=ppufile.getlongint;
@@ -4369,8 +4365,8 @@ implementation
               ppufile.putguid(iidguid^);
               ppufile.putstring(iidstr^);
            end;
-         if oo_is_classhelper in objectoptions then
+         if objecttype=odt_helper then
-           ppufile.putderef(helperparentderef);
+           ppufile.putderef(extendeddefderef);
 
          ppufile.putlongint(vmtentries.count);
          for i:=0 to vmtentries.count-1 do
@@ -4429,8 +4425,8 @@ implementation
          else
            tstoredsymtable(symtable).buildderef;
 
-         if oo_is_classhelper in objectoptions then
+         if objecttype=odt_helper then
-           helperparentderef.build(helperparent);
+           extendeddefderef.build(extendeddef);
 
          for i:=0 to vmtentries.count-1 do
            begin
@@ -4460,8 +4456,8 @@ implementation
            end
          else
            tstoredsymtable(symtable).deref;
-         if oo_is_classhelper in objectoptions then
+         if objecttype=odt_helper then
-           helperparent:=tobjectdef(helperparentderef.resolve);
+           extendeddef:=tobjectdef(extendeddefderef.resolve);
          for i:=0 to vmtentries.count-1 do
            begin
              vmtentry:=pvmtentry(vmtentries[i]);
@@ -4743,14 +4739,9 @@ 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
+        if objecttype in [odt_class,odt_interfacecom,odt_interfacecorba,odt_dispinterface,odt_objcclass,odt_objcprotocol,odt_helper] then
           result:=sizeof(pint)
         else
           result:=tObjectSymtable(symtable).datasize;
@@ -4759,7 +4750,7 @@ implementation
 
     function tobjectdef.alignment:shortint;
       begin
-        if objecttype in [odt_class,odt_interfacecom,odt_interfacecorba,odt_dispinterface,odt_objcclass,odt_objcprotocol] then
+        if objecttype in [odt_class,odt_interfacecom,odt_interfacecorba,odt_dispinterface,odt_objcclass,odt_objcprotocol,odt_helper] then
           alignment:=sizeof(pint)
         else
           alignment:=tObjectSymtable(symtable).recordalignment;
@@ -4773,6 +4764,7 @@ implementation
         odt_class:
           { the +2*sizeof(pint) is size and -size }
           vmtmethodoffset:=(index+10)*sizeof(pint)+2*sizeof(pint);
+        odt_helper,
         odt_objcclass,
         odt_objcprotocol:
           vmtmethodoffset:=0;
@@ -4799,6 +4791,7 @@ implementation
     function tobjectdef.needs_inittable : boolean;
       begin
          case objecttype of
+            odt_helper,
             odt_class :
               needs_inittable:=false;
             odt_dispinterface,
@@ -5472,16 +5465,12 @@ implementation
       end;
 
 
-    function is_objectpascal_classhelper(def: tdef): boolean;
+    function is_objectpascal_helper(def: tdef): boolean;
       begin
         result:=
           assigned(def) and
           (def.typ=objectdef) and
-          { if used as a forward type }
+          (tobjectdef(def).objecttype=odt_helper);
-          ((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;
 
 
@@ -5537,7 +5526,7 @@ implementation
     function is_classhelper(def: tdef): boolean;
       begin
          result:=
-           is_objectpascal_classhelper(def) or
+           is_objectpascal_helper(def) or
            is_objccategory(def);
       end;
 

compiler/symtable.pas

@@ -220,7 +220,7 @@ interface
     function  searchsym_type(const s : TIDString;out srsym:tsym;out srsymtable:TSymtable):boolean;
     function  searchsym_in_module(pm:pointer;const s : TIDString;out srsym:tsym;out srsymtable:TSymtable):boolean;
     function  searchsym_in_named_module(const unitname, symname: TIDString; out srsym: tsym; out srsymtable: tsymtable): boolean;
-    function  searchsym_in_class(classh,contextclassh:tobjectdef;const s : TIDString;out srsym:tsym;out srsymtable:TSymtable):boolean;
+    function  searchsym_in_class(classh,contextclassh:tobjectdef;const s : TIDString;out srsym:tsym;out srsymtable:TSymtable;searchhelper:boolean):boolean;
     function  searchsym_in_record(recordh:tabstractrecorddef;const s : TIDString;out srsym:tsym;out srsymtable:TSymtable):boolean;
     function  searchsym_in_class_by_msgint(classh:tobjectdef;msgid:longint;out srdef : tdef;out srsym:tsym;out srsymtable:TSymtable):boolean;
     function  searchsym_in_class_by_msgstr(classh:tobjectdef;const s:string;out srsym:tsym;out srsymtable:TSymtable):boolean;
@@ -229,7 +229,7 @@ interface
     function  search_struct_member(pd : tabstractrecorddef;const s : string):tsym;
     function  search_assignment_operator(from_def,to_def:Tdef;explicit:boolean):Tprocdef;
     function  search_enumerator_operator(from_def,to_def:Tdef):Tprocdef;
-    function  search_last_objectpascal_classhelper(pd : tobjectdef;out odef : tobjectdef):boolean;
+    function  search_last_objectpascal_helper(pd : tabstractrecorddef;out odef : tobjectdef):boolean;
     function  search_objectpascal_class_helper(pd,contextclassh : tobjectdef;const s : string; out srsym: tsym; out srsymtable: tsymtable):boolean;
     function  search_class_helper(pd : tobjectdef;const s : string; out srsym: tsym; out srsymtable: tsymtable):boolean;
     function  search_objc_method(const s : string; out srsym: tsym; out srsymtable: tsymtable):boolean;
@@ -1906,7 +1906,7 @@ implementation
             srsymtable:=stackitem^.symtable;
             if (srsymtable.symtabletype=objectsymtable) then
               begin
-                if searchsym_in_class(tobjectdef(srsymtable.defowner),tobjectdef(srsymtable.defowner),s,srsym,srsymtable) then
+                if searchsym_in_class(tobjectdef(srsymtable.defowner),tobjectdef(srsymtable.defowner),s,srsym,srsymtable,true) then
                   begin
                     result:=true;
                     exit;
@@ -2136,19 +2136,27 @@ implementation
       end;
 
 
-    function searchsym_in_class(classh,contextclassh:tobjectdef;const s : TIDString;out srsym:tsym;out srsymtable:TSymtable):boolean;
+    function searchsym_in_class(classh,contextclassh:tobjectdef;const s : TIDString;out srsym:tsym;out srsymtable:TSymtable;searchhelper:boolean):boolean;
       var
         hashedid : THashedIDString;
+        exdef    : tabstractrecorddef;
         orgclass : tobjectdef;
         i        : longint;
       begin
         { search for a class helper method first if this is an Object Pascal
           class }
-        if is_class(classh) then
+        if is_class(classh) and searchhelper then
           begin
             result:=search_objectpascal_class_helper(classh,contextclassh,s,srsym,srsymtable);
             if result then
-              exit;
+              begin
+                { if the procsym is overloaded we need to use the "original"
+                  symbol; the helper symbol will be find when searching for
+                  overloads }
+                if (srsym.typ<>procsym) or
+                    not (sp_has_overloaded in tprocsym(srsym).symoptions) then
+                  Exit;
+              end;
           end;
 
         orgclass:=classh;
@@ -2159,8 +2167,9 @@ implementation
               classh:=find_real_objcclass_definition(classh,true);
             { The contextclassh is used for visibility. The classh must be equal to
               or be a parent of contextclassh. E.g. for inherited searches the classh is the
-              parent. }
+              parent or a class helper. }
-            if not contextclassh.is_related(classh) then
+            if not (contextclassh.is_related(classh) or
+                (contextclassh.extendeddef=classh)) then
               internalerror(200811161);
           end;
         result:=false;
@@ -2180,7 +2189,7 @@ implementation
               end;
             for i:=0 to classh.ImplementedInterfaces.count-1 do
               begin
-                if searchsym_in_class(TImplementedInterface(classh.ImplementedInterfaces[i]).intfdef,contextclassh,s,srsym,srsymtable) then
+                if searchsym_in_class(TImplementedInterface(classh.ImplementedInterfaces[i]).intfdef,contextclassh,s,srsym,srsymtable,true) then
                   begin
                     result:=true;
                     exit;
@@ -2189,6 +2198,24 @@ implementation
           end
         else
           begin
+            { if we're searching for a symbol inside a helper, we must search in
+              the extended class/record/whatever first }
+            if is_objectpascal_helper(classh) then
+              begin
+                { important: disable the search for helpers here! }
+                if is_class(classh.extendeddef) and
+                    searchsym_in_class(tobjectdef(classh.extendeddef), tobjectdef(classh.extendeddef), s, srsym, srsymtable, false) then
+                  begin
+                    result:=true;
+                    exit;
+                  end
+                else if is_record(classh.extendeddef) and
+                    searchsym_in_record(classh.extendeddef, s, srsym, srsymtable) then
+                  begin
+                    result:=true;
+                    exit;
+                  end;
+              end;
             while assigned(classh) do
               begin
                 srsymtable:=classh.symtable;
@@ -2435,7 +2462,7 @@ implementation
           end;
       end;
 
-    function search_last_objectpascal_classhelper(pd : tobjectdef;out odef : tobjectdef):boolean;
+    function search_last_objectpascal_helper(pd : tabstractrecorddef;out odef : tobjectdef):boolean;
       var
         stackitem : psymtablestackitem;
         i : integer;
@@ -2455,11 +2482,11 @@ implementation
                   begin
                     if not (srsymtable.symlist[i] is ttypesym) then
                       continue;
-                    if not is_objectpascal_classhelper(ttypesym(srsymtable.symlist[i]).typedef) then
+                    if not is_objectpascal_helper(ttypesym(srsymtable.symlist[i]).typedef) then
                       continue;
                     odef:=tobjectdef(ttypesym(srsymtable.symlist[i]).typedef);
                     { does the class helper extend the correct class? }
-                    result:=odef.childof=pd;
+                    result:=odef.extendeddef=pd;
                     if result then
                       exit
                     else
@@ -2482,7 +2509,7 @@ implementation
 
         { if there is no class helper for the class then there is no need to
           search further }
-        if not search_last_objectpascal_classhelper(pd,classh) then
+        if not search_last_objectpascal_helper(pd,classh) then
           exit;
 
         hashedid.id:=s;
@@ -2524,8 +2551,8 @@ implementation
                 end;
             end;
 
-          { try the class helper "parent" if available }
+          { try the class helper parent if available }
-          classh:=classh.helperparent;
+          classh:=classh.childof;
         until classh=nil;
 
         srsym:=nil;