* symconst.pas:

- remove thelpersearch again => adjustments to searchsym_in_class and calls to it
- rename sto_has_classhelper to sto_has_helper
* symbase.pas: make push and pop in tsymtablestack virtual
* symdef.pas:
- add a new class tdefawaresymtablestack which overrides push and pop of tsymtablestack and adjusts the new extendeddefs field of the current tmodule
- tobjectdef.create: sto_has_classhelper => sto_has_helper
* fmodule.pas:
- add new hash object list to tmodule (key: mangled type name) which holds object list instances that contain all helpers currently active for a given type (= key of the hash list)
- tmodule.create: the hash list owns the sublists (but those don't own the defs)
- tmodule.destroy: free the hash list
* pdecobjpas:
- rename parse_extended_class to parse_extended_type
- parsing of constructors:
# for all helper types: no class constructors allowed
# for record helpers: as long as constructors for records themselves are disabled they are for record helpers as well
- object_dec: manually add the helper to the extendeddefs if the overall owner of the current def is a static symtable (implementation section or program/library main file), because the symtable won't be popped and pushed then
* parser.pas: instantiate the new stack class
* psub.pas: backup the extendeddefs in specialize_objectdefs as well
* ptype.pas:
- generate_specialization: backup the extendeddefs as well
- record_dec: _RECORD is now consumed in read_named_type itself
- read_named_type: parse "record helper" if advanced record syntax is enabled
* symtable.pas:
- correct searchsym_in_class declaration => adjustments in this unit as well
- add the possibility to pass a context def to search_last_objectpascal_helper
- rename search_objectpascal_class_helper to search_objectpascal_helper
- rename search_class_helper to search_objc_helper
- searchsym_in_class: 
# search for helpers in every level of the tree of the class
# the contextclassh can also be a subclass of the extendeddef
- searchsym_in_record: search for helper methods as well
- searchsym_in_helper:
# search for symbols in class and record helpers is the same except for the search in the class' ancestors
# search the extendeddef directly and rely on searchsym_in_class only for the class' ancestors as we need to find the helpers there as well
- search_last_objectpascal_helper: use the extendeddefs list of current_module instead of scanning the symbol stack itself
* pexpr.pas: adjustments because of renaming of sto_has_classhelper
* pinline.pas: adjustment because of removing of thelpersearch
* nflw.pas: 
- renamed classhelper to helperdef
- adjusted search_last_objectpascal_helper call
* msg*:
- adjusted error message for constructors in records (this currently applies to record helpers as well)
- renamed parser_e_not_allowed_in_classhelper to parser_e_not_allowed_in_helper => adjustments in code
- added parser_e_no_class_constructors_in_helpers
* pdecsub.pas: adjusted renamed error message
* htypechk.pas: check for helpers in every step of the hierarchy
* nobj.pas: search_class_helper => search_objc_helper
* utils/ppudump.pas: adjust, because of renames

Note: the define "useoldsearch" will be only used for performance comparison on my (faster) Linux machine; that (and its associated code) will be removed afterwards

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

compiler/fmodule.pas

@@ -178,6 +178,11 @@ interface
         moduleoptions: tmoduleoptions;
         deprecatedmsg: pshortstring;
 
+        { contains a list of types that are extended by helper types; the key is
+          the full name of the type and the data is a TFPObjectList of
+          tobjectdef instances (the helper defs) }
+        extendeddefs: TFPHashObjectList;
+
         {create creates a new module which name is stored in 's'. LoadedFrom
         points to the module calling it. It is nil for the first compiled
         module. This allow inheritence of all path lists. MUST pay attention
@@ -513,6 +518,7 @@ implementation
         symlist:=TFPObjectList.Create(false);
         wpoinfo:=nil;
         checkforwarddefs:=TFPObjectList.Create(false);
+        extendeddefs := TFPHashObjectList.Create(true);
         globalsymtable:=nil;
         localsymtable:=nil;
         globalmacrosymtable:=nil;
@@ -602,6 +608,7 @@ implementation
         linkotherframeworks.Free;
         stringdispose(mainname);
         FImportLibraryList.Free;
+        extendeddefs.Free;
         stringdispose(objfilename);
         stringdispose(asmfilename);
         stringdispose(ppufilename);

compiler/htypechk.pas

@@ -1827,33 +1827,34 @@ implementation
         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
+           { first search in helpers for this type }
+           if (is_class(structdef) or is_record(structdef))
+               and searchhelpers then
+             begin
+               if search_last_objectpascal_helper(structdef,nil,helperdef) 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;
+             end;
+           { now search in the type itself }
            srsym:=tprocsym(structdef.symtable.FindWithHash(hashedid));
            if assigned(srsym) and
               { Delphi allows hiding a property by a procedure with the same name }

compiler/msg/errore.msg

@@ -368,7 +368,7 @@ scanner_w_illegal_warn_identifier=02087_W_Illegal identifier "$1" for $WARN dire
 #
 # Parser
 #
-# 03305 is the last used one
+# 03306 is the last used one
 #
 % \section{Parser messages}
 % This section lists all parser messages. The parser takes care of the
@@ -1355,22 +1355,25 @@ parser_e_forward_protocol_declaration_must_be_resolved=03298_E_Forward declarati
 % where \var{MyProtocol} is declared but not defined.
 parser_e_no_record_published=03299_E_Record types cannot have published sections
 % Published sections can be used only inside classes.
-parser_e_no_destructor_in_records=03300_E_Destructors aren't allowed in records or class helpers
-% Destructor declarations aren't allowed in records or class helpers.
+parser_e_no_destructor_in_records=03300_E_Destructors aren't allowed in records or helpers
+% Destructor declarations aren't allowed in records or helpers.
 parser_e_class_methods_only_static_in_records=03301_E_Class methods must be static in records
 % Class methods declarations aren't allowed in records without static modifier.
 % Records have no inheritance and therefore non static class methods have no sence for them.
-parser_e_no_constructor_in_records=03302_E_Constructors aren't allowed in records
-% Constructor declarations aren't allowed in records.
+parser_e_no_constructor_in_records=03302_E_Constructors aren't allowed in records or record helpers
+% Constructor declarations aren't allowed in records or record helpers.
 parser_e_at_least_one_argument_must_be_of_type=03303_E_Either the result or at least one parameter must be of type "$1"
 % It is required that either the result of the routine or at least one of its parameters be of the specified type.
 % For example class operators either take an instance of the structured type in which they are defined, or they return one.
 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_not_allowed_in_classhelper=03305_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).
+parser_e_not_allowed_in_helper=03305_E_"$1" is not allowed in helpers
+% Some directives and specifiers like "virtual", "dynamic", "override" aren't
+% allowed inside class helpers in mode ObjFPC (they are ignored in mode Delphi),
+% because they have no meaning within helpers.
+parser_e_no_class_constructor_in_helpers=03306_E_Class constructors aren't allowed in helpers
+% Class constructor declarations aren't allowed in helpers.
 % \end{description}
 # Type Checking
 #

compiler/msgidx.inc

@@ -393,7 +393,8 @@ 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_not_allowed_in_classhelper=03305;
+  parser_e_not_allowed_in_helper=03305;
+  parser_e_no_class_constructor_in_helpers=03306;
   type_e_mismatch=04000;
   type_e_incompatible_types=04001;
   type_e_not_equal_types=04002;
@@ -887,9 +888,9 @@ const
   option_info=11024;
   option_help_pages=11025;
 
-  MsgTxtSize = 58973;
+  MsgTxtSize = 59014;
 
   MsgIdxMax : array[1..20] of longint=(
-    24,88,306,103,84,54,111,22,202,63,
+    24,88,307,103,84,54,111,22,202,63,
     49,20,1,1,1,1,1,1,1,1
   );

compiler/nflw.pas

@@ -824,7 +824,7 @@ implementation
     function create_for_in_loop(hloopvar, hloopbody, expr: tnode): tnode;
       var
         pd, movenext: tprocdef;
-        classhelper: tobjectdef;
+        helperdef: tobjectdef;
         current: tpropertysym;
         storefilepos: tfileposinfo;
       begin
@@ -866,12 +866,12 @@ implementation
                     { first search using the class helper hierarchy if it's a
                       class }
                     if (expr.resultdef.typ=objectdef) and
-                        search_last_objectpascal_helper(tobjectdef(expr.resultdef),classhelper) then
+                        search_last_objectpascal_helper(tobjectdef(expr.resultdef),nil,helperdef) then
                       repeat
-                        pd:=classhelper.search_enumerator_get;
-                        classhelper:=classhelper.childof;
-                      until (pd<>nil) or (classhelper=nil);
-                    { we didn't found a class helper, so search in the
+                        pd:=helperdef.search_enumerator_get;
+                        helperdef:=helperdef.childof;
+                      until (pd<>nil) or (helperdef=nil);
+                    { we didn't find an enumerator in a helper, so search in the
                       class/record/object itself }
                     if pd=nil then
                       pd:=tabstractrecorddef(expr.resultdef).search_enumerator_get;

compiler/nobj.pas

@@ -460,7 +460,7 @@ implementation
           "overriding" method }
         if is_objcclass(_class) and
            assigned(_class.childof) and
-           search_class_helper(_class.childof,pd.procsym.name,srsym,st) then
+           search_objc_helper(_class.childof,pd.procsym.name,srsym,st) then
           begin
             overridesclasshelper:=found_category_method(st);
           end;

compiler/parser.pas

@@ -344,7 +344,11 @@ implementation
          Message1(parser_i_compiling,filename);
 
        { reset symtable }
-         symtablestack:=TSymtablestack.create;
+{$ifdef useoldsearch}
+         symtablestack:=tsymtablestack.create;
+{$else}
+         symtablestack:=tdefawaresymtablestack.create;
+{$endif}
          macrosymtablestack:=TSymtablestack.create;
          systemunit:=nil;
          current_settings.defproccall:=init_settings.defproccall;

compiler/pdecobj.pas

@@ -582,7 +582,7 @@ implementation
           end;
       end;
 
-    procedure parse_extended_class(helpertype:thelpertype);
+    procedure parse_extended_type(helpertype:thelpertype);
       var
         hdef: tdef;
       begin
@@ -954,6 +954,16 @@ implementation
                 if is_objc_class_or_protocol(current_structdef) then
                   Message(parser_e_objc_no_constructor_destructor);
 
+                if is_objectpascal_helper(current_structdef) then
+                  if is_classdef then
+                    { class constructors are not allowed in class helpers }
+                    Message(parser_e_no_class_constructor_in_helpers)
+                  else
+                  if is_record(current_objectdef.extendeddef) then
+                    { as long as constructors aren't allowed in records they
+                      aren't allowed in helpers either }
+                    Message(parser_e_no_constructor_in_records);
+
                 { only 1 class constructor is allowed }
                 if is_classdef and (oo_has_class_constructor in current_structdef.objectoptions) then
                   Message1(parser_e_only_one_class_constructor_allowed, current_structdef.objrealname^);
@@ -1051,6 +1061,9 @@ implementation
         old_current_genericdef,
         old_current_specializedef: tstoreddef;
         old_parse_generic: boolean;
+        list: TFPObjectList;
+        s: String;
+        st: TSymtable;
       begin
         old_current_structdef:=current_structdef;
         old_current_genericdef:=current_genericdef;
@@ -1170,7 +1183,7 @@ implementation
 
             { parse extended type for helpers }
             if is_objectpascal_helper(current_structdef) then
-              parse_extended_class(helpertype);
+              parse_extended_type(helpertype);
 
             { parse optional GUID for interfaces }
             parse_guid;
@@ -1202,6 +1215,28 @@ implementation
         else if is_objcclass(current_structdef) then
           setobjcclassmethodoptions;
 
+        { if this helper is defined in the implementation section of the unit
+          or inside the main project file, the extendeddefs list of the current
+          module must be updated (it will be removed when poping the symtable) }
+        if is_objectpascal_helper(current_structdef) then
+          begin
+            { the topmost symtable must be a static symtable }
+            st:=current_structdef.owner;
+            while st.symtabletype in [objectsymtable,recordsymtable] do
+              st:=st.defowner.owner;
+            if st.symtabletype=staticsymtable then
+              begin
+                s:=make_mangledname('',current_objectdef.extendeddef.symtable,'');
+                list:=TFPObjectList(current_module.extendeddefs.Find(s));
+                if not assigned(list) then
+                  begin
+                    list:=TFPObjectList.Create(false);
+                    current_module.extendeddefs.Add(s, list);
+                  end;
+                list.add(current_structdef);
+              end;
+          end;
+
         { return defined objectdef }
         result:=current_objectdef;
 

compiler/pdecsub.pas

@@ -1630,7 +1630,7 @@ begin
     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);
+    Message1(parser_e_not_allowed_in_helper, 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)
@@ -1649,7 +1649,7 @@ begin
     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);
+    Message1(parser_e_not_allowed_in_helper, arraytokeninfo[_FINAL].str);
   if (po_virtualmethod in pd.procoptions) then
     include(pd.procoptions,po_finalmethod)
   else
@@ -1697,7 +1697,7 @@ begin
     Message(parser_e_constructor_cannot_be_not_virtual);
   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);
+    Message1(parser_e_not_allowed_in_helper, arraytokeninfo[_VIRTUAL].str);
 {$ifdef WITHDMT}
   if is_object(tprocdef(pd).struct) and
      (token<>_SEMICOLON) then
@@ -1750,7 +1750,7 @@ begin
   if is_objectpascal_helper(tprocdef(pd).struct) then
     begin
       if m_objfpc in current_settings.modeswitches then
-        Message1(parser_e_not_allowed_in_classhelper, arraytokeninfo[_OVERRIDE].str)
+        Message1(parser_e_not_allowed_in_helper, arraytokeninfo[_OVERRIDE].str)
     end
   else if not(is_class_or_interface_or_objc(tprocdef(pd).struct)) then
     Message(parser_e_no_object_override)
@@ -1779,7 +1779,7 @@ begin
   if is_objectpascal_helper(tprocdef(pd).struct) then
     begin
       if m_objfpc in current_settings.modeswitches then
-        Message1(parser_e_not_allowed_in_classhelper, arraytokeninfo[_MESSAGE].str);
+        Message1(parser_e_not_allowed_in_helper, arraytokeninfo[_MESSAGE].str);
     end
   else
     if not is_class(tprocdef(pd).struct) and
@@ -1841,7 +1841,7 @@ begin
   if is_objectpascal_helper(tprocdef(pd).struct) then
     begin
       if m_objfpc in current_settings.modeswitches then
-        Message1(parser_e_not_allowed_in_classhelper, arraytokeninfo[_REINTRODUCE].str);
+        Message1(parser_e_not_allowed_in_helper, arraytokeninfo[_REINTRODUCE].str);
     end
   else
     if not(is_class_or_interface_or_object(tprocdef(pd).struct)) and

compiler/pexpr.pas

@@ -1035,7 +1035,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,hs_searchfirst)
+              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
@@ -1512,7 +1512,7 @@ implementation
                              begin
                                p1:=ctypenode.create(hdef);
                                { search also in inherited methods }
-                               searchsym_in_class(tobjectdef(hdef),tobjectdef(current_structdef),pattern,srsym,srsymtable,hs_searchfirst);
+                               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);
@@ -2147,7 +2147,7 @@ implementation
                            if token=_ID then
                              begin
                                structh:=tobjectdef(tclassrefdef(p1.resultdef).pointeddef);
-                               searchsym_in_class(tobjectdef(structh),tobjectdef(structh),pattern,srsym,srsymtable,hs_searchfirst);
+                               searchsym_in_class(tobjectdef(structh),tobjectdef(structh),pattern,srsym,srsymtable,true);
                                if assigned(srsym) then
                                  begin
                                    check_hints(srsym,srsym.symoptions,srsym.deprecatedmsg);
@@ -2171,7 +2171,7 @@ implementation
                            if token=_ID then
                              begin
                                structh:=tobjectdef(p1.resultdef);
-                               searchsym_in_class(tobjectdef(structh),tobjectdef(structh),pattern,srsym,srsymtable,hs_searchfirst);
+                               searchsym_in_class(tobjectdef(structh),tobjectdef(structh),pattern,srsym,srsymtable,true);
                                if assigned(srsym) then
                                  begin
                                     check_hints(srsym,srsym.symoptions,srsym.deprecatedmsg);
@@ -2398,7 +2398,7 @@ implementation
                        if is_objectpascal_helper(current_structdef) then
                          searchsym_in_helper(tobjectdef(current_structdef),tobjectdef(current_structdef),hs,srsym,srsymtable,true)
                        else
-                         searchsym_in_class(hclassdef,tobjectdef(current_structdef),hs,srsym,srsymtable,hs_nosearch);
+                         searchsym_in_class(hclassdef,tobjectdef(current_structdef),hs,srsym,srsymtable,true);
                      end
                     else
                      begin
@@ -2410,7 +2410,7 @@ implementation
                        if is_objectpascal_helper(current_structdef) then
                          searchsym_in_helper(tobjectdef(current_structdef),tobjectdef(current_structdef),hs,srsym,srsymtable,true)
                        else
-                         searchsym_in_class(hclassdef,tobjectdef(current_structdef),hs,srsym,srsymtable,hs_nosearch);
+                         searchsym_in_class(hclassdef,tobjectdef(current_structdef),hs,srsym,srsymtable,true);
                      end;
                     if assigned(srsym) then
                      begin
@@ -2444,7 +2444,7 @@ implementation
                           if (po_msgint in pd.procoptions) or
                              (po_msgstr in pd.procoptions) then
                             begin
-                              searchsym_in_class(hclassdef,hclassdef,'DEFAULTHANDLER',srsym,srsymtable,hs_searchfirst);
+                              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,hs_searchfirst);
+            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/psub.pas

@@ -1985,6 +1985,9 @@ implementation
         hp : tdef;
         oldcurrent_filepos : tfileposinfo;
         oldsymtablestack   : tsymtablestack;
+{$ifndef useoldsearch}
+        oldextendeddefs    : TFPHashObjectList;
+{$endif}
         pu : tused_unit;
         hmodule : tmodule;
         specobj : tabstractrecorddef;
@@ -1999,7 +2002,13 @@ implementation
         { Setup symtablestack a definition time }
         specobj:=tabstractrecorddef(ttypesym(p).typedef);
         oldsymtablestack:=symtablestack;
+{$ifdef useoldsearch}
         symtablestack:=tsymtablestack.create;
+{$else}
+        oldextendeddefs:=current_module.extendeddefs;
+        current_module.extendeddefs:=TFPHashObjectList.create(true);
+        symtablestack:=tdefawaresymtablestack.create;
+{$endif}
         if not assigned(specobj.genericdef) then
           internalerror(200705151);
         hmodule:=find_module_from_symtable(specobj.genericdef.owner);
@@ -2046,6 +2055,10 @@ implementation
           end;
 
         { Restore symtablestack }
+{$ifndef useoldsearch}
+        current_module.extendeddefs.free;
+        current_module.extendeddefs:=oldextendeddefs;
+{$endif}
         symtablestack.free;
         symtablestack:=oldsymtablestack;
       end;

compiler/ptype.pas

@@ -159,6 +159,9 @@ implementation
         generictype : ttypesym;
         generictypelist : TFPObjectList;
         oldsymtablestack   : tsymtablestack;
+{$ifndef useoldsearch}
+        oldextendeddefs    : TFPHashObjectList;
+{$endif}
         hmodule : tmodule;
         pu : tused_unit;
         uspecializename,
@@ -295,7 +298,13 @@ implementation
               to get types right, however this is not perfect, we should probably record
               the resolved symbols }
             oldsymtablestack:=symtablestack;
+{$ifdef useoldsearch}
             symtablestack:=tsymtablestack.create;
+{$else}
+            oldextendeddefs:=current_module.extendeddefs;
+            current_module.extendeddefs:=TFPHashObjectList.create(true);
+            symtablestack:=tdefawaresymtablestack.create;
+{$endif}
             if not assigned(genericdef) then
               internalerror(200705151);
             hmodule:=find_module_from_symtable(genericdef.owner);
@@ -362,6 +371,10 @@ implementation
               end;
 
             { Restore symtablestack }
+{$ifndef useoldsearch}
+            current_module.extendeddefs.free;
+            current_module.extendeddefs:=oldextendeddefs;
+{$endif}
             symtablestack.free;
             symtablestack:=oldsymtablestack;
           end
@@ -889,8 +902,6 @@ implementation
          result:=current_structdef;
          { insert in symtablestack }
          symtablestack.push(recst);
-         { parse record }
-         consume(_RECORD);
 
          { usage of specialized type inside its generic template }
          if assigned(genericdef) then
@@ -1472,7 +1483,14 @@ implementation
               end;
             _RECORD:
               begin
-                def:=record_dec(name,genericdef,genericlist);
+                consume(token);
+                if (idtoken=_HELPER) and (m_advanced_records in current_settings.modeswitches) then
+                  begin
+                    consume(_HELPER);
+                    def:=object_dec(odt_helper,name,genericdef,genericlist,nil,ht_record);
+                  end
+                else
+                  def:=record_dec(name,genericdef,genericlist);
               end;
             _PACKED,
             _BITPACKED:

compiler/symbase.pas

@@ -130,8 +130,8 @@ interface
          constructor create;
          destructor destroy;override;
          procedure clear;
-         procedure push(st:TSymtable);
-         procedure pop(st:TSymtable);
+         procedure push(st:TSymtable); virtual;
+         procedure pop(st:TSymtable); virtual;
          function  top:TSymtable;
        end;
 

compiler/symconst.pas

@@ -338,12 +338,6 @@ type
     ht_record
   );
 
-  { defines when helper methods should be searched }
-  thelpersearch=(hs_nosearch, { helper methods are not searched at all }
-    hs_searchfirst,           { search before the actual extended types symbols }
-    hs_searchlast             { search only if no symbol is found in the extended type }
-  );
-
   { Variations in interfaces implementation }
   { Beware, this data is duplicated in the compiler and rtl. }
   { Do not change the order of the fields. }
@@ -470,8 +464,7 @@ type
 
   { options for symtables }
   tsymtableoption = (
-    sto_has_classhelper    { contains at least one class
-                             helper symbol }
+    sto_has_helper         { contains at least one helper symbol }
   );
   tsymtableoptions = set of tsymtableoption;
 

compiler/symdef.pas

@@ -648,6 +648,15 @@ interface
           function  is_publishable : boolean;override;
        end;
 
+       tdefawaresymtablestack = class(TSymtablestack)
+       private
+         procedure addhelpers(st: TSymtable);
+         procedure removehelpers(st: TSymtable);
+       public
+         procedure push(st: TSymtable); override;
+         procedure pop(st: TSymtable); override;
+       end;
+
     var
        current_structdef: tabstractrecorddef; { used for private functions check !! }
        current_genericdef: tstoreddef;        { used to reject declaration of generic class inside generic class }
@@ -923,6 +932,96 @@ implementation
           result := '_' + result;
       end;
 
+{****************************************************************************
+           TDEFAWARESYMTABLESTACK
+           (symtablestack descendant that does some special actions on
+           the pushed/popped symtables)
+****************************************************************************}
+
+    procedure tdefawaresymtablestack.addhelpers(st: TSymtable);
+      var
+        i: integer;
+        s: string;
+        list: TFPObjectList;
+        def: tdef;
+      begin
+        { search the symtable from first to last; the helper to use will be the
+          last one in the list }
+        for i:=0 to st.symlist.count-1 do
+          begin
+            if not (st.symlist[i] is ttypesym) then
+              continue;
+            def:=ttypesym(st.SymList[i]).typedef;
+            if is_objectpascal_helper(def) then
+              begin
+                s:=make_mangledname('',tobjectdef(def).extendeddef.symtable,'');
+                list:=TFPObjectList(current_module.extendeddefs.Find(s));
+                if not assigned(list) then
+                  begin
+                    list:=TFPObjectList.Create(false);
+                    current_module.extendeddefs.Add(s,list);
+                  end;
+                list.Add(def);
+              end
+            else
+              { add nested helpers as well }
+              if def.typ in [recorddef,objectdef] then
+                addhelpers(tabstractrecorddef(def).symtable);
+          end;
+      end;
+
+    procedure tdefawaresymtablestack.removehelpers(st: TSymtable);
+      var
+        i, j: integer;
+        tmpst: TSymtable;
+        list: TFPObjectList;
+      begin
+        for i:=current_module.extendeddefs.count-1 downto 0 do
+          begin
+            list:=TFPObjectList(current_module.extendeddefs[i]);
+            for j:=list.count-1 downto 0 do
+              begin
+                if not (list[j] is tobjectdef) then
+                  Internalerror(2011031501);
+                tmpst:=tobjectdef(list[j]).owner;
+                repeat
+                  if tmpst=st then
+                    begin
+                      list.delete(j);
+                      break;
+                    end
+                  else
+                    begin
+                      if assigned(tmpst.defowner) then
+                        tmpst:=tmpst.defowner.owner
+                      else
+                        tmpst:=nil;
+                    end;
+                until not assigned(tmpst) or (tmpst.symtabletype in [globalsymtable,staticsymtable]);
+              end;
+            if list.count=0 then
+              current_module.extendeddefs.delete(i);
+          end;
+      end;
+
+    procedure tdefawaresymtablestack.push(st: TSymtable);
+      begin
+        { nested helpers will be added as well }
+        if (st.symtabletype in [globalsymtable,staticsymtable]) and
+            (sto_has_helper in st.tableoptions) then
+          addhelpers(st);
+        inherited push(st);
+      end;
+
+    procedure tdefawaresymtablestack.pop(st: TSymtable);
+      begin
+        inherited pop(st);
+        { nested helpers will be removed as well }
+        if (st.symtabletype in [globalsymtable,staticsymtable]) and
+            (sto_has_helper in st.tableoptions) then
+          removehelpers(st);
+      end;
+
 
 {****************************************************************************
                      TDEF (base class for definitions)
@@ -4160,7 +4259,7 @@ implementation
         objecttype:=ot;
         childof:=nil;
         if objecttype=odt_helper then
-          owner.includeoption(sto_has_classhelper);
+          owner.includeoption(sto_has_helper);
         symtable:=tObjectSymtable.create(self,n,current_settings.packrecords);
         { create space for vmt !! }
         vmtentries:=TFPList.Create;

compiler/symtable.pas

@@ -220,19 +220,23 @@ 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;searchhelper:thelpersearch):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;
+    { searches symbols inside of a helper's implementation }
     function  searchsym_in_helper(classh,contextclassh:tobjectdef;const s: TIDString;out srsym:tsym;out srsymtable:TSymtable;aHasInherited:boolean):boolean;
     function  search_system_type(const s: TIDString): ttypesym;
     function  search_named_unit_globaltype(const unitname, typename: TIDString; throwerror: boolean): ttypesym;
     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_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;
+    { searches for the helper definition that's currently active for pd }
+    function  search_last_objectpascal_helper(pd,contextclassh : tabstractrecorddef;out odef : tobjectdef):boolean;
+    { searches whether the symbol s is available in the currently active }
+    { helper for pd }
+    function  search_objectpascal_helper(pd,contextclassh : tabstractrecorddef;const s : string; out srsym: tsym; out srsymtable: tsymtable):boolean;
+    function  search_objc_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;
     {Looks for macro s (must be given in upper case) in the macrosymbolstack, }
     {and returns it if found. Returns nil otherwise.}
@@ -1919,7 +1923,7 @@ implementation
             srsymtable:=stackitem^.symtable;
             if (srsymtable.symtabletype=objectsymtable) then
               begin
-                if searchsym_in_class(tobjectdef(srsymtable.defowner),tobjectdef(srsymtable.defowner),s,srsym,srsymtable,hs_searchfirst) then
+                if searchsym_in_class(tobjectdef(srsymtable.defowner),tobjectdef(srsymtable.defowner),s,srsym,srsymtable,true) then
                   begin
                     result:=true;
                     exit;
@@ -2149,29 +2153,12 @@ implementation
       end;
 
 
-    function searchsym_in_class(classh,contextclassh:tobjectdef;const s : TIDString;out srsym:tsym;out srsymtable:TSymtable;searchhelper:thelpersearch):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) and (searchhelper = hs_searchfirst) then
-          begin
-            result:=search_objectpascal_class_helper(classh,contextclassh,s,srsym,srsymtable);
-            if result then
-              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;
         { in case this is a formal objcclass, first find the real definition }
         if assigned(classh) then
@@ -2182,7 +2169,9 @@ implementation
               or be a parent of contextclassh. E.g. for inherited searches the classh is the
               parent or a class helper. }
             if not (contextclassh.is_related(classh) or
-                (contextclassh.extendeddef=classh)) then
+                (assigned(contextclassh.extendeddef) and
+                (contextclassh.extendeddef.typ=objectdef) and
+                contextclassh.extendeddef.is_related(classh))) then
               internalerror(200811161);
           end;
         result:=false;
@@ -2202,7 +2191,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,hs_nosearch) then
+                if searchsym_in_class(TImplementedInterface(classh.ImplementedInterfaces[i]).intfdef,contextclassh,s,srsym,srsymtable,false) then
                   begin
                     result:=true;
                     exit;
@@ -2221,6 +2210,19 @@ implementation
           begin
             while assigned(classh) do
               begin
+                { search for a class helper method first if this is an Object
+                  Pascal class }
+                if is_class(classh) and searchhelper then
+                  begin
+                    result:=search_objectpascal_helper(classh,contextclassh,s,srsym,srsymtable);
+                    if result then
+                      { if the procsym is overloaded we need to use the
+                        "original" symbol; the helper symbol will be found when
+                        searching for overloads }
+                      if (srsym.typ<>procsym) or
+                          not (sp_has_overloaded in tprocsym(srsym).symoptions) then
+                        exit;
+                  end;
                 srsymtable:=classh.symtable;
                 srsym:=tsym(srsymtable.FindWithHash(hashedid));
                 if assigned(srsym) and
@@ -2234,11 +2236,7 @@ implementation
               end;
           end;
         if is_objcclass(orgclass) then
-          result:=search_class_helper(orgclass,s,srsym,srsymtable)
-        else
-        { this is currently not used, so maybe this can be removed again... }
-        if is_class(orgclass) and (searchhelper = hs_searchlast) then
-          result:=search_objectpascal_class_helper(orgclass,contextclassh,s,srsym,srsymtable)
+          result:=search_objc_helper(orgclass,s,srsym,srsymtable)
         else
           begin
             srsym:=nil;
@@ -2251,6 +2249,15 @@ implementation
         hashedid : THashedIDString;
       begin
         hashedid.id:=s;
+        { search for a record helper method first }
+        result:=search_objectpascal_helper(recordh,recordh,s,srsym,srsymtable);
+        if result then
+          { if the procsym is overloaded we need to use the
+            "original" symbol; the helper symbol will be found when
+            searching for overloads }
+          if (srsym.typ<>procsym) or
+              not (sp_has_overloaded in tprocsym(srsym).symoptions) then
+            exit;
         srsymtable:=recordh.symtable;
         srsym:=tsym(srsymtable.FindWithHash(hashedid));
         if assigned(srsym) and is_visible_for_object(srsym,recordh) then
@@ -2339,88 +2346,59 @@ implementation
     function searchsym_in_helper(classh,contextclassh:tobjectdef;const s: TIDString;out srsym:tsym;out srsymtable:TSymtable;aHasInherited:boolean):boolean;
       var
         hashedid      : THashedIDString;
-        tmpsrsym      : tsym;
-        tmpsrsymtable : tsymtable;
-        found         : boolean;
+        parentclassh  : tobjectdef;
       begin
         if not is_objectpascal_helper(classh) then
           Internalerror(2011030101);
         hashedid.id:=s;
-        if is_class(classh.extendeddef) then
+        { in a helper things are a bit more complex:
+          1. search the symbol in the helper (if not "inherited")
+          2. search the symbol in the extended type
+          3. search the symbol in the parent helpers
+          4. only classes: search the symbol in the parents of the extended type
+        }
+        if not aHasInherited then
           begin
-            { in a class helper things are a bit more complex:
-              1. search the symbol in the helper (if not "inherited")
-              2. search the symbol in the extended type
-              3. search the symbol in the parent helpers
-              4. search the symbol in the parents of the extended type
-              Thus we search in the hierarchy of the extended type first and
-              check whether the returned symtable (if any) belongs to the
-              extended type or one of its parents. If the latter we first
-              check whether one of the helper parents contains a suitable
-              symbol
-            }
-            if not aHasInherited then
-              begin
-                { search in the helper itself }
-                srsymtable:=classh.symtable;
-                srsym:=tsym(srsymtable.FindWithHash(hashedid));
-                if assigned(srsym) and
-                   is_visible_for_object(srsym,contextclassh) then
-                  begin
-                    addsymref(srsym);
-                    result:=true;
-                    exit;
-                  end;
-              end;
-            { search in the hierarchy of the extended class }
-            found:=searchsym_in_class(tobjectdef(classh.extendeddef),contextclassh,s,tmpsrsym,tmpsrsymtable,hs_nosearch);
-            if not found then
-              begin
-                if assigned(classh.childof) then
-                  begin
-                    { the symbol isn't in the extended type's hierarchy,
-                      so search in the parents of the helper }
-                    result:=searchsym_in_class(classh.childof,contextclassh,s,srsym,srsymtable,hs_nosearch);
-                    if result and is_visible_for_object(srsym,contextclassh) then
-                      addsymref(srsym);
-                  end;
-              end
-            else
+            { search in the helper itself }
+            srsymtable:=classh.symtable;
+            srsym:=tsym(srsymtable.FindWithHash(hashedid));
+            if assigned(srsym) and
+               is_visible_for_object(srsym,contextclassh) then
               begin
-                if (tmpsrsymtable.defowner=classh.extendeddef) and
-                    is_visible_for_object(tmpsrsym,contextclassh) then
-                  begin
-                    { the symbol was found in the extended type }
-                    result:=true;
-                    srsym:=tmpsrsym;
-                    srsymtable:=tmpsrsymtable;
-                    exit;
-                  end
-                else
-                  begin
-                    result:=false;
-                    { search in the helper's parents first }
-                    if assigned(classh.childof) then
-                      result:=searchsym_in_helper(classh.childof,contextclassh,s,srsym,srsymtable,false);
-                    if not result then
-                      begin
-                        { we use the symbol found in one of the extended
-                          type's ancestors }
-                        result:=true;
-                        srsym:=tmpsrsym;
-                        srsymtable:=tmpsrsymtable;
-                      end;
-                    if assigned(srsym) and is_visible_for_object(srsym,contextclassh) then
-                      addsymref(srsym);
-                  end;
+                addsymref(srsym);
+                result:=true;
+                exit;
               end;
-          end
-        else if is_record(classh.extendeddef) and
-            searchsym_in_record(classh.extendeddef, s, srsym, srsymtable) then
+          end;
+        { now search in the extended type itself }
+        srsymtable:=classh.extendeddef.symtable;
+        srsym:=tsym(srsymtable.FindWithHash(hashedid));
+        if assigned(srsym) and
+           is_visible_for_object(srsym,contextclassh) then
           begin
+            addsymref(srsym);
             result:=true;
             exit;
           end;
+        { now search in the parent helpers }
+        parentclassh:=classh.childof;
+        while assigned(parentclassh) do
+          begin
+            srsymtable:=parentclassh.symtable;
+            srsym:=tsym(srsymtable.FindWithHash(hashedid));
+            if assigned(srsym) and
+               is_visible_for_object(srsym,contextclassh) then
+              begin
+                addsymref(srsym);
+                result:=true;
+                exit;
+              end;
+            parentclassh:=parentclassh.childof;
+          end;
+          if is_class(classh.extendeddef) then
+            { now search in the parents of the extended class (with helpers!) }
+            result:=searchsym_in_class(tobjectdef(classh.extendeddef).childof,contextclassh,s,srsym,srsymtable,true);
+            { addsymref is already called by searchsym_in_class }
       end;
 
     function search_specific_assignment_operator(assignment_type:ttoken;from_def,to_def:Tdef):Tprocdef;
@@ -2555,12 +2533,19 @@ implementation
           end;
       end;
 
-    function search_last_objectpascal_helper(pd : tabstractrecorddef;out odef : tobjectdef):boolean;
+    function search_last_objectpascal_helper(pd,contextclassh : tabstractrecorddef;out odef : tobjectdef):boolean;
       var
+{$ifdef useoldsearch}
         stackitem : psymtablestackitem;
         i : integer;
         srsymtable : tsymtable;
+{$else}
+        s: string;
+        list: TFPObjectList;
+        i: integer;
+{$endif}
       begin
+{$ifdef useoldsearch}
         result:=false;
         stackitem:=symtablestack.stack;
         while assigned(stackitem) do
@@ -2568,7 +2553,7 @@ implementation
             srsymtable:=stackitem^.symtable;
             { only check symtables that contain a class helper }
             if (srsymtable.symtabletype in [staticsymtable,globalsymtable]) and
-                (sto_has_classhelper in srsymtable.tableoptions) then
+                (sto_has_helper in srsymtable.tableoptions) then
               begin
                 { we need to search from last to first }
                 for i:=srsymtable.symlist.count-1 downto 0 do
@@ -2588,9 +2573,27 @@ implementation
               end;
             stackitem:=stackitem^.next;
           end;
+{$else}
+        result:=false;
+        s:=make_mangledname('',pd.symtable,'');
+        list:=TFPObjectList(current_module.extendeddefs.Find(s));
+        if assigned(list) and (list.count>0) then
+          begin
+            i:=list.count-1;
+            repeat
+              odef:=tobjectdef(list[list.count-1]);
+              result:=(odef.owner.symtabletype in [staticsymtable,globalsymtable]) or
+                      is_visible_for_object(tobjectdef(list[i]).typesym,contextclassh);
+              dec(i);
+            until result or (i<0);
+            if not result then
+              { just to be sure that noone uses odef }
+              odef:=nil;
+          end;
+{$endif}
       end;
 
-    function search_objectpascal_class_helper(pd,contextclassh : tobjectdef;const s: string; out srsym: tsym; out srsymtable: tsymtable):boolean;
+    function search_objectpascal_helper(pd,contextclassh : tabstractrecorddef;const s: string; out srsym: tsym; out srsymtable: tsymtable):boolean;
 
       var
         hashedid  : THashedIDString;
@@ -2602,7 +2605,7 @@ implementation
 
         { if there is no class helper for the class then there is no need to
           search further }
-        if not search_last_objectpascal_helper(pd,classh) then
+        if not search_last_objectpascal_helper(pd,contextclassh,classh) then
           exit;
 
         hashedid.id:=s;
@@ -2629,13 +2632,7 @@ implementation
                   if assigned(current_procinfo) and
                      (srsym.owner.symtabletype=staticsymtable) then
                     include(current_procinfo.flags,pi_uses_static_symtable);
-                  { no need to keep looking. There might be other
-                    categories that extend this, a parent or child
-                    class with a method with the same name (either
-                    overriding this one, or overridden by this one),
-                    but that doesn't matter as far as the basic
-                    procsym is concerned.
-                  }
+                  { the first found method wins }
                   srsym:=tprocdef(tprocsym(srsym).procdeflist[i]).procsym;
                   srsymtable:=srsym.owner;
                   addsymref(srsym);
@@ -2644,7 +2641,7 @@ implementation
                 end;
             end;
 
-          { try the class helper parent if available }
+          { try the helper parent if available }
           classh:=classh.childof;
         until classh=nil;
 
@@ -2652,7 +2649,7 @@ implementation
         srsymtable:=nil;
       end;
 
-    function search_class_helper(pd : tobjectdef;const s : string; out srsym: tsym; out srsymtable: tsymtable):boolean;
+    function search_objc_helper(pd : tobjectdef;const s : string; out srsym: tsym; out srsymtable: tsymtable):boolean;
       var
         hashedid   : THashedIDString;
         stackitem  : psymtablestackitem;
@@ -2796,7 +2793,7 @@ implementation
 
         { not found, now look for class helpers }
         if is_objcclass(pd) then
-          search_class_helper(tobjectdef(orgpd),s,result,srsymtable)
+          search_objc_helper(tobjectdef(orgpd),s,result,srsymtable)
         else
           result:=nil;
       end;
@@ -2864,7 +2861,7 @@ implementation
      begin
         _defaultprop:=nil;
         { first search in helper's hierarchy }
-        if search_last_objectpascal_helper(pd, helperpd) then
+        if search_last_objectpascal_helper(pd,nil,helperpd) then
           while assigned(helperpd) do
             begin
               helperpd.symtable.SymList.ForEachCall(@tstoredsymtable(helperpd.symtable).testfordefaultproperty,@_defaultprop);

compiler/utils/ppudump.pp

@@ -429,8 +429,7 @@ end;
 procedure readsymtableoptions(const s: string);
 type
   tsymtableoption = (
-    sto_has_classhelper    { contains at least one class
-                             helper symbol }
+    sto_has_helper         { contains at least one helper symbol }
   );
   tsymtableoptions = set of tsymtableoption;
   tsymtblopt=record
@@ -440,7 +439,7 @@ type
 const
   symtblopts=1;
   symtblopt : array[1..symtblopts] of tsymtblopt=(
-     (mask:sto_has_classhelper;   str:'Has class helper')
+     (mask:sto_has_helper;   str:'Has helper')
   );
 var
   options : tsymtableoptions;
@@ -1947,7 +1946,7 @@ type
     odt_dispinterface,
     odt_objcclass,
     odt_objcprotocol,
-    odt_classhelper
+    odt_helper
   );
   tvarianttype = (
     vt_normalvariant,vt_olevariant