* Merged helper branch made by Sven Barth

-- Zusammenführen der Unterschiede zwischen Projektarchiv-URLs in ».«:
 U   rtl/inc/objc1.inc
U    rtl/inc/system.inc
U    rtl/objpas/typinfo.pp
A    tests/test/tchlp30.pp
A    tests/test/thlp35.pp
A    tests/test/tchlp3.pp
A    tests/test/thlp7.pp
A    tests/test/trhlp24.pp
A    tests/test/tchlp13.pp
A    tests/test/thlp44.pp
A    tests/test/thlp18.pp
A    tests/test/trhlp33.pp
A    tests/test/tchlp22.pp
A    tests/test/thlp27.pp
A    tests/test/trhlp16.pp
A    tests/test/tchlp31.pp
A    tests/test/thlp36.pp
A    tests/test/tchlp4.pp
A    tests/test/thlp8.pp
A    tests/test/trhlp25.pp
A    tests/test/trhlp1.pp
A    tests/test/uhlp41a.pp
A    tests/test/tchlp40.pp
A    tests/test/tchlp14.pp
A    tests/test/thlp19.pp
A    tests/test/trhlp34.pp
 U   tests/test/ttpara1.pp
A    tests/test/tchlp23.pp
A    tests/test/thlp28.pp
A    tests/test/urhlp14.pp
A    tests/test/trhlp17.pp
A    tests/test/tchlp32.pp
A    tests/test/uhlp43.pp
A    tests/test/thlp37.pp
A    tests/test/tchlp5.pp
A    tests/test/thlp9.pp
A    tests/test/trhlp26.pp
A    tests/test/trhlp2.pp
A    tests/test/uchlp12.pp
A    tests/test/tchlp41.pp
A    tests/test/uhlp41b.pp
A    tests/test/tchlp15.pp
A    tests/test/trhlp35.pp
 U   tests/test/ttpara2.pp
A    tests/test/tchlp50.pp
A    tests/test/tchlp24.pp
A    tests/test/thlp29.pp
A    tests/test/trhlp18.pp
A    tests/test/thlp10.pp
 U   tests/test/cg/ttincdec.pp
A    tests/test/tchlp33.pp
A    tests/test/thlp38.pp
A    tests/test/tchlp6.pp
A    tests/test/trhlp27.pp
A    tests/test/trhlp3.pp
A    tests/test/tchlp42.pp
A    tests/test/tchlp16.pp
A    tests/test/trhlp36.pp
A    tests/test/tchlp51.pp
A    tests/test/tchlp25.pp
A    tests/test/trhlp19.pp
A    tests/test/thlp11.pp
A    tests/test/tchlp34.pp
A    tests/test/thlp39.pp
A    tests/test/tchlp7.pp
A    tests/test/trhlp28.pp
A    tests/test/thlp20.pp
A    tests/test/trhlp4.pp
A    tests/test/tchlp43.pp
A    tests/test/tchlp17.pp
A    tests/test/trhlp37.pp
A    tests/test/tchlp52.pp
A    tests/test/tchlp26.pp
A    tests/test/thlp1.pp
A    tests/test/urhlp17.pp
A    tests/test/thlp12.pp
A    tests/test/tchlp35.pp
A    tests/test/tchlp8.pp
A    tests/test/trhlp29.pp
A    tests/test/thlp21.pp
A    tests/test/trhlp5.pp
A    tests/test/tchlp44.pp
A    tests/test/tchlp18.pp
A    tests/test/trhlp10.pp
A    tests/test/trhlp38.pp
A    tests/test/thlp30.pp
A    tests/test/tchlp53.pp
A    tests/test/tchlp27.pp
A    tests/test/thlp2.pp
A    tests/test/thlp13.pp
A    tests/test/tchlp36.pp
A    tests/test/tchlp9.pp
A    tests/test/thlp22.pp
A    tests/test/trhlp6.pp
A    tests/test/tchlp45.pp
A    tests/test/tchlp19.pp
A    tests/test/trhlp11.pp
A    tests/test/trhlp39.pp
A    tests/test/thlp31.pp
A    tests/test/tchlp54.pp
A    tests/test/tchlp28.pp
A    tests/test/uhlp39.pp
A    tests/test/thlp3.pp
A    tests/test/trhlp20.pp
A    tests/test/thlp40.pp
A    tests/test/thlp14.pp
A    tests/test/tchlp37.pp
A    tests/test/thlp23.pp
A    tests/test/trhlp7.pp
A    tests/test/tchlp46.pp
A    tests/test/trhlp12.pp
A    tests/test/thlp32.pp
A    tests/test/tchlp29.pp
A    tests/test/thlp4.pp
A    tests/test/trhlp21.pp
A    tests/test/tchlp10.pp
A    tests/test/thlp41.pp
A    tests/test/thlp15.pp
A    tests/test/tchlp38.pp
U    tests/test/trtti1.pp
A    tests/test/trhlp30.pp
A    tests/test/thlp24.pp
A    tests/test/trhlp8.pp
A    tests/test/uchlp18.pp
A    tests/test/tchlp47.pp
A    tests/test/trhlp13.pp
A    tests/test/thlp33.pp
A    tests/test/tchlp1.pp
A    tests/test/thlp5.pp
A    tests/test/trhlp22.pp
A    tests/test/tchlp11.pp
A    tests/test/thlp42.pp
A    tests/test/thlp16.pp
A    tests/test/tchlp39.pp
A    tests/test/uhlp3.pp
A    tests/test/trhlp31.pp
A    tests/test/tchlp20.pp
A    tests/test/uhlp31.pp
A    tests/test/thlp25.pp
A    tests/test/trhlp9.pp
A    tests/test/tchlp48.pp
A    tests/test/trhlp40.pp
A    tests/test/trhlp14.pp
A    tests/test/thlp34.pp
A    tests/test/tchlp2.pp
A    tests/test/thlp6.pp
A    tests/test/trhlp23.pp
A    tests/test/tchlp12.pp
A    tests/test/thlp43.pp
A    tests/test/thlp17.pp
A    tests/test/trhlp32.pp
A    tests/test/tchlp21.pp
A    tests/test/thlp26.pp
A    tests/test/tchlp49.pp
A    tests/test/trhlp41.pp
A    tests/test/trhlp15.pp
 U   tests/webtbf/tw13815.pp
 U   tests/tbf/tb0216.pp
U    compiler/msgtxt.inc
U    compiler/nld.pas
U    compiler/dbgdwarf.pas
U    compiler/sparc/cgcpu.pas
U    compiler/fmodule.pas
U    compiler/i386/cgcpu.pas
U    compiler/msgidx.inc
U    compiler/pdecsub.pas
U    compiler/ncgld.pas
U    compiler/symdef.pas
U    compiler/nobj.pas
U    compiler/nflw.pas
U    compiler/pdecobj.pas
U    compiler/objcdef.pas
U    compiler/pinline.pas
U    compiler/pexpr.pas
U    compiler/ncgrtti.pas
U    compiler/x86_64/cgcpu.pas
U    compiler/htypechk.pas
U    compiler/parser.pas
U    compiler/tokens.pas
U    compiler/symbase.pas
U    compiler/ncal.pas
U    compiler/symtable.pas
U    compiler/pp.lpi
U    compiler/m68k/cgcpu.pas
U    compiler/ppu.pas
U    compiler/rautils.pas
U    compiler/arm/cgcpu.pas
U    compiler/ptype.pas
U    compiler/symconst.pas
U    compiler/mips/cgcpu.pas
U    compiler/msg/errore.msg
U    compiler/psub.pas
U    compiler/utils/ppudump.pp
 U   compiler/utils
U    compiler/pdecvar.pas
U    compiler/ncgcal.pas
U    compiler/pdecl.pas
U    compiler/dbgstabs.pas
U    compiler/ppcgen/cgppc.pas
 U   packages/fcl-xml/tests/README_DOM.txt
 U   packages/unzip/src/unzip51g.pp
 U   packages/winunits-base/src/dwmapi.pp
 U   .

git-svn-id: trunk@17328 -

.gitattributes

@@ -9590,6 +9590,60 @@ tests/test/tcase7.pp svneol=native#text/pascal
 tests/test/tcase8.pp svneol=native#text/pascal
 tests/test/tcase9.pp svneol=native#text/pascal
 tests/test/tcg1.pp svneol=native#text/plain
+tests/test/tchlp1.pp svneol=native#text/pascal
+tests/test/tchlp10.pp svneol=native#text/pascal
+tests/test/tchlp11.pp svneol=native#text/pascal
+tests/test/tchlp12.pp svneol=native#text/pascal
+tests/test/tchlp13.pp svneol=native#text/pascal
+tests/test/tchlp14.pp svneol=native#text/pascal
+tests/test/tchlp15.pp svneol=native#text/pascal
+tests/test/tchlp16.pp svneol=native#text/pascal
+tests/test/tchlp17.pp svneol=native#text/pascal
+tests/test/tchlp18.pp svneol=native#text/pascal
+tests/test/tchlp19.pp svneol=native#text/pascal
+tests/test/tchlp2.pp svneol=native#text/pascal
+tests/test/tchlp20.pp svneol=native#text/pascal
+tests/test/tchlp21.pp svneol=native#text/pascal
+tests/test/tchlp22.pp svneol=native#text/pascal
+tests/test/tchlp23.pp svneol=native#text/pascal
+tests/test/tchlp24.pp svneol=native#text/pascal
+tests/test/tchlp25.pp svneol=native#text/pascal
+tests/test/tchlp26.pp svneol=native#text/pascal
+tests/test/tchlp27.pp svneol=native#text/pascal
+tests/test/tchlp28.pp svneol=native#text/pascal
+tests/test/tchlp29.pp svneol=native#text/pascal
+tests/test/tchlp3.pp svneol=native#text/pascal
+tests/test/tchlp30.pp svneol=native#text/pascal
+tests/test/tchlp31.pp svneol=native#text/pascal
+tests/test/tchlp32.pp svneol=native#text/pascal
+tests/test/tchlp33.pp svneol=native#text/pascal
+tests/test/tchlp34.pp svneol=native#text/pascal
+tests/test/tchlp35.pp svneol=native#text/pascal
+tests/test/tchlp36.pp svneol=native#text/pascal
+tests/test/tchlp37.pp svneol=native#text/pascal
+tests/test/tchlp38.pp svneol=native#text/pascal
+tests/test/tchlp39.pp svneol=native#text/pascal
+tests/test/tchlp4.pp svneol=native#text/pascal
+tests/test/tchlp40.pp svneol=native#text/pascal
+tests/test/tchlp41.pp svneol=native#text/pascal
+tests/test/tchlp42.pp svneol=native#text/pascal
+tests/test/tchlp43.pp svneol=native#text/pascal
+tests/test/tchlp44.pp svneol=native#text/pascal
+tests/test/tchlp45.pp svneol=native#text/pascal
+tests/test/tchlp46.pp svneol=native#text/pascal
+tests/test/tchlp47.pp svneol=native#text/pascal
+tests/test/tchlp48.pp svneol=native#text/pascal
+tests/test/tchlp49.pp svneol=native#text/pascal
+tests/test/tchlp5.pp svneol=native#text/pascal
+tests/test/tchlp50.pp svneol=native#text/pascal
+tests/test/tchlp51.pp svneol=native#text/pascal
+tests/test/tchlp52.pp svneol=native#text/pascal
+tests/test/tchlp53.pp svneol=native#text/pascal
+tests/test/tchlp54.pp svneol=native#text/pascal
+tests/test/tchlp6.pp svneol=native#text/pascal
+tests/test/tchlp7.pp svneol=native#text/pascal
+tests/test/tchlp8.pp svneol=native#text/pascal
+tests/test/tchlp9.pp svneol=native#text/pascal
 tests/test/tcint64.pp svneol=native#text/plain
 tests/test/tclass1.pp svneol=native#text/plain
 tests/test/tclass10.pp svneol=native#text/pascal
@@ -9751,6 +9805,50 @@ tests/test/theap.pp svneol=native#text/plain
 tests/test/theapthread.pp svneol=native#text/plain
 tests/test/thintdir.pp svneol=native#text/plain
 tests/test/thintdir1.pp svneol=native#text/pascal
+tests/test/thlp1.pp svneol=native#text/pascal
+tests/test/thlp10.pp svneol=native#text/pascal
+tests/test/thlp11.pp svneol=native#text/pascal
+tests/test/thlp12.pp svneol=native#text/pascal
+tests/test/thlp13.pp svneol=native#text/pascal
+tests/test/thlp14.pp svneol=native#text/pascal
+tests/test/thlp15.pp svneol=native#text/pascal
+tests/test/thlp16.pp svneol=native#text/pascal
+tests/test/thlp17.pp svneol=native#text/pascal
+tests/test/thlp18.pp svneol=native#text/pascal
+tests/test/thlp19.pp svneol=native#text/pascal
+tests/test/thlp2.pp svneol=native#text/pascal
+tests/test/thlp20.pp svneol=native#text/pascal
+tests/test/thlp21.pp svneol=native#text/pascal
+tests/test/thlp22.pp svneol=native#text/pascal
+tests/test/thlp23.pp svneol=native#text/pascal
+tests/test/thlp24.pp svneol=native#text/pascal
+tests/test/thlp25.pp svneol=native#text/pascal
+tests/test/thlp26.pp svneol=native#text/pascal
+tests/test/thlp27.pp svneol=native#text/pascal
+tests/test/thlp28.pp svneol=native#text/pascal
+tests/test/thlp29.pp svneol=native#text/pascal
+tests/test/thlp3.pp svneol=native#text/pascal
+tests/test/thlp30.pp svneol=native#text/pascal
+tests/test/thlp31.pp svneol=native#text/pascal
+tests/test/thlp32.pp svneol=native#text/pascal
+tests/test/thlp33.pp svneol=native#text/pascal
+tests/test/thlp34.pp svneol=native#text/pascal
+tests/test/thlp35.pp svneol=native#text/pascal
+tests/test/thlp36.pp svneol=native#text/pascal
+tests/test/thlp37.pp svneol=native#text/pascal
+tests/test/thlp38.pp svneol=native#text/pascal
+tests/test/thlp39.pp svneol=native#text/pascal
+tests/test/thlp4.pp svneol=native#text/pascal
+tests/test/thlp40.pp svneol=native#text/pascal
+tests/test/thlp41.pp svneol=native#text/pascal
+tests/test/thlp42.pp svneol=native#text/pascal
+tests/test/thlp43.pp svneol=native#text/pascal
+tests/test/thlp44.pp svneol=native#text/pascal
+tests/test/thlp5.pp svneol=native#text/pascal
+tests/test/thlp6.pp svneol=native#text/pascal
+tests/test/thlp7.pp svneol=native#text/pascal
+tests/test/thlp8.pp svneol=native#text/pascal
+tests/test/thlp9.pp svneol=native#text/pascal
 tests/test/timplements1.pp svneol=native#text/plain
 tests/test/timplements2.pp svneol=native#text/plain
 tests/test/timplements3.pp svneol=native#text/plain
@@ -10017,6 +10115,47 @@ tests/test/trecreg2.pp svneol=native#text/plain
 tests/test/trecreg3.pp svneol=native#text/plain
 tests/test/trecreg4.pp svneol=native#text/plain
 tests/test/tresstr.pp svneol=native#text/plain
+tests/test/trhlp1.pp svneol=native#text/pascal
+tests/test/trhlp10.pp svneol=native#text/pascal
+tests/test/trhlp11.pp svneol=native#text/pascal
+tests/test/trhlp12.pp svneol=native#text/pascal
+tests/test/trhlp13.pp svneol=native#text/pascal
+tests/test/trhlp14.pp svneol=native#text/pascal
+tests/test/trhlp15.pp svneol=native#text/pascal
+tests/test/trhlp16.pp svneol=native#text/pascal
+tests/test/trhlp17.pp svneol=native#text/pascal
+tests/test/trhlp18.pp svneol=native#text/pascal
+tests/test/trhlp19.pp svneol=native#text/pascal
+tests/test/trhlp2.pp svneol=native#text/pascal
+tests/test/trhlp20.pp svneol=native#text/pascal
+tests/test/trhlp21.pp svneol=native#text/pascal
+tests/test/trhlp22.pp svneol=native#text/pascal
+tests/test/trhlp23.pp svneol=native#text/pascal
+tests/test/trhlp24.pp svneol=native#text/pascal
+tests/test/trhlp25.pp svneol=native#text/pascal
+tests/test/trhlp26.pp svneol=native#text/pascal
+tests/test/trhlp27.pp svneol=native#text/pascal
+tests/test/trhlp28.pp svneol=native#text/pascal
+tests/test/trhlp29.pp svneol=native#text/pascal
+tests/test/trhlp3.pp svneol=native#text/pascal
+tests/test/trhlp30.pp svneol=native#text/pascal
+tests/test/trhlp31.pp svneol=native#text/pascal
+tests/test/trhlp32.pp svneol=native#text/pascal
+tests/test/trhlp33.pp svneol=native#text/pascal
+tests/test/trhlp34.pp svneol=native#text/pascal
+tests/test/trhlp35.pp svneol=native#text/pascal
+tests/test/trhlp36.pp svneol=native#text/pascal
+tests/test/trhlp37.pp svneol=native#text/pascal
+tests/test/trhlp38.pp svneol=native#text/pascal
+tests/test/trhlp39.pp svneol=native#text/pascal
+tests/test/trhlp4.pp svneol=native#text/pascal
+tests/test/trhlp40.pp svneol=native#text/pascal
+tests/test/trhlp41.pp svneol=native#text/pascal
+tests/test/trhlp5.pp svneol=native#text/pascal
+tests/test/trhlp6.pp svneol=native#text/pascal
+tests/test/trhlp7.pp svneol=native#text/pascal
+tests/test/trhlp8.pp svneol=native#text/pascal
+tests/test/trhlp9.pp svneol=native#text/pascal
 tests/test/trox1.pp svneol=native#text/plain
 tests/test/trox2.pp svneol=native#text/plain
 tests/test/trstr1.pp svneol=native#text/plain
@@ -10125,6 +10264,8 @@ tests/test/twrstr6.pp svneol=native#text/plain
 tests/test/twrstr7.pp svneol=native#text/plain
 tests/test/twrstr8.pp svneol=native#text/plain
 tests/test/uabstrcl.pp svneol=native#text/plain
+tests/test/uchlp12.pp svneol=native#text/pascal
+tests/test/uchlp18.pp svneol=native#text/pascal
 tests/test/uenum2a.pp svneol=native#text/plain
 tests/test/uenum2b.pp svneol=native#text/plain
 tests/test/ugeneric10.pp svneol=native#text/plain
@@ -10133,6 +10274,12 @@ tests/test/ugeneric3.pp svneol=native#text/plain
 tests/test/ugeneric4.pp svneol=native#text/plain
 tests/test/ugeneric7.pp svneol=native#text/plain
 tests/test/uhintdir.pp svneol=native#text/plain
+tests/test/uhlp3.pp svneol=native#text/pascal
+tests/test/uhlp31.pp svneol=native#text/pascal
+tests/test/uhlp39.pp svneol=native#text/pascal
+tests/test/uhlp41a.pp svneol=native#text/pascal
+tests/test/uhlp41b.pp svneol=native#text/pascal
+tests/test/uhlp43.pp svneol=native#text/pascal
 tests/test/uimpluni1.pp svneol=native#text/plain
 tests/test/uimpluni2.pp svneol=native#text/plain
 tests/test/uinline4a.pp svneol=native#text/plain
@@ -10296,6 +10443,8 @@ tests/test/uprec6.pp svneol=native#text/plain
 tests/test/uprec7.pp svneol=native#text/plain
 tests/test/uprocext1.pp svneol=native#text/plain
 tests/test/uprocext2.pp svneol=native#text/plain
+tests/test/urhlp14.pp svneol=native#text/pascal
+tests/test/urhlp17.pp svneol=native#text/pascal
 tests/test/utasout.pp svneol=native#text/plain
 tests/test/uunit1.pp svneol=native#text/plain
 tests/test/uunit2a.pp svneol=native#text/plain

compiler/arm/cgcpu.pas

@@ -2488,7 +2488,8 @@ unit cgcpu;
         g_adjust_self_value(list,procdef,ioffset);
 
         { case 4 }
-        if po_virtualmethod in procdef.procoptions then
+        if (po_virtualmethod in procdef.procoptions) and
+            not is_objectpascal_helper(procdef.struct) then
           begin
             loadvmttor12;
             op_onr12methodaddr;

compiler/dbgdwarf.pas

@@ -2083,7 +2083,8 @@ implementation
           append_attribute(DW_AT_external,DW_FORM_flag,[true]);
         { Abstract or virtual/overriding method.  }
         if (([po_abstractmethod, po_virtualmethod, po_overridingmethod] * def.procoptions) <> []) and
-           not is_objc_class_or_protocol(def.struct) then
+           not is_objc_class_or_protocol(def.struct) and
+           not is_objectpascal_helper(def.struct) then
           begin
             if not(po_abstractmethod in def.procoptions) then
               append_attribute(DW_AT_virtuality,DW_FORM_data1,[ord(DW_VIRTUALITY_virtual)])

compiler/dbgstabs.pas

@@ -416,7 +416,8 @@ implementation
         if tsym(p).typ = procsym then
          begin
            pd :=tprocdef(tprocsym(p).ProcdefList[0]);
-           if (po_virtualmethod in pd.procoptions) then
+           if (po_virtualmethod in pd.procoptions) and
+               not is_objectpascal_helper(pd.struct) then
              begin
                lindex := pd.extnumber;
                {doesnt seem to be necessary

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;
@@ -596,6 +602,7 @@ implementation
         linkotherframeworks.Free;
         stringdispose(mainname);
         FImportLibraryList.Free;
+        extendeddefs.Free;
         stringdispose(objfilename);
         stringdispose(asmfilename);
         stringdispose(ppufilename);

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,13 +1795,32 @@ 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
@@ -1810,23 +1829,38 @@ implementation
         hasoverload:=false;
         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 }
               (srsym.typ=procsym) then
              begin
-               { Store first procsym found }
-               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;
+               hasoverload:=processprocsym(tprocsym(srsym));
                { when there is no explicit overload we stop searching }
                if not hasoverload then
                  break;
@@ -1911,7 +1945,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 +1963,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 +1973,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/i386/cgcpu.pas

@@ -644,7 +644,8 @@ unit cgcpu;
         { set param1 interface to self  }
         g_adjust_self_value(list,procdef,ioffset);
 
-        if po_virtualmethod in procdef.procoptions then
+        if (po_virtualmethod in procdef.procoptions) and
+            not is_objectpascal_helper(procdef.struct) then
           begin
             if (procdef.proccalloption=pocall_register) then
               begin

compiler/m68k/cgcpu.pas

@@ -1605,7 +1605,8 @@ unit cgcpu;
 //        g_adjust_self_value(list,procdef,ioffset);
 
         { case 4 }
-        if po_virtualmethod in procdef.procoptions then
+        if (po_virtualmethod in procdef.procoptions) and
+            not is_objectpascal_helper(procdef.struct) then
           begin
 //            loadvmttor11;
 //            op_onr11methodaddr;

compiler/mips/cgcpu.pas

@@ -1679,7 +1679,8 @@ begin
   { set param1 interface to self  }
   g_adjust_self_value(list, procdef, ioffset);
 
-  if po_virtualmethod in procdef.procoptions then
+  if (po_virtualmethod in procdef.procoptions) and
+      not is_objectpascal_helper(procdef.struct) then
   begin
     loadvmttor24;
     op_onr24methodaddr;

compiler/msg/errore.msg

@@ -368,7 +368,7 @@ scanner_w_illegal_warn_identifier=02087_W_Illegal identifier "$1" for $WARN dire
 #
 # Parser
 #
-# 03304 is the last used one
+# 03309 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 Objective-C protocol or category cannot contain fields
-% Declarations of fields are not allowed in interfaces and Objective-C protocols and categories.
-% An interface/protocol/category can contain only methods and properties with method read/write specifiers.
+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, helpers and Objective-C protocols and categories.
+% 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.
@@ -1264,9 +1264,12 @@ parser_e_objc_message_name_changed=03275_E_Message name "$1" in inherited class
 parser_e_no_objc_unique=03276_E_It is not yet possible to make unique copies of Objective-C types
 % Duplicating an Objective-C type using \var{type x = type y;} is not yet supported. You may be able to
 % obtain the desired effect using \var{type x = objcclass(y) end;} instead.
-parser_e_no_category_as_types=03277_E_Objective-C categories cannot be used as types
-% It is not possible to declare a variable as an instance of an Objective-C category. A
-% category adds methods to the scope of an existing class, but does not define a type by itself.
+parser_e_no_category_as_types=03277_E_Objective-C categories and Object Pascal class helpers cannot be used as types
+% It is not possible to declare a variable as an instance of an Objective-C
+% category or an Object Pascal class helper. A category/class helper adds
+% methods to the scope of an existing class, but does not define a type by
+% itself. An exception of this rule is when inheriting an Object Pascal class
+% helper from another class helper.
 parser_e_no_category_override=03278_E_Categories do not override, but replace methods. Use "reintroduce" instead.
 parser_e_must_use_reintroduce_objc=03279_E_Replaced methods can only be reintroduced in Objective-C, add "reintroduce" (replaced method defined in $1).
 parser_h_should_use_reintroduce_objc=03280_H_Replaced methods can only be reintroduced in Objective-C, add "reintroduce" (replaced method defined in $1).
@@ -1352,27 +1355,37 @@ 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
-% Destructor declarations aren't allowed in records.
+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. 
-% \end{description}
+% code which is implicitly generated by the compiler.
 parser_e_externals_no_section=03305_E_Variables being declared as external cannot be in a custom section
 % A section directive is not valid for variables being declared as external.
 parser_e_section_no_locals=03306_E_Non-static and non-global variables cannot have a section directive
 % A variable placed in a custom section is always statically allocated so it must be either a static or global variable.
+parser_e_not_allowed_in_helper=03307_E_"$1" is not allowed in helper types
+% Some directives and specifiers like "virtual", "dynamic", "override" aren't
+% allowed inside helper types in mode ObjFPC (they are ignored in mode Delphi),
+% because they have no meaning within helpers. Also "abstract" isn't allowed in
+% either mode.
+parser_e_no_class_constructor_in_helpers=03308_E_Class constructors aren't allowed in helpers
+% Class constructor declarations aren't allowed in helpers.
+parser_e_inherited_not_in_record=03309_E_The use of "inherited" is not allowed in a record
+% As records don't suppport inheritance the use of "inherited" is prohibited for
+% these as well as for record helpers (in mode "Delphi" only).
+% \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
@@ -1720,6 +1733,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

@@ -395,6 +395,9 @@ const
   parser_e_cant_use_type_parameters_here=03304;
   parser_e_externals_no_section=03305;
   parser_e_section_no_locals=03306;
+  parser_e_not_allowed_in_helper=03307;
+  parser_e_no_class_constructor_in_helpers=03308;
+  parser_e_inherited_not_in_record=03309;
   type_e_mismatch=04000;
   type_e_incompatible_types=04001;
   type_e_not_equal_types=04002;
@@ -484,6 +487,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;
@@ -884,9 +891,9 @@ const
   option_info=11024;
   option_help_pages=11025;
 
-  MsgTxtSize = 58848;
+  MsgTxtSize = 59257;
 
   MsgIdxMax : array[1..20] of longint=(
-    24,88,307,99,84,54,111,22,202,63,
+    24,88,310,103,84,54,111,22,202,63,
     49,20,1,1,1,1,1,1,1,1
   );

compiler/ncal.pas

@@ -2713,7 +2713,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
@@ -3238,6 +3238,14 @@ implementation
       begin
          result:=nil;
 
+         { as pass_1 is never called on the methodpointer node, we must check
+           here that it's not a helper type }
+         if assigned(methodpointer) and
+             (methodpointer.nodetype=typen) and
+             is_objectpascal_helper(ttypenode(methodpointer).typedef) and
+             not ttypenode(methodpointer).helperallowed then
+           Message(parser_e_no_category_as_types);
+
          { convert Objective-C calls into a message call }
          if (procdefinition.typ=procdef) and
             (po_objc in tprocdef(procdefinition).procoptions) then

compiler/ncgcal.pas

@@ -697,6 +697,7 @@ implementation
                otherwise optimised called methods are no longer registered)
              }
              if (po_virtualmethod in procdefinition.procoptions) and
+                not is_objectpascal_helper(tprocdef(procdefinition).struct) and
                 assigned(methodpointer) and
                 (methodpointer.nodetype<>typen) and
                 (not assigned(current_procinfo) or
@@ -717,6 +718,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

@@ -338,7 +338,8 @@ implementation
                 { When there was an error then procdef is not assigned }
                 if not assigned(propaccesslist.procdef) then
                   exit;
-                if not(po_virtualmethod in tprocdef(propaccesslist.procdef).procoptions) then
+                if not(po_virtualmethod in tprocdef(propaccesslist.procdef).procoptions) or
+                   is_objectpascal_helper(tprocdef(propaccesslist.procdef).struct) then
                   begin
                      current_asmdata.asmlists[al_rtti].concat(Tai_const.createname(tprocdef(propaccesslist.procdef).mangledname,0));
                      typvalue:=1;
@@ -767,10 +768,11 @@ implementation
             propnamelist:=TFPHashObjectList.Create;
             collect_propnamelist(propnamelist,def);
 
-            if (oo_has_vmt in def.objectoptions) then
-              current_asmdata.asmlists[al_rtti].concat(Tai_const.Createname(def.vmt_mangledname,0))
-            else
-              current_asmdata.asmlists[al_rtti].concat(Tai_const.create_sym(nil));
+            if not is_objectpascal_helper(def) then
+              if (oo_has_vmt in def.objectoptions) then
+                current_asmdata.asmlists[al_rtti].concat(Tai_const.Createname(def.vmt_mangledname,0))
+              else
+                current_asmdata.asmlists[al_rtti].concat(Tai_const.create_sym(nil));
 
             { write parent typeinfo }
             if assigned(def.childof) then
@@ -778,6 +780,13 @@ implementation
             else
               current_asmdata.asmlists[al_rtti].concat(Tai_const.create_sym(nil));
 
+            { write typeinfo of extended type }
+            if is_objectpascal_helper(def) then
+              if assigned(def.extendeddef) then
+                current_asmdata.asmlists[al_rtti].concat(Tai_const.Create_sym(ref_rtti(def.extendeddef,fullrtti)))
+              else
+                InternalError(2011033001);
+
             { total number of unique properties }
             current_asmdata.asmlists[al_rtti].concat(Tai_const.Create_16bit(propnamelist.count));
 
@@ -860,6 +869,8 @@ implementation
                current_asmdata.asmlists[al_rtti].concat(Tai_const.Create_8bit(tkinterface));
              odt_interfacecorba:
                current_asmdata.asmlists[al_rtti].concat(Tai_const.Create_8bit(tkinterfaceCorba));
+             odt_helper:
+               current_asmdata.asmlists[al_rtti].concat(Tai_const.Create_8bit(tkhelper));
              else
                internalerror(200611034);
            end;
@@ -871,7 +882,7 @@ implementation
            case rt of
              initrtti :
                begin
-                 if def.objecttype in [odt_class,odt_object] then
+                 if def.objecttype in [odt_class,odt_object,odt_helper] then
                    objectdef_rtti_fields(def)
                  else
                    objectdef_rtti_interface_init(def);
@@ -879,6 +890,7 @@ implementation
              fullrtti :
                begin
                  case def.objecttype of
+                   odt_helper,
                    odt_class:
                      objectdef_rtti_class_full(def);
                    odt_object:

compiler/nflw.pas

@@ -824,6 +824,7 @@ implementation
     function create_for_in_loop(hloopvar, hloopbody, expr: tnode): tnode;
       var
         pd, movenext: tprocdef;
+        helperdef: tobjectdef;
         current: tpropertysym;
         storefilepos: tfileposinfo;
       begin
@@ -859,9 +860,20 @@ implementation
               begin
                 // search for operator first
                 pd:=search_enumerator_operator(expr.resultdef, hloopvar.resultdef);
-                // if there is no operator then search for class/object/record enumerator method
+                // if there is no operator then search for class/object enumerator method
                 if (pd=nil) and (expr.resultdef.typ in [objectdef,recorddef]) then
-                  pd:=tabstractrecorddef(expr.resultdef).search_enumerator_get;
+                  begin
+                    { first search using the helper hierarchy }
+                    if search_last_objectpascal_helper(tabstractrecorddef(expr.resultdef),nil,helperdef) then
+                      repeat
+                        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;
+                  end;
                 if pd<>nil then
                   begin
                     // seach movenext and current symbols

compiler/nld.pas

@@ -101,6 +101,7 @@ interface
 
        ttypenode = class(tnode)
           allowed : boolean;
+          helperallowed : boolean;
           typedef : tdef;
           typedefderef : tderef;
           constructor create(def:tdef);virtual;
@@ -302,6 +303,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)
@@ -1032,6 +1035,7 @@ implementation
          inherited create(typen);
          typedef:=def;
          allowed:=false;
+         helperallowed:=false;
       end;
 
 
@@ -1040,6 +1044,7 @@ implementation
         inherited ppuload(t,ppufile);
         ppufile.getderef(typedefderef);
         allowed:=boolean(ppufile.getbyte);
+        helperallowed:=boolean(ppufile.getbyte);
       end;
 
 
@@ -1048,6 +1053,7 @@ implementation
         inherited ppuwrite(ppufile);
         ppufile.putderef(typedefderef);
         ppufile.putbyte(byte(allowed));
+        ppufile.putbyte(byte(helperallowed));
       end;
 
 
@@ -1085,6 +1091,8 @@ implementation
            an error }
          if not allowed then
           Message(parser_e_no_type_not_allowed_here);
+         if not helperallowed and is_objectpascal_helper(typedef) then
+           Message(parser_e_no_category_as_types);
       end;
 
 
@@ -1095,6 +1103,7 @@ implementation
          n:=ttypenode(inherited dogetcopy);
          n.allowed:=allowed;
          n.typedef:=typedef;
+         n.helperallowed:=helperallowed;
          result:=n;
       end;
 

compiler/nobj.pas

@@ -270,7 +270,8 @@ implementation
 
           { check that we are not trying to override a final method }
           if (po_finalmethod in vmtpd.procoptions) and
-             hasequalpara and (po_overridingmethod in pd.procoptions) and is_class(_class) then
+             hasequalpara and (po_overridingmethod in pd.procoptions) and
+             (is_class(_class) or is_objectpascal_helper(_class)) then
             MessagePos1(pd.fileinfo,parser_e_final_can_no_be_overridden,pd.fullprocname(false))
           else
           { old definition has virtual
@@ -281,8 +282,11 @@ implementation
               (
                { new one does not have reintroduce in case of an objccategory }
                (is_objccategory(_class) and not(po_reintroduce in pd.procoptions)) or
-               { new one does not have override in case of objpas/objc class/intf/proto }
-               (is_class_or_interface_or_objc(_class) and not is_objccategory(_class) and not(po_overridingmethod in pd.procoptions))
+               { new one does not have override in case of objpas/objc class/helper/intf/proto }
+               (
+                (is_class_or_interface_or_objc(_class) or is_objectpascal_helper(_class)) and
+                not is_objccategory(_class) and not(po_overridingmethod in pd.procoptions)
+               )
               )
              ) then
             begin
@@ -456,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/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/parser.pas

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

compiler/pdecl.pas

@@ -501,7 +501,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
@@ -645,7 +645,8 @@ implementation
               end;
             end;
 
-           if isgeneric and not(hdef.typ in [objectdef,recorddef,arraydef,procvardef]) then
+           if isgeneric and (not(hdef.typ in [objectdef,recorddef,arraydef,procvardef])
+               or is_objectpascal_helper(hdef)) then
              message(parser_e_cant_create_generics_of_this_type);
 
            { Stop recording a generic template }

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 }
-        if not((is_class_or_interface_or_dispinterface(current_structdef) or is_record(current_structdef)) or
+        { check for a class, record or helper }
+        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);
@@ -423,6 +423,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;
 
@@ -522,6 +523,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;
@@ -576,6 +583,62 @@ implementation
           end;
       end;
 
+    procedure parse_extended_type(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,[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
@@ -651,14 +714,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;
@@ -668,7 +731,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;
@@ -776,7 +839,8 @@ implementation
                         if object_member_blocktype=bt_general then
                           begin
                             if is_interface(current_structdef) or
-                               is_objc_protocol_or_category(current_structdef) then
+                               is_objc_protocol_or_category(current_structdef) or
+                               is_objectpascal_helper(current_structdef) then
                               Message(parser_e_no_vars_in_interfaces);
 
                             if (current_structdef.symtable.currentvisibility=vis_published) and
@@ -852,6 +916,12 @@ implementation
                     if (m_mac in current_settings.modeswitches) then
                       include(pd.procoptions,po_virtualmethod);
 
+                    { for record helpers only static class methods are allowed }
+                    if is_objectpascal_helper(current_structdef) and
+                        is_record(current_objectdef.extendeddef) and
+                        is_classdef and not (po_staticmethod in pd.procoptions) then
+                      MessagePos(pd.fileinfo, parser_e_class_methods_only_static_in_records);
+
                     handle_calling_convention(pd);
 
                     { add definition to procsym }
@@ -891,6 +961,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^);
@@ -932,6 +1012,10 @@ implementation
                 if is_interface(current_structdef) then
                   Message(parser_e_no_con_des_in_interfaces);
 
+                { (class) destructors are not allowed in class helpers }
+                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
                   Message(parser_w_destructor_should_be_public);
 
@@ -978,12 +1062,15 @@ 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,
         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;
@@ -1059,7 +1146,7 @@ implementation
         { set published flag in $M+ mode, it can also be inherited and will
           be added when the parent class set with tobjectdef.set_parent (PFV) }
         if (cs_generate_rtti in current_settings.localswitches) and
-           (current_objectdef.objecttype in [odt_interfacecom,odt_class]) then
+           (current_objectdef.objecttype in [odt_interfacecom,odt_class,odt_helper]) then
           include(current_structdef.objectoptions,oo_can_have_published);
 
         { Objective-C objectdefs can be "formal definitions", in which case
@@ -1086,6 +1173,10 @@ implementation
                 include(current_structdef.objectoptions,oo_is_classhelper);
               end;
 
+            { include the class helper flag for Object Pascal helpers }
+            if (objecttype=odt_helper) then
+              include(current_objectdef.objectoptions,oo_is_classhelper);
+
             { parse list of options (abstract / sealed) }
             if not(objecttype in [odt_objcclass,odt_objcprotocol,odt_objccategory]) then
               parse_object_options;
@@ -1095,7 +1186,19 @@ implementation
             parse_generic:=(df_generic in current_structdef.defoptions);
 
             { parse list of parent classes }
-            parse_parent_classes;
+            { for record helpers in mode Delphi this is not allowed }
+            if not (is_objectpascal_helper(current_objectdef) and
+                (m_delphi in current_settings.modeswitches) and
+                (helpertype=ht_record)) then
+              parse_parent_classes
+            else
+              { remove forward flag, is resolved (this is normally done inside
+                parse_parent_classes) }
+              exclude(current_structdef.objectoptions,oo_is_forward);
+
+            { parse extended type for helpers }
+            if is_objectpascal_helper(current_structdef) then
+              parse_extended_type(helpertype);
 
             { parse optional GUID for interfaces }
             parse_guid;
@@ -1127,6 +1230,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

@@ -43,7 +43,8 @@ interface
         pd_dispinterface,{ directive can be used with dispinterface methods }
         pd_cppobject,    { directive can be used with cppclass }
         pd_objcclass,    { directive can be used with objcclass }
-        pd_objcprot      { directive can be used with objcprotocol }
+        pd_objcprot,     { directive can be used with objcprotocol }
+        pd_nothelper     { directive can not be used with record/class helper declaration }
       );
       tpdflags=set of tpdflag;
 
@@ -244,6 +245,7 @@ implementation
         storepos : tfileposinfo;
         vs       : tparavarsym;
         hdef     : tdef;
+        selfdef  : tabstractrecorddef;
         vsp      : tvarspez;
         aliasvs  : tabsolutevarsym;
         sl       : tpropaccesslist;
@@ -301,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);
@@ -1633,6 +1641,8 @@ procedure pd_abstract(pd:tabstractprocdef);
 begin
   if pd.typ<>procdef then
     internalerror(200304269);
+  if is_objectpascal_helper(tprocdef(pd).struct) then
+    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,6 +1659,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_helper, arraytokeninfo[_FINAL].str);
   if (po_virtualmethod in pd.procoptions) then
     include(pd.procoptions,po_finalmethod)
   else
@@ -1694,6 +1707,9 @@ begin
   if (pd.proctypeoption=potype_constructor) and
      is_object(tprocdef(pd).struct) then
     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_helper, arraytokeninfo[_VIRTUAL].str);
 {$ifdef WITHDMT}
   if is_object(tprocdef(pd).struct) and
      (token<>_SEMICOLON) then
@@ -1743,7 +1759,12 @@ procedure pd_override(pd:tabstractprocdef);
 begin
   if pd.typ<>procdef then
     internalerror(2003042611);
-  if not(is_class_or_interface_or_objc(tprocdef(pd).struct)) then
+  if is_objectpascal_helper(tprocdef(pd).struct) then
+    begin
+      if m_objfpc in current_settings.modeswitches then
+        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)
   else if is_objccategory(tprocdef(pd).struct) then
     Message(parser_e_no_category_override)
@@ -1767,9 +1788,15 @@ var
 begin
   if pd.typ<>procdef then
     internalerror(2003042613);
-  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 is_objectpascal_helper(tprocdef(pd).struct) then
+    begin
+      if m_objfpc in current_settings.modeswitches then
+        Message1(parser_e_not_allowed_in_helper, arraytokeninfo[_MESSAGE].str);
+    end
+  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 }
@@ -1798,7 +1825,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
@@ -1822,9 +1850,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
-     not(is_objccategory(tprocdef(pd).struct)) then
-    Message(parser_e_no_object_reintroduce);
+  if is_objectpascal_helper(tprocdef(pd).struct) then
+    begin
+      if m_objfpc in current_settings.modeswitches then
+        Message1(parser_e_not_allowed_in_helper, arraytokeninfo[_REINTRODUCE].str);
+    end
+  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;
 
 
@@ -2176,7 +2210,7 @@ const
       mutexclpo     : [po_exports,po_interrupt,po_external,po_overridingmethod,po_inline]
     ),(
       idtok:_EXPORT;
-      pd_flags : [pd_body,pd_interface,pd_implemen,pd_notobjintf,pd_notrecord];
+      pd_flags : [pd_body,pd_interface,pd_implemen,pd_notobjintf,pd_notrecord,pd_nothelper];
       handler  : @pd_export;
       pocall   : pocall_none;
       pooption : [po_exports,po_global];
@@ -2185,7 +2219,7 @@ const
       mutexclpo     : [po_external,po_interrupt,po_inline]
     ),(
       idtok:_EXTERNAL;
-      pd_flags : [pd_implemen,pd_interface,pd_notobject,pd_notobjintf,pd_cppobject,pd_notrecord];
+      pd_flags : [pd_implemen,pd_interface,pd_notobject,pd_notobjintf,pd_cppobject,pd_notrecord,pd_nothelper];
       handler  : @pd_external;
       pocall   : pocall_none;
       pooption : [po_external];
@@ -2195,7 +2229,7 @@ const
       mutexclpo     : [po_public,po_exports,po_interrupt,po_assembler,po_inline]
     ),(
       idtok:_FAR;
-      pd_flags : [pd_implemen,pd_body,pd_interface,pd_procvar,pd_notobject,pd_notobjintf,pd_notrecord];
+      pd_flags : [pd_implemen,pd_body,pd_interface,pd_procvar,pd_notobject,pd_notobjintf,pd_notrecord,pd_nothelper];
       handler  : @pd_far;
       pocall   : pocall_none;
       pooption : [];
@@ -2204,7 +2238,7 @@ const
       mutexclpo     : [po_inline]
     ),(
       idtok:_FAR16;
-      pd_flags : [pd_interface,pd_implemen,pd_body,pd_procvar,pd_notobject,pd_notrecord];
+      pd_flags : [pd_interface,pd_implemen,pd_body,pd_procvar,pd_notobject,pd_notrecord,pd_nothelper];
       handler  : nil;
       pocall   : pocall_far16;
       pooption : [];
@@ -2222,7 +2256,7 @@ const
       mutexclpo     : [po_exports,po_interrupt,po_external,po_inline]
     ),(
       idtok:_FORWARD;
-      pd_flags : [pd_implemen,pd_notobject,pd_notobjintf,pd_notrecord];
+      pd_flags : [pd_implemen,pd_notobject,pd_notobjintf,pd_notrecord,pd_nothelper];
       handler  : @pd_forward;
       pocall   : pocall_none;
       pooption : [];
@@ -2249,7 +2283,7 @@ const
       mutexclpo     : [po_exports,po_external,po_interrupt,po_virtualmethod]
     ),(
       idtok:_INTERNCONST;
-      pd_flags : [pd_interface,pd_body,pd_notobject,pd_notobjintf,pd_notrecord];
+      pd_flags : [pd_interface,pd_body,pd_notobject,pd_notobjintf,pd_notrecord,pd_nothelper];
       handler  : @pd_internconst;
       pocall   : pocall_none;
       pooption : [po_internconst];
@@ -2258,7 +2292,7 @@ const
       mutexclpo     : []
     ),(
       idtok:_INTERNPROC;
-      pd_flags : [pd_interface,pd_notobject,pd_notobjintf,pd_notrecord];
+      pd_flags : [pd_interface,pd_notobject,pd_notobjintf,pd_notrecord,pd_nothelper];
       handler  : @pd_internproc;
       pocall   : pocall_internproc;
       pooption : [];
@@ -2267,7 +2301,7 @@ const
       mutexclpo     : [po_exports,po_external,po_interrupt,po_assembler,po_iocheck,po_virtualmethod]
     ),(
       idtok:_INTERRUPT;
-      pd_flags : [pd_implemen,pd_body,pd_notobject,pd_notobjintf,pd_notrecord];
+      pd_flags : [pd_implemen,pd_body,pd_notobject,pd_notobjintf,pd_notrecord,pd_nothelper];
       handler  : @pd_interrupt;
       pocall   : pocall_oldfpccall;
       pooption : [po_interrupt];
@@ -2313,7 +2347,7 @@ const
       mutexclpo     : []
     ),(
       idtok:_NEAR;
-      pd_flags : [pd_implemen,pd_body,pd_procvar,pd_notobjintf,pd_notrecord];
+      pd_flags : [pd_implemen,pd_body,pd_procvar,pd_notobjintf,pd_notrecord,pd_nothelper];
       handler  : @pd_near;
       pocall   : pocall_none;
       pooption : [];
@@ -2358,7 +2392,7 @@ const
       mutexclpo     : [po_external]
     ),(
       idtok:_PUBLIC;
-      pd_flags : [pd_interface,pd_implemen,pd_body,pd_notobject,pd_notobjintf,pd_notrecord];
+      pd_flags : [pd_interface,pd_implemen,pd_body,pd_notobject,pd_notobjintf,pd_notrecord,pd_nothelper];
       handler  : @pd_public;
       pocall   : pocall_none;
       pooption : [po_public,po_global];
@@ -2472,7 +2506,7 @@ const
       mutexclpo     : [po_interrupt]
     ),(
       idtok:_WEAKEXTERNAL;
-      pd_flags : [pd_implemen,pd_interface,pd_notobject,pd_notobjintf,pd_cppobject,pd_notrecord];
+      pd_flags : [pd_implemen,pd_interface,pd_notobject,pd_notobjintf,pd_cppobject,pd_notrecord,pd_nothelper];
       handler  : @pd_weakexternal;
       pocall   : pocall_none;
       { mark it both external and weak external, so we don't have to
@@ -2638,6 +2672,11 @@ const
              not(pd_objcprot in proc_direcdata[p].pd_flags) then
             exit;
 
+           { check if method and directive not for record/class helper }
+           if is_objectpascal_helper(tprocdef(pd).struct) and
+             (pd_nothelper in proc_direcdata[p].pd_flags) then
+            exit;
+
          end;
 
         { consume directive, and turn flag on }

compiler/pdecvar.pas

@@ -844,7 +844,8 @@ implementation
                  case p.propaccesslist[palt_read].firstsym^.sym.typ of
                    procsym :
                      begin
-                       if (po_virtualmethod in tprocdef(p.propaccesslist[palt_read].procdef).procoptions) then
+                       if (po_virtualmethod in tprocdef(p.propaccesslist[palt_read].procdef).procoptions) and
+                           not is_objectpascal_helper(tprocdef(p.propaccesslist[palt_read].procdef).struct) then
                          ImplIntf.IType:=etVirtualMethodResult
                        else
                          ImplIntf.IType:=etStaticMethodResult;

compiler/pexpr.pas

@@ -404,6 +404,9 @@ implementation
                 end
               else
                begin
+                 { allow helpers for SizeOf and BitSizeOf }
+                 if p1.nodetype=typen then
+                   ttypenode(p1).helperallowed:=true;
                  if (p1.resultdef.typ=forwarddef) then
                    Message1(type_e_type_is_not_completly_defined,tforwarddef(p1.resultdef).tosymname^);
                  if (l = in_sizeof_x) or
@@ -442,7 +445,12 @@ implementation
                       p1:=p2;
                     end;
                   if p1.nodetype=typen then
+                  begin
                     ttypenode(p1).allowed:=true;
+                    { allow helpers for TypeInfo }
+                    if l=in_typeinfo_x then
+                      ttypenode(p1).helperallowed:=true;
+                  end;
     {              else
                     begin
                        p1.destroy;
@@ -1031,7 +1039,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
@@ -1488,7 +1496,12 @@ implementation
                         begin
                           p1:=comp_expr(true,false);
                           consume(_RKLAMMER);
-                          p1:=ctypeconvnode.create_explicit(p1,hdef);
+                          { type casts to class helpers aren't allowed }
+                          if is_objectpascal_helper(hdef) then
+                            Message(parser_e_no_category_as_types)
+                            { recovery by not creating a conversion node }
+                          else
+                            p1:=ctypeconvnode.create_explicit(p1,hdef);
                         end
                        else { not LKLAMMER }
                         if (token=_POINT) and
@@ -1503,7 +1516,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);
@@ -1530,6 +1543,12 @@ implementation
                          end
                        else
                         begin
+                          { Normally here would be the check against the usage
+                            of "TClassHelper.Something", but as that might be
+                            used inside of system symbols like sizeof and
+                            typeinfo this check is put into ttypenode.pass_1
+                            (for "TClassHelper" alone) and tcallnode.pass_1
+                            (for "TClassHelper.Something") }
                           { class reference ? }
                           if is_class(hdef) or
                              is_objcclass(hdef) then
@@ -2129,7 +2148,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);
@@ -2153,7 +2172,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);
@@ -2343,6 +2362,12 @@ implementation
                     assigned(current_structdef) and
                     (current_structdef.typ=objectdef) then
                   begin
+                    { for record helpers in mode Delphi "inherited" is not
+                      allowed }
+                    if is_objectpascal_helper(current_structdef) and
+                        (m_delphi in current_settings.modeswitches) and
+                        is_record(tobjectdef(current_structdef).extendeddef) then
+                      Message(parser_e_inherited_not_in_record);
                     hclassdef:=tobjectdef(current_structdef).childof;
                     { Objective-C categories *replace* methods in the class
                       they extend, or add methods to it. So calling an
@@ -2367,7 +2392,11 @@ 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);
+                       { helpers have their own ways of dealing with inherited }
+                       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,true);
                      end
                     else
                      begin
@@ -2375,7 +2404,11 @@ implementation
                        hsorg:=orgpattern;
                        consume(_ID);
                        anon_inherited:=false;
-                       searchsym_in_class(hclassdef,tobjectdef(current_structdef),hs,srsym,srsymtable);
+                       { helpers have their own ways of dealing with inherited }
+                       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,true);
                      end;
                     if assigned(srsym) then
                      begin
@@ -2385,11 +2418,31 @@ implementation
                        case srsym.typ of
                          procsym:
                            begin
-                             hdef:=hclassdef;
+                             if is_objectpascal_helper(current_structdef) then
+                               begin
+                                 { for a helper load the procdef either from the
+                                   extended type, from the parent helper or from
+                                   the extended type of the parent helper
+                                   depending on the def the found symbol belongs
+                                   to }
+                                 if (srsym.Owner.defowner.typ=objectdef) and
+                                     is_objectpascal_helper(tobjectdef(srsym.Owner.defowner)) then
+                                   if current_structdef.is_related(tdef(srsym.Owner.defowner)) and
+                                       assigned(tobjectdef(current_structdef).childof) then
+                                     hdef:=tobjectdef(current_structdef).childof
+                                   else
+                                     hdef:=tobjectdef(srsym.Owner.defowner).extendeddef
+                                 else
+                                   hdef:=tdef(srsym.Owner.defowner);
+                               end
+                             else
+                               hdef:=hclassdef;
                              if (po_classmethod in current_procinfo.procdef.procoptions) or
                                 (po_staticmethod in current_procinfo.procdef.procoptions) then
                                hdef:=tclassrefdef.create(hdef);
                              p1:=ctypenode.create(hdef);
+                             { we need to allow helpers here }
+                             ttypenode(p1).helperallowed:=true;
                            end;
                          propertysym:
                            ;
@@ -2409,7 +2462,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);
@@ -2434,9 +2487,14 @@ implementation
                   end
                  else
                    begin
-                      Message(parser_e_generic_methods_only_in_methods);
-                      again:=false;
-                      p1:=cerrornode.create;
+                     { in case of records we use a more clear error message }
+                     if assigned(current_structdef) and
+                         (current_structdef.typ=recorddef) then
+                       Message(parser_e_inherited_not_in_record)
+                     else
+                       Message(parser_e_generic_methods_only_in_methods);
+                     again:=false;
+                     p1:=cerrornode.create;
                    end;
                  postfixoperators(p1,again);
                end;

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/pp.lpi

@@ -25,8 +25,9 @@
     <RunParams>
       <local>
         <FormatVersion Value="1"/>
-        <CommandLineParams Value="-n @\home\florian\bin\fpc.cfg \home\florian\fpc\tests\test\cg\tsar1.pp"/>
+        <CommandLineParams Value="-n -Fuc:\svn\fpcbranches\classhelpers\rtl\units\i386-win32 -Futests\test -FEtestoutput c:\svn\fpcbranches\classhelpers\tests\test\tchlp84.pp"/>
         <LaunchingApplication PathPlusParams="\usr\bin\xterm -T 'Lazarus Run Output' -e $(LazarusDir)\tools\runwait.sh $(TargetCmdLine)"/>
+        <WorkingDirectory Value="c:\svn\fpcbranches\classhelpers\"/>
       </local>
     </RunParams>
     <Units Count="2">

compiler/ppcgen/cgppc.pas

@@ -718,7 +718,8 @@ unit cgppc;
         g_adjust_self_value(list,procdef,ioffset);
 
         { case 4 }
-        if po_virtualmethod in procdef.procoptions then
+        if (po_virtualmethod in procdef.procoptions) and
+            not is_objectpascal_helper(procdef.struct) then
           begin
             loadvmttor11;
             op_onr11methodaddr;

compiler/ppu.pas

@@ -43,7 +43,7 @@ type
 {$endif Test_Double_checksum}
 
 const
-  CurrentPPUVersion = 127;
+  CurrentPPUVersion = 128;
 
 { buffer sizes }
   maxentrysize = 1024;
@@ -131,6 +131,7 @@ const
   ibmoduleoptions   = 85;
 
   ibmainname       = 90;
+  ibsymtableoptions = 91;
   { target-specific things }
   iblinkotherframeworks = 100;
 

compiler/psub.pas

@@ -1972,6 +1972,7 @@ implementation
         hp : tdef;
         oldcurrent_filepos : tfileposinfo;
         oldsymtablestack   : tsymtablestack;
+        oldextendeddefs    : TFPHashObjectList;
         pu : tused_unit;
         hmodule : tmodule;
         specobj : tabstractrecorddef;
@@ -1986,7 +1987,9 @@ implementation
         { Setup symtablestack a definition time }
         specobj:=tabstractrecorddef(ttypesym(p).typedef);
         oldsymtablestack:=symtablestack;
-        symtablestack:=tsymtablestack.create;
+        oldextendeddefs:=current_module.extendeddefs;
+        current_module.extendeddefs:=TFPHashObjectList.create(true);
+        symtablestack:=tdefawaresymtablestack.create;
         if not assigned(specobj.genericdef) then
           internalerror(200705151);
         hmodule:=find_module_from_symtable(specobj.genericdef.owner);
@@ -2033,6 +2036,8 @@ implementation
           end;
 
         { Restore symtablestack }
+        current_module.extendeddefs.free;
+        current_module.extendeddefs:=oldextendeddefs;
         symtablestack.free;
         symtablestack:=oldsymtablestack;
       end;

compiler/ptype.pas

@@ -156,6 +156,7 @@ implementation
         generictype : ttypesym;
         generictypelist : TFPObjectList;
         oldsymtablestack   : tsymtablestack;
+        oldextendeddefs    : TFPHashObjectList;
         hmodule : tmodule;
         pu : tused_unit;
         uspecializename,
@@ -292,7 +293,9 @@ implementation
               to get types right, however this is not perfect, we should probably record
               the resolved symbols }
             oldsymtablestack:=symtablestack;
-            symtablestack:=tsymtablestack.create;
+            oldextendeddefs:=current_module.extendeddefs;
+            current_module.extendeddefs:=TFPHashObjectList.create(true);
+            symtablestack:=tdefawaresymtablestack.create;
             if not assigned(genericdef) then
               internalerror(200705151);
             hmodule:=find_module_from_symtable(genericdef.owner);
@@ -359,6 +362,8 @@ implementation
               end;
 
             { Restore symtablestack }
+            current_module.extendeddefs.free;
+            current_module.extendeddefs:=oldextendeddefs;
             symtablestack.free;
             symtablestack:=oldsymtablestack;
           end
@@ -628,7 +633,8 @@ implementation
                 Message(parser_e_no_generics_as_types);
                 def:=generrordef;
               end
-            else if is_objccategory(def) then
+            else if is_classhelper(def) and
+                not (stoParseClassParent in options) then
               begin
                 Message(parser_e_no_category_as_types);
                 def:=generrordef
@@ -948,8 +954,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
@@ -1084,7 +1088,7 @@ implementation
                            Message(parser_e_no_generics_as_types);
                            def:=generrordef;
                          end
-                       else if is_objccategory(def) then
+                       else if is_classhelper(def) then
                          begin
                            Message(parser_e_no_category_as_types);
                            def:=generrordef
@@ -1520,7 +1524,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:
@@ -1547,15 +1558,17 @@ 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
+                      else begin
+                        consume(_RECORD);
                         def:=record_dec(name,genericdef,genericlist);
+                      end;
                     end;
                     current_settings.packrecords:=oldpackrecords;
                   end;
@@ -1567,7 +1580,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
@@ -1594,12 +1607,18 @@ implementation
                       Message1(type_e_class_or_objcclass_type_expected,hdef.typename);
                   end
                 else
-                  def:=object_dec(odt_class,name,genericdef,genericlist,nil);
+                if (idtoken=_HELPER) then
+                  begin
+                    consume(_HELPER);
+                    def:=object_dec(odt_helper,name,genericdef,genericlist,nil,ht_class);
+                  end
+                else
+                  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
@@ -1607,7 +1626,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
@@ -1617,9 +1636,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
@@ -1627,7 +1646,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
@@ -1635,12 +1654,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/rautils.pas

@@ -1392,7 +1392,8 @@ Begin
            else
              begin
                { can only get the vmtoffset of virtual methods }
-               if not(po_virtualmethod in procdef.procoptions) then
+               if not(po_virtualmethod in procdef.procoptions) or
+                   is_objectpascal_helper(procdef.struct) then
                  Message1(asmr_e_no_vmtoffset_possible,FullTypeName(procdef,nil))
                else
                  begin

compiler/sparc/cgcpu.pas

@@ -1375,7 +1375,8 @@ implementation
         { set param1 interface to self  }
         g_adjust_self_value(list,procdef,ioffset);
 
-        if po_virtualmethod in procdef.procoptions then
+        if (po_virtualmethod in procdef.procoptions) and
+            not is_objectpascal_helper(procdef.struct) then
           begin
             if (procdef.extnumber=$ffff) then
               Internalerror(200006139);

compiler/symbase.pas

@@ -97,6 +97,7 @@ interface
           refcount  : smallint;
           currentvisibility : tvisibility;
           currentlyoptional : boolean;
+          tableoptions : tsymtableoptions;
           { level of symtable, used for nested procedures }
           symtablelevel : byte;
           symtabletype  : TSymtabletype;
@@ -113,6 +114,9 @@ interface
           procedure insertdef(def:TDefEntry);virtual;
           procedure deletedef(def:TDefEntry);
           function  iscurrentunit:boolean;virtual;
+          { includes the flag in this symtable and all parent symtables; if
+            it's already set the flag is not set again }
+          procedure includeoption(option:tsymtableoption);
        end;
 
        psymtablestackitem = ^TSymtablestackitem;
@@ -126,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;
 
@@ -262,6 +266,26 @@ implementation
         result:=false;
       end;
 
+    procedure TSymtable.includeoption(option: tsymtableoption);
+      var
+        st: tsymtable;
+      begin
+        if option in tableoptions then
+          exit;
+        include(tableoptions,option);
+        { iterative approach should be faster than recursion based on calls }
+        st:=self;
+        while assigned(st.defowner) do
+          begin
+            st:=st.defowner.owner;
+            { the flag is already set, so by definition it is set in the
+              owning symtables as well }
+            if option in st.tableoptions then
+              break;
+            include(st.tableoptions,option);
+          end;
+      end;
+
 
     procedure TSymtable.clear;
       var

compiler/symconst.pas

@@ -64,7 +64,8 @@ const
   tkProcVar  = 23;
   tkUString  = 24;
   tkUChar    = 25;
-  tkFile     = 26;
+  tkHelper   = 26;
+  tkFile     = 27;
 
   otSByte     = 0;
   otUByte     = 1;
@@ -328,7 +329,14 @@ type
     odt_dispinterface,
     odt_objcclass,
     odt_objcprotocol,
-    odt_objccategory { note that these are changed into odt_class afterwards }
+    odt_objccategory, { note that these are changed into odt_class afterwards }
+    odt_helper
+  );
+
+  { defines the type of the extended "structure"; only used for parsing }
+  thelpertype=(ht_none,
+    ht_class,
+    ht_record
   );
 
   { Variations in interfaces implementation }
@@ -456,6 +464,11 @@ type
                              in array                        }
   );
 
+  { options for symtables }
+  tsymtableoption = (
+    sto_has_helper         { contains at least one helper symbol }
+  );
+  tsymtableoptions = set of tsymtableoption;
 
   { definition contains the informations about a type }
   tdeftyp = (abstractdef,

compiler/symdef.pas

@@ -260,6 +260,9 @@ interface
           childof        : tobjectdef;
           childofderef   : tderef;
 
+          { for Object Pascal helpers }
+          extendeddef   : tabstractrecorddef;
+          extendeddefderef: 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 }
@@ -648,6 +651,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 }
@@ -784,12 +796,14 @@ interface
     function is_object(def: tdef): boolean;
     function is_class(def: tdef): boolean;
     function is_cppclass(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;
     function is_objccategory(def: tdef): boolean;
     function is_objc_class_or_protocol(def: tdef): boolean;
     function is_objc_protocol_or_category(def: tdef): boolean;
+    function is_classhelper(def: tdef): boolean;
     function is_class_or_interface(def: tdef): boolean;
     function is_class_or_interface_or_objc(def: tdef): boolean;
     function is_class_or_interface_or_object(def: tdef): boolean;
@@ -921,6 +935,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)
@@ -4170,6 +4274,8 @@ implementation
         fcurrent_dispid:=0;
         objecttype:=ot;
         childof:=nil;
+        if objecttype=odt_helper then
+          owner.includeoption(sto_has_helper);
         symtable:=tObjectSymtable.create(self,n,current_settings.packrecords);
         { create space for vmt !! }
         vmtentries:=TFPList.Create;
@@ -4220,6 +4326,9 @@ implementation
               iidstr:=stringdup(ppufile.getstring);
            end;
 
+         if objecttype=odt_helper then
+           ppufile.getderef(extendeddefderef);
+
          vmtentries:=TFPList.Create;
          vmtentries.count:=ppufile.getlongint;
          for i:=0 to vmtentries.count-1 do
@@ -4381,6 +4490,8 @@ implementation
               ppufile.putguid(iidguid^);
               ppufile.putstring(iidstr^);
            end;
+         if objecttype=odt_helper then
+           ppufile.putderef(extendeddefderef);
 
          ppufile.putlongint(vmtentries.count);
          for i:=0 to vmtentries.count-1 do
@@ -4439,6 +4550,9 @@ implementation
          else
            tstoredsymtable(symtable).buildderef;
 
+         if objecttype=odt_helper then
+           extendeddefderef.build(extendeddef);
+
          for i:=0 to vmtentries.count-1 do
            begin
              vmtentry:=pvmtentry(vmtentries[i]);
@@ -4467,6 +4581,8 @@ implementation
            end
          else
            tstoredsymtable(symtable).deref;
+         if objecttype=odt_helper then
+           extendeddef:=tobjectdef(extendeddefderef.resolve);
          for i:=0 to vmtentries.count-1 do
            begin
              vmtentry:=pvmtentry(vmtentries[i]);
@@ -4760,7 +4876,7 @@ implementation
 
     function tobjectdef.size : asizeint;
       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;
@@ -4769,7 +4885,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;
@@ -4783,6 +4899,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;
@@ -4809,6 +4926,7 @@ implementation
     function tobjectdef.needs_inittable : boolean;
       begin
          case objecttype of
+            odt_helper,
             odt_class :
               needs_inittable:=false;
             odt_dispinterface,
@@ -5482,6 +5600,15 @@ implementation
       end;
 
 
+    function is_objectpascal_helper(def: tdef): boolean;
+      begin
+        result:=
+          assigned(def) and
+          (def.typ=objectdef) and
+          (tobjectdef(def).objecttype=odt_helper);
+      end;
+
+
     function is_objcclassref(def: tdef): boolean;
       begin
         is_objcclassref:=
@@ -5531,6 +5658,12 @@ implementation
              (oo_is_classhelper in tobjectdef(def).objectoptions)));
       end;
 
+    function is_classhelper(def: tdef): boolean;
+      begin
+         result:=
+           is_objectpascal_helper(def) or
+           is_objccategory(def);
+      end;
 
     function is_class_or_interface(def: tdef): boolean;
       begin

compiler/symtable.pas

@@ -220,17 +220,24 @@ 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;
+    { 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  try_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_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.}
@@ -349,6 +356,11 @@ implementation
 
     procedure tstoredsymtable.ppuload(ppufile:tcompilerppufile);
       begin
+        { load the table's flags }
+        if ppufile.readentry<>ibsymtableoptions then
+          Message(unit_f_ppu_read_error);
+        ppufile.getsmallset(tableoptions);
+
         { load definitions }
         loaddefs(ppufile);
 
@@ -359,6 +371,10 @@ implementation
 
     procedure tstoredsymtable.ppuwrite(ppufile:tcompilerppufile);
       begin
+         { write the table's flags }
+         ppufile.putsmallset(tableoptions);
+         ppufile.writeentry(ibsymtableoptions);
+
          { write definitions }
          writedefs(ppufile);
 
@@ -1269,10 +1285,7 @@ implementation
          oldtyp:=ppufile.entrytyp;
          ppufile.entrytyp:=subentryid;
 
-         { write definitions }
-         writedefs(ppufile);
-         { write symbols }
-         writesyms(ppufile);
+         inherited ppuwrite(ppufile);
 
          ppufile.entrytyp:=oldtyp;
       end;
@@ -1811,9 +1824,16 @@ implementation
             end;
           vis_strictprotected :
             begin
-               result:=assigned(current_structdef) and
-                       (current_structdef.is_related(symownerdef) or
-                        is_owned_by(current_structdef,symownerdef));
+               result:=(
+                         assigned(current_structdef) and
+                         (current_structdef.is_related(symownerdef) or
+                         is_owned_by(current_structdef,symownerdef))
+                       ) or
+                       (
+                         { helpers can access strict protected symbols }
+                         is_objectpascal_helper(contextobjdef) and
+                         tobjectdef(contextobjdef).extendeddef.is_related(symownerdef)
+                       );
             end;
           vis_protected :
             begin
@@ -1843,7 +1863,12 @@ implementation
                         (
                           not assigned(current_structdef) and
                           (symownerdef.owner.iscurrentunit)
-                         )
+                        ) or
+                        (
+                          { helpers can access protected symbols }
+                          is_objectpascal_helper(contextobjdef) and
+                          tobjectdef(contextobjdef).extendeddef.is_related(symownerdef)
+                        )
                        )
                       );
             end;
@@ -1899,7 +1924,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;
@@ -2129,7 +2154,7 @@ 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;
         orgclass : tobjectdef;
@@ -2143,8 +2168,11 @@ 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. }
-            if not contextclassh.is_related(classh) then
+              parent or a class helper. }
+            if not (contextclassh.is_related(classh) or
+                (assigned(contextclassh.extendeddef) and
+                (contextclassh.extendeddef.typ=objectdef) and
+                contextclassh.extendeddef.is_related(classh))) then
               internalerror(200811161);
           end;
         result:=false;
@@ -2164,17 +2192,38 @@ 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,false) then
                   begin
                     result:=true;
                     exit;
                   end;
               end;
           end
+        else
+        if is_objectpascal_helper(classh) then
+          begin
+            { helpers have their own obscure search logic... }
+            result:=searchsym_in_helper(classh,contextclassh,s,srsym,srsymtable,false);
+            if result then
+              exit;
+          end
         else
           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
@@ -2188,7 +2237,7 @@ implementation
               end;
           end;
         if is_objcclass(orgclass) then
-          result:=search_class_helper(orgclass,s,srsym,srsymtable)
+          result:=search_objc_helper(orgclass,s,srsym,srsymtable)
         else
           begin
             srsym:=nil;
@@ -2202,6 +2251,15 @@ implementation
       begin
         result:=false;
         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
@@ -2287,6 +2345,64 @@ implementation
         srsymtable:=nil;
       end;
 
+    function searchsym_in_helper(classh,contextclassh:tobjectdef;const s: TIDString;out srsym:tsym;out srsymtable:TSymtable;aHasInherited:boolean):boolean;
+      var
+        hashedid      : THashedIDString;
+        parentclassh  : tobjectdef;
+      begin
+        result:=false;
+        if not is_objectpascal_helper(classh) then
+          Internalerror(2011030101);
+        hashedid.id:=s;
+        { 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
+            { 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;
+        { 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;
       var
@@ -2436,8 +2552,103 @@ implementation
           end;
       end;
 
+    function search_last_objectpascal_helper(pd,contextclassh : tabstractrecorddef;out odef : tobjectdef):boolean;
+      var
+        s: string;
+        list: TFPObjectList;
+        i: integer;
+        st: tsymtable;
+      begin
+        result:=false;
+        { when there are no helpers active currently then we don't need to do
+          anything }
+        if current_module.extendeddefs.count=0 then
+          exit;
+        { no helpers for anonymous types }
+        if not assigned(pd.objrealname) or (pd.objrealname^='') then
+          exit;
+        { if pd is defined inside a procedure we must not use make_mangledname
+          (as a helper may not be defined in a procedure this is no problem...)}
+        st:=pd.owner;
+        while st.symtabletype in [objectsymtable,recordsymtable] do
+          st:=st.defowner.owner;
+        if st.symtabletype=localsymtable then
+          exit;
+        { the mangled name is used as the key for tmodule.extendeddefs }
+        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;
+      end;
+
+    function search_objectpascal_helper(pd,contextclassh : tabstractrecorddef;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;
+      var
+        hashedid  : THashedIDString;
+        classh : tobjectdef;
+        i : integer;
+        pdef : tprocdef;
+      begin
+        result:=false;
+
+        { if there is no class helper for the class then there is no need to
+          search further }
+        if not search_last_objectpascal_helper(pd,contextclassh,classh) then
+          exit;
+
+        hashedid.id:=s;
+
+        repeat
+          srsymtable:=classh.symtable;
+          srsym:=tsym(srsymtable.FindWithHash(hashedid));
+
+          if srsym<>nil then
+            begin
+              if srsym.typ=propertysym then
+                begin
+                  result:=true;
+                  exit;
+                end;
+              for i:=0 to tprocsym(srsym).procdeflist.count-1 do
+                begin
+                  pdef:=tprocdef(tprocsym(srsym).procdeflist[i]);
+                  if not is_visible_for_object(pdef.owner,pdef.visibility,contextclassh) then
+                    continue;
+                  { we need to know if a procedure references symbols
+                    in the static symtable, because then it can't be
+                    inlined from outside this unit }
+                  if assigned(current_procinfo) and
+                     (srsym.owner.symtabletype=staticsymtable) then
+                    include(current_procinfo.flags,pi_uses_static_symtable);
+                  { the first found method wins }
+                  srsym:=tprocdef(tprocsym(srsym).procdeflist[i]).procsym;
+                  srsymtable:=srsym.owner;
+                  addsymref(srsym);
+                  result:=true;
+                  exit;
+                end;
+            end;
+
+          { try the helper parent if available }
+          classh:=classh.childof;
+        until classh=nil;
+
+        srsym:=nil;
+        srsymtable:=nil;
+      end;
+
+    function search_objc_helper(pd : tobjectdef;const s : string; out srsym: tsym; out srsymtable: tsymtable):boolean;
       var
         hashedid   : THashedIDString;
         stackitem  : psymtablestackitem;
@@ -2563,6 +2774,8 @@ implementation
         { in case this is a formal objcclass, first find the real definition }
         if (oo_is_formal in pd.objectoptions) then
           pd:=find_real_objcclass_definition(tobjectdef(pd),true);
+        if search_objectpascal_helper(pd, pd, s, result, srsymtable) then
+          exit;
         hashedid.id:=s;
         orgpd:=pd;
         while assigned(pd) do
@@ -2581,7 +2794,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;
@@ -2645,8 +2858,24 @@ implementation
    { returns the default property of a class, searches also anchestors }
      var
        _defaultprop : tpropertysym;
+       helperpd : tobjectdef;
      begin
         _defaultprop:=nil;
+        { first search in helper's hierarchy }
+        if search_last_objectpascal_helper(pd,nil,helperpd) then
+          while assigned(helperpd) do
+            begin
+              helperpd.symtable.SymList.ForEachCall(@tstoredsymtable(helperpd.symtable).testfordefaultproperty,@_defaultprop);
+              if assigned(_defaultprop) then
+                break;
+              helperpd:=helperpd.childof;
+            end;
+        if assigned(_defaultprop) then
+          begin
+            search_default_property:=_defaultprop;
+            exit;
+          end;
+        { now search in the type's hierarchy itself }
         while assigned(pd) do
           begin
              pd.symtable.SymList.ForEachCall(@tstoredsymtable(pd.symtable).testfordefaultproperty,@_defaultprop);

compiler/tokens.pas

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

compiler/utils/ppudump.pp

@@ -426,6 +426,50 @@ end;
                              Read Routines
 ****************************************************************************}
 
+procedure readsymtableoptions(const s: string);
+type
+  tsymtableoption = (
+    sto_has_helper         { contains at least one helper symbol }
+  );
+  tsymtableoptions = set of tsymtableoption;
+  tsymtblopt=record
+    mask : tsymtableoption;
+    str  : string[30];
+  end;
+const
+  symtblopts=1;
+  symtblopt : array[1..symtblopts] of tsymtblopt=(
+     (mask:sto_has_helper;   str:'Has helper')
+  );
+var
+  options : tsymtableoptions;
+  first : boolean;
+  i : integer;
+begin
+  if ppufile.readentry<>ibsymtableoptions then
+    exit;
+  ppufile.getsmallset(options);
+  if space<>'' then
+   writeln(space,'------ ',s,' ------');
+  write(space,'Symtable options: ');
+  if options<>[] then
+   begin
+     first:=true;
+     for i:=1 to symtblopts do
+      if (symtblopt[i].mask in options) then
+       begin
+         if first then
+           first:=false
+         else
+           write(', ');
+         write(symtblopt[i].str);
+       end;
+   end
+  else
+   write('none');
+  writeln;
+end;
+
 Procedure ReadLinkContainer(const prefix:string);
 {
   Read a serie of strings and write to the screen starting every line
@@ -846,10 +890,37 @@ type
   );
   tdefoptions=set of tdefoption;
 
+  tobjectoption=(oo_none,
+    oo_is_forward,         { the class is only a forward declared yet }
+    oo_is_abstract,        { the class is abstract - only descendants can be used }
+    oo_is_sealed,          { the class is sealed - can't have descendants }
+    oo_has_virtual,        { the object/class has virtual methods }
+    oo_has_private,
+    oo_has_protected,
+    oo_has_strictprivate,
+    oo_has_strictprotected,
+    oo_has_constructor,    { the object/class has a constructor }
+    oo_has_destructor,     { the object/class has a destructor }
+    oo_has_vmt,            { the object/class has a vmt }
+    oo_has_msgstr,
+    oo_has_msgint,
+    oo_can_have_published,{ the class has rtti, i.e. you can publish properties }
+    oo_has_default_property,
+    oo_has_valid_guid,
+    oo_has_enumerator_movenext,
+    oo_has_enumerator_current,
+    oo_is_external,       { the class is externally implemented (objcclass, cppclass) }
+    oo_is_anonymous,      { the class is only formally defined in this module (objcclass x = class; external;) }
+    oo_is_classhelper,    { objcclasses that represent categories, and Delpi-style class helpers, are marked like this }
+    oo_has_class_constructor, { the object/class has a class constructor }
+    oo_has_class_destructor   { the object/class has a class destructor  }
+  );
+  tobjectoptions=set of tobjectoption;
 
 var
   { needed during tobjectdef parsing... }
   current_defoptions : tdefoptions;
+  current_objectoptions : tobjectoptions;
 
 procedure readcommondef(const s:string; out defoptions: tdefoptions);
 type
@@ -1401,32 +1472,6 @@ end;
 
 procedure readobjectdefoptions;
 type
-  tobjectoption=(oo_none,
-    oo_is_forward,         { the class is only a forward declared yet }
-    oo_is_abstract,        { the class is abstract - only descendants can be used }
-    oo_is_sealed,          { the class is sealed - can't have descendants }
-    oo_has_virtual,        { the object/class has virtual methods }
-    oo_has_private,
-    oo_has_protected,
-    oo_has_strictprivate,
-    oo_has_strictprotected,
-    oo_has_constructor,    { the object/class has a constructor }
-    oo_has_destructor,     { the object/class has a destructor }
-    oo_has_vmt,            { the object/class has a vmt }
-    oo_has_msgstr,
-    oo_has_msgint,
-    oo_can_have_published,{ the class has rtti, i.e. you can publish properties }
-    oo_has_default_property,
-    oo_has_valid_guid,
-    oo_has_enumerator_movenext,
-    oo_has_enumerator_current,
-    oo_is_external,       { the class is externally implemented (objcclass, cppclass) }
-    oo_is_anonymous,      { the class is only formally defined in this module (objcclass x = class; external;) }
-    oo_is_classhelper,    { objcclasses that represent categories, and Delpi-style class helpers, are marked like this }
-    oo_has_class_constructor, { the object/class has a class constructor }
-    oo_has_class_destructor   { the object/class has a class destructor  }
-  );
-  tobjectoptions=set of tobjectoption;
   tsymopt=record
     mask : tobjectoption;
     str  : string[30];
@@ -1458,16 +1503,15 @@ const
      (mask:oo_has_class_destructor; str:'HasClassDestructor')
   );
 var
-  symoptions : tobjectoptions;
   i      : longint;
   first  : boolean;
 begin
-  ppufile.getsmallset(symoptions);
-  if symoptions<>[] then
+  ppufile.getsmallset(current_objectoptions);
+  if current_objectoptions<>[] then
    begin
      first:=true;
      for i:=1 to high(symopt) do
-      if (symopt[i].mask in symoptions) then
+      if (symopt[i].mask in current_objectoptions) then
        begin
          if first then
            first:=false
@@ -1901,7 +1945,8 @@ type
     odt_cppclass,
     odt_dispinterface,
     odt_objcclass,
-    odt_objcprotocol
+    odt_objcprotocol,
+    odt_helper
   );
   tvarianttype = (
     vt_normalvariant,vt_olevariant
@@ -1976,6 +2021,7 @@ begin
              writeln(space,'            Range : ',getaint,' to ',getaint);
              write  (space,'          Options : ');
              readarraydefoptions;
+             readsymtableoptions('symbols');
              readdefinitions('symbols');
              readsymbols('symbols');
            end;
@@ -2037,11 +2083,13 @@ begin
               Writeln('!! Entry has more information stored');
              space:='    '+space;
              { parast }
+             readsymtableoptions('parast');
              readdefinitions('parast');
              readsymbols('parast');
              { localst }
              if (po_has_inlininginfo in procoptions) then
               begin
+                readsymtableoptions('localst');
                 readdefinitions('localst');
                 readsymbols('localst');
               end;
@@ -2059,6 +2107,7 @@ begin
               Writeln('!! Entry has more information stored');
              space:='    '+space;
              { parast }
+             readsymtableoptions('parast');
              readdefinitions('parast');
              readsymbols('parast');
              delete(space,1,4);
@@ -2109,6 +2158,7 @@ begin
               Writeln('!! Entry has more information stored');
              {read the record definitions and symbols}
              space:='    '+space;
+             readsymtableoptions('fields');
              readdefinitions('fields');
              readsymbols('fields');
              Delete(space,1,4);
@@ -2131,6 +2181,7 @@ begin
                odt_dispinterface  : writeln('dispinterface');
                odt_objcclass      : writeln('objcclass');
                odt_objcprotocol   : writeln('objcprotocol');
+               odt_helper         : writeln('helper');
                else                 writeln('!! Warning: Invalid object type ',b);
              end;
              writeln(space,'    External name : ',getstring);
@@ -2150,6 +2201,13 @@ begin
                   writeln(space,'       IID String : ',getstring);
                end;
 
+             if (tobjecttyp(b)=odt_helper) or
+                 (oo_is_classhelper in current_objectoptions) then
+               begin
+                 write(space,'    Helper parent : ');
+                 readderef('');
+               end;
+
              l:=getlongint;
              writeln(space,'  VMT entries: ',l);
              for j:=1 to l do
@@ -2183,6 +2241,7 @@ begin
                begin
                  {read the record definitions and symbols}
                  space:='    '+space;
+                 readsymtableoptions('fields');
                  readdefinitions('fields');
                  readsymbols('fields');
                  Delete(space,1,4);
@@ -2227,6 +2286,7 @@ begin
              else
                begin
                  space:='    '+space;
+                 readsymtableoptions('elements');
                  readdefinitions('elements');
                  readsymbols('elements');
                  delete(space,1,4);
@@ -2534,6 +2594,10 @@ begin
    end
   else
    ppufile.skipuntilentry(ibendinterface);
+  Writeln;
+  Writeln('Interface symtable');
+  Writeln('----------------------');
+  readsymtableoptions('interface');
 {read the definitions}
   if (verbose and v_defs)<>0 then
    begin
@@ -2569,6 +2633,7 @@ begin
     end;
   if boolean(ppufile.getbyte) then
     begin
+      readsymtableoptions('interface macro');
       {skip the definition section for macros (since they are never used) }
       ppufile.skipuntilentry(ibenddefs);
       {read the macro symbols}
@@ -2591,6 +2656,10 @@ begin
   else
    ppufile.skipuntilentry(ibendimplementation);
   {read the static symtable}
+  Writeln;
+  Writeln('Implementation symtable');
+  Writeln('----------------------');
+  readsymtableoptions('implementation');
   if (ppufile.header.flags and uf_local_symtable)<>0 then
    begin
      if (verbose and v_defs)<>0 then

compiler/x86_64/cgcpu.pas

@@ -173,7 +173,8 @@ unit cgcpu;
         { set param1 interface to self  }
         g_adjust_self_value(list,procdef,ioffset);
 
-        if po_virtualmethod in procdef.procoptions then
+        if (po_virtualmethod in procdef.procoptions) and
+            not is_objectpascal_helper(procdef.struct) then
           begin
             if (procdef.extnumber=$ffff) then
               Internalerror(200006139);

rtl/inc/system.inc

@@ -44,6 +44,7 @@ Const
    tkInterfaceCorba = 22;
    tkProcVar       = 23;
    tkUString       = 24;
+   tkHelper        = 26;
 
   // all potentially managed types
   tkManagedTypes   = [tkAstring,tkWstring,tkUstring,tkArray,

rtl/objpas/typinfo.pp

@@ -42,7 +42,8 @@ unit typinfo;
                    tkSet,tkMethod,tkSString,tkLString,tkAString,
                    tkWString,tkVariant,tkArray,tkRecord,tkInterface,
                    tkClass,tkObject,tkWChar,tkBool,tkInt64,tkQWord,
-                   tkDynArray,tkInterfaceRaw,tkProcVar,tkUString,tkUChar);
+                   tkDynArray,tkInterfaceRaw,tkProcVar,tkUString,tkUChar,
+                   tkHelper);
 
        TOrdType  = (otSByte,otUByte,otSWord,otUWord,otSLong,otULong);
 
@@ -151,6 +152,13 @@ unit typinfo;
                UnitName : ShortString
                // here the properties follow as array of TPropInfo
               );
+            tkHelper:
+              (HelperParent : PTypeInfo;
+               ExtendedInfo : PTypeInfo;
+               HelperProps : SmallInt;
+               HelperUnit : ShortString
+               // here the properties follow as array of TPropInfo
+              );
             tkMethod:
               (MethodKind : TMethodKind;
                ParamCount : Byte;

tests/test/tchlp1.pp

@@ -0,0 +1,29 @@
+{ %NORUN }
+
+{ this tests that helpers can introduce instance methods for classes - mode
+  Delphi }
+program tchlp1;
+
+{$ifdef fpc}
+  {$mode delphi}
+{$endif}
+
+type
+  TTest = class
+
+  end;
+
+  TTestHelper = class helper for TTest
+    procedure Test;
+  end;
+
+procedure TTestHelper.Test;
+begin
+
+end;
+
+var
+  t: TTest;
+begin
+  t.Test;
+end.

tests/test/tchlp10.pp

@@ -0,0 +1,40 @@
+{ %NORUN }
+
+{ method modifiers of the extended class are completly irrelevant }
+program tchlp10;
+
+{$ifdef fpc}
+  {$mode delphi}
+{$endif}
+
+type
+  TTest = class
+    procedure Test; virtual;
+  end;
+
+  TTestHelper = class helper for TTest
+    procedure Test; virtual;
+  end;
+
+  TTestHelperSub = class helper(TTestHelper) for TTest
+    procedure Test; override;
+  end;
+
+procedure TTest.Test;
+begin
+
+end;
+
+procedure TTestHelper.Test;
+begin
+
+end;
+
+procedure TTestHelperSub.Test;
+begin
+
+end;
+
+begin
+
+end.

tests/test/tchlp11.pp

@@ -0,0 +1,20 @@
+{ %FAIL }
+
+{ it's forbidden for a class helper to extend a record }
+program tchlp11;
+
+{$ifdef fpc}
+  {$mode delphi}
+{$endif}
+
+type
+  TTest = record
+
+  end;
+
+  TTestHelper = class helper for TTest
+  end;
+
+begin
+
+end.

tests/test/tchlp12.pp

@@ -0,0 +1,25 @@
+{ %FAIL }
+
+{ class helpers can access (strict) protected, public and published members -
+  here: strict private }
+program tchlp12;
+
+{$ifdef fpc}
+  {$mode delphi}
+{$endif}
+
+uses
+  uchlp12;
+
+type
+  TTestHelper = class helper for TTest
+    function AccessTest: Integer;
+  end;
+
+function TTestHelper.AccessTest: Integer;
+begin
+  Result := Test1;
+end;
+
+begin
+end.

tests/test/tchlp13.pp

@@ -0,0 +1,26 @@
+{ %FAIL }
+
+{ class helpers can access (strict) protected, public and published members -
+  here: private }
+program tchlp13;
+
+{$ifdef fpc}
+  {$mode delphi}
+{$endif}
+
+uses
+  uchlp12;
+
+type
+  TTestHelper = class helper for TTest
+    function AccessTest: Integer;
+  end;
+
+function TTestHelper.AccessTest: Integer;
+begin
+  Result := Test2;
+end;
+
+begin
+end.
+

tests/test/tchlp14.pp

@@ -0,0 +1,26 @@
+{ %NORUN }
+
+{ class helpers can access (strict) protected, public and published members -
+  here: strict protected }
+program tchlp14;
+
+{$ifdef fpc}
+  {$mode delphi}
+{$endif}
+
+uses
+  uchlp12;
+
+type
+  TTestHelper = class helper for TTest
+    function AccessTest: Integer;
+  end;
+
+function TTestHelper.AccessTest: Integer;
+begin
+  Result := Test3;
+end;
+
+begin
+end.
+

tests/test/tchlp15.pp

@@ -0,0 +1,26 @@
+{ %NORUN }
+
+{ class helpers can access (strict) protected, public and published members -
+  here: protected }
+program tchlp15;
+
+{$ifdef fpc}
+  {$mode delphi}
+{$endif}
+
+uses
+  uchlp12;
+
+type
+  TTestHelper = class helper for TTest
+    function AccessTest: Integer;
+  end;
+
+function TTestHelper.AccessTest: Integer;
+begin
+  Result := Test4;
+end;
+
+begin
+end.
+

tests/test/tchlp16.pp

@@ -0,0 +1,26 @@
+{ %NORUN }
+
+{ class helpers can access (strict) protected, public and published members -
+  here: public }
+program tchlp16;
+
+{$ifdef fpc}
+  {$mode delphi}
+{$endif}
+
+uses
+  uchlp12;
+
+type
+  TTestHelper = class helper for TTest
+    function AccessTest: Integer;
+  end;
+
+function TTestHelper.AccessTest: Integer;
+begin
+  Result := Test5;
+end;
+
+begin
+end.
+

tests/test/tchlp17.pp

@@ -0,0 +1,26 @@
+{ %NORUN }
+
+{ class helpers can access (strict) protected, public and published members -
+  here: published }
+program tchlp17;
+
+{$ifdef fpc}
+  {$mode delphi}
+{$endif}
+
+uses
+  uchlp12;
+
+type
+  TTestHelper = class helper for TTest
+    function AccessTest: Integer;
+  end;
+
+function TTestHelper.AccessTest: Integer;
+begin
+  Result := Test6;
+end;
+
+begin
+end.
+

tests/test/tchlp18.pp

@@ -0,0 +1,18 @@
+{ %FAIL }
+
+{ usage of nested helpers adheres to visibility rules as well - here:
+  strict private }
+program tchlp18;
+
+{$ifdef fpc}
+  {$mode delphi}
+{$endif}
+
+uses
+  uchlp18;
+
+var
+  t: TTest1;
+begin
+  t.Test;
+end.

tests/test/tchlp19.pp

@@ -0,0 +1,19 @@
+{ %FAIL }
+
+{ usage of nested helpers adheres to visibility rules as well - here:
+  private }
+program tchlp19;
+
+{$ifdef fpc}
+  {$mode delphi}
+{$endif}
+
+uses
+  uchlp18;
+
+var
+  t: TTest2;
+begin
+  t.Test;
+end.
+

tests/test/tchlp2.pp

@@ -0,0 +1,28 @@
+{ %NORUN }
+
+{ this tests that helpers can introduce class methods for classes - mode
+  Delphi }
+program tchlp2;
+
+{$ifdef fpc}
+  {$mode delphi}
+{$endif}
+
+type
+  TTest = class
+
+  end;
+
+  TTestHelper = class helper for TTest
+    class procedure Test;
+  end;
+
+class procedure TTestHelper.Test;
+begin
+
+end;
+
+begin
+  TTest.Test;
+end.
+

tests/test/tchlp20.pp

@@ -0,0 +1,19 @@
+{ %FAIL }
+
+{ usage of nested helpers adheres to visibility rules as well - here:
+  strict protected }
+program tchlp20;
+
+{$ifdef fpc}
+  {$mode delphi}
+{$endif}
+
+uses
+  uchlp18;
+
+var
+  t: TTest3;
+begin
+  t.Test;
+end.
+

tests/test/tchlp21.pp

@@ -0,0 +1,19 @@
+{ %FAIL }
+
+{ usage of nested helpers adheres to visibility rules as well - here:
+  protected }
+program tchlp18;
+
+{$ifdef fpc}
+  {$mode delphi}
+{$endif}
+
+uses
+  uchlp18;
+
+var
+  t: TTest4;
+begin
+  t.Test;
+end.
+

tests/test/tchlp22.pp

@@ -0,0 +1,19 @@
+{ %NORUN }
+
+{ usage of nested helpers adheres to visibility rules as well - here:
+  public }
+program tchlp22;
+
+{$ifdef fpc}
+  {$mode delphi}
+{$endif}
+
+uses
+  uchlp18;
+
+var
+  t: TTest5;
+begin
+  t.Test;
+end.
+

tests/test/tchlp23.pp

@@ -0,0 +1,19 @@
+{ %NORUN }
+
+{ usage of nested helpers adheres to visibility rules as well - here:
+  published }
+program tchlp23;
+
+{$ifdef fpc}
+  {$mode delphi}
+{$endif}
+
+uses
+  uchlp18;
+
+var
+  t: TTest6;
+begin
+  t.Test;
+end.
+

tests/test/tchlp24.pp

@@ -0,0 +1,42 @@
+{ published methods of class helpers are not accessible through the extended
+  class' RTTI }
+program tchlp24;
+
+{$ifdef fpc}
+  {$mode delphi}
+{$endif}
+{$apptype console}
+
+type
+{$M+}
+  TTest = class
+  end;
+{$M-}
+
+{$M+}
+  TTestHelper = class helper for TTest
+  published
+    function Test: Integer;
+  end;
+{$M-}
+
+function TTestHelper.Test: Integer;
+begin
+  Result := 1;
+end;
+
+var
+  f: TTest;
+  res: Pointer;
+begin
+  f := TTest.Create;
+  res := f.MethodAddress('Test');
+{$ifdef fpc}
+  Writeln('Address of TTest.Test: ', PtrInt(res));
+{$else}
+  Writeln('Address of TTest.Test: ', NativeInt(res));
+{$endif}
+  if res <> Nil then
+    Halt(1);
+  Writeln('ok');
+end.

tests/test/tchlp25.pp

@@ -0,0 +1,23 @@
+{ %NORUN }
+
+{ class helpers can extend a subclass of the parent's extended class }
+program tchlp25;
+
+{$ifdef fpc}
+  {$mode delphi}
+{$endif}
+
+type
+  TObjectHelper = class helper for TObject
+  end;
+
+  TTest = class
+  end;
+
+  TTestHelper = class helper(TObjectHelper) for TTest
+  end;
+
+begin
+
+end.
+

tests/test/tchlp26.pp

@@ -0,0 +1,20 @@
+{ %FAIL }
+
+{ a class helper can only inherit from another class helper }
+program tchlp26;
+
+{$ifdef fpc}
+  {$mode delphi}
+{$endif}
+
+type
+  TTest = class
+
+  end;
+
+  TObjectHelper = class helper(TTest) for TObject
+  end;
+
+begin
+end.
+

tests/test/tchlp27.pp

@@ -0,0 +1,26 @@
+{ %FAIL }
+
+{ a class helper must extend a subclass of the parent class helper }
+program tchlp27;
+
+{$ifdef fpc}
+  {$mode delphi}
+{$endif}
+
+type
+  TTest1 = class
+
+  end;
+
+  TTest1Helper = class helper for TTest1
+  end;
+
+  TTest2 = class
+
+  end;
+
+  TTest2Helper = class helper(TTest1Helper) for TTest2
+  end;
+
+begin
+end.

tests/test/tchlp28.pp

@@ -0,0 +1,35 @@
+{ class helpers hide methods of the extended class }
+program tchlp28;
+
+{$ifdef fpc}
+  {$mode delphi}
+{$endif}
+
+type
+  TTest = class
+    function Test: Integer;
+  end;
+
+  TTestHelper = class helper for TTest
+    function Test: Integer;
+  end;
+
+function TTest.Test: Integer;
+begin
+  Result := 1;
+end;
+
+function TTestHelper.Test: Integer;
+begin
+  Result := 2;
+end;
+
+var
+  t: TTest;
+begin
+  t := TTest.Create;
+  if t.Test <> 2 then
+    Halt(1);
+  Writeln('ok');
+end.
+

tests/test/tchlp29.pp

@@ -0,0 +1,44 @@
+{ class helpers don't hide methods of the subclasses of the extended class }
+program tchlp29;
+
+{$ifdef fpc}
+  {$mode delphi}
+{$endif}
+
+type
+  TTest = class
+    function Test: Integer;
+  end;
+
+  TTestHelper = class helper for TTest
+    function Test: Integer;
+  end;
+
+  TTestSub = class(TTest)
+    function Test: Integer;
+  end;
+
+function TTest.Test: Integer;
+begin
+  Result := 1;
+end;
+
+function TTestHelper.Test: Integer;
+begin
+  Result := 2;
+end;
+
+function TTestSub.Test: Integer;
+begin
+  Result := 3;
+end;
+
+var
+  t: TTestSub;
+begin
+  t := TTestSub.Create;
+  if t.Test <> 3 then
+    Halt(1);
+  Writeln('ok');
+end.
+

tests/test/tchlp3.pp

@@ -0,0 +1,30 @@
+{ %NORUN }
+
+{ this tests that helpers can introduce instance methods for classes - mode
+  ObjFPC }
+program tchlp3;
+
+{$ifdef fpc}
+  {$mode objfpc}
+{$endif}
+
+type
+  TTest = class
+
+  end;
+
+  TTestHelper = class helper for TTest
+    procedure Test;
+  end;
+
+procedure TTestHelper.Test;
+begin
+
+end;
+
+var
+  t: TTest;
+begin
+  t.Test;
+end.
+

tests/test/tchlp30.pp

@@ -0,0 +1,31 @@
+{ %FAIL }
+
+{ helpers must not override virtual methods of the extended class }
+program tchlp30;
+
+{$ifdef fpc}
+  {$mode delphi}
+{$endif}
+
+type
+  TTest = class
+    function Test: Integer; virtual;
+  end;
+
+  TTestHelper = class helper for TTest
+    function Test: Integer; override;
+  end;
+
+function TTest.Test: Integer;
+begin
+
+end;
+
+function TTestHelper.Test: Integer;
+begin
+
+end;
+
+begin
+
+end.

tests/test/tchlp31.pp

@@ -0,0 +1,35 @@
+{ helpers may hide virtual methods of the extended class }
+program tchlp31;
+
+{$ifdef fpc}
+  {$mode delphi}
+{$endif}
+
+type
+  TTest = class
+    function Test: Integer; virtual;
+  end;
+
+  TTestHelper = class helper for TTest
+    function Test: Integer;
+  end;
+
+function TTest.Test: Integer;
+begin
+  Result := 1;
+end;
+
+function TTestHelper.Test: Integer;
+begin
+  Result := 2;
+end;
+
+var
+  t: TTest;
+begin
+  t := TTest.Create;
+  if t.Test <> 2 then
+    Halt(1);
+  Writeln('ok');
+end.
+

tests/test/tchlp32.pp

@@ -0,0 +1,35 @@
+{ %FAIL }
+
+{ overloading needs to be enabled explicitly }
+program tchlp32;
+
+{$ifdef fpc}
+  {$mode delphi}
+{$endif}
+
+type
+  TTest = class
+    procedure Test(const aTest: String);
+  end;
+
+  TTestHelper = class helper for TTest
+    procedure Test;
+  end;
+
+procedure TTest.Test(const aTest: String);
+begin
+
+end;
+
+procedure TTestHelper.Test;
+begin
+
+end;
+
+var
+  t: TTest;
+begin
+  t := TTest.Create;
+  t.Test('Foo');
+end.
+

tests/test/tchlp33.pp

@@ -0,0 +1,36 @@
+{ %NORUN }
+
+{ overloading needs to be enabled explicitly }
+program tchlp33;
+
+{$ifdef fpc}
+  {$mode delphi}
+{$endif}
+
+type
+  TTest = class
+    procedure Test(const aTest: String);
+  end;
+
+  TTestHelper = class helper for TTest
+    procedure Test; overload;
+  end;
+
+procedure TTest.Test(const aTest: String);
+begin
+
+end;
+
+procedure TTestHelper.Test;
+begin
+
+end;
+
+var
+  t: TTest;
+begin
+  t := TTest.Create;
+  t.Test;
+  t.Test('Foo');
+end.
+

tests/test/tchlp34.pp

@@ -0,0 +1,30 @@
+{ %NORUN }
+
+{ a helper can already be accessed when implementing a class' methods }
+program tchlp34;
+
+{$ifdef fpc}
+  {$mode delphi}
+{$endif}
+
+type
+  TTest = class
+    procedure Test;
+  end;
+
+  TTestHelper = class helper for TTest
+    procedure DoSomething;
+  end;
+
+procedure TTest.Test;
+begin
+  DoSomething;
+end;
+
+procedure TTestHelper.DoSomething;
+begin
+
+end;
+
+begin
+end.

tests/test/tchlp35.pp

@@ -0,0 +1,47 @@
+{ helper methods also influence calls to a parent's method in a derived class }
+program tchlp35;
+
+{$ifdef fpc}
+  {$mode delphi}
+{$endif}
+{$apptype console}
+
+type
+  TTest = class
+    function Test: Integer;
+  end;
+
+  TTestSub = class(TTest)
+    function AccessTest: Integer;
+  end;
+
+  TTestHelper = class helper for TTest
+    function Test: Integer;
+  end;
+
+function TTest.Test: Integer;
+begin
+  Result := 1;
+end;
+
+function TTestSub.AccessTest: Integer;
+begin
+  Result := Test;
+end;
+
+function TTestHelper.Test: Integer;
+begin
+  Result := 2;
+end;
+
+var
+  t: TTestSub;
+  res: Integer;
+begin
+  t := TTestSub.Create;
+  res := t.AccessTest;
+  Writeln('f.AccessTest: ', res);
+  if res <> 2 then
+    Halt(1);
+  Writeln('ok');
+end.

tests/test/tchlp36.pp

@@ -0,0 +1,48 @@
+{ helper methods also influence calls to a parent's method in a derived class }
+program tchlp36;
+
+{$ifdef fpc}
+  {$mode delphi}
+{$endif}
+{$apptype console}
+
+type
+  TTest = class
+    function Test: Integer;
+  end;
+
+  TTestSub = class(TTest)
+    function AccessTest: Integer;
+  end;
+
+  TTestHelper = class helper for TTest
+    function Test: Integer;
+  end;
+
+function TTest.Test: Integer;
+begin
+  Result := 1;
+end;
+
+function TTestSub.AccessTest: Integer;
+begin
+  Result := inherited Test;
+end;
+
+function TTestHelper.Test: Integer;
+begin
+  Result := 2;
+end;
+
+var
+  t: TTestSub;
+  res: Integer;
+begin
+  t := TTestSub.Create;
+  res := t.AccessTest;
+  Writeln('f.AccessTest: ', res);
+  if res <> 2 then
+    Halt(1);
+  Writeln('ok');
+end.
+

tests/test/tchlp37.pp

@@ -0,0 +1,33 @@
+{ %NORUN }
+
+{ helpers of a parent are available in a subclass as well }
+program tchlp37;
+
+{$ifdef fpc}
+  {$mode delphi}
+{$endif}
+{$apptype console}
+
+type
+  TTest = class
+
+  end;
+
+  TTestSub = class(TTest)
+
+  end;
+
+  TTestHelper = class helper for TTest
+    procedure Test;
+  end;
+
+procedure TTestHelper.Test;
+begin
+
+end;
+
+var
+  t: TTestSub;
+begin
+  t.Test;
+end.

tests/test/tchlp38.pp

@@ -0,0 +1,42 @@
+{ a helper of a parent class hides the parent's methods }
+program tchlp38;
+
+{$ifdef fpc}
+  {$mode delphi}
+{$endif}
+{$apptype console}
+
+type
+  TTest = class
+    function Test: Integer;
+  end;
+
+  TTestSub = class(TTest)
+
+  end;
+
+  TTestHelper = class helper for TTest
+    function Test: Integer;
+  end;
+
+function TTest.Test: Integer;
+begin
+  Result := 1;
+end;
+
+function TTestHelper.Test: Integer;
+begin
+  Result := 2;
+end;
+
+var
+  t: TTestSub;
+  res: Integer;
+begin
+  t := TTestSub.Create;
+  res := t.Test;
+  Writeln('b.TestFoo: ', res);
+  if res <> 2 then
+    Halt(1);
+  Writeln('ok');
+end.

tests/test/tchlp39.pp

@@ -0,0 +1,51 @@
+{ a helper of a parent class hides methods in the child class if its also a
+  parent of the helper for the child class }
+program tchlp90;
+
+{$ifdef fpc}
+  {$mode delphi}
+{$endif}
+{$apptype console}
+
+type
+  TTest = class
+    function Test: Integer;
+  end;
+
+  TTestSub = class(TTest)
+     function Test: Integer;
+  end;
+
+  TTestHelper = class helper for TTest
+    function Test: Integer;
+  end;
+
+  TTestSubHelper = class helper(TTestHelper) for TTestSub
+  end;
+
+function TTest.Test: Integer;
+begin
+  Result := 1;
+end;
+
+function TTestSub.Test: Integer;
+begin
+  Result := 4;
+end;
+
+function TTestHelper.Test: Integer;
+begin
+  Result := 2;
+end;
+
+var
+  t: TTestSub;
+  res: Integer;
+begin
+  t := TTestSub.Create;
+  res := t.Test;
+  Writeln('b.TestFoo: ', res);
+  if res <> 2 then
+    Halt(1);
+  Writeln('ok');
+end.

tests/test/tchlp4.pp

@@ -0,0 +1,28 @@
+{ %NORUN }
+
+{ this tests that helpers can introduce class methods for classes - mode
+  ObjFPC }
+program tchlp4;
+
+{$ifdef fpc}
+  {$mode delphi}
+{$endif}
+
+type
+  TTest = class
+
+  end;
+
+  TTestHelper = class helper for TTest
+    class procedure Test;
+  end;
+
+class procedure TTestHelper.Test;
+begin
+
+end;
+
+begin
+  TTest.Test;
+end.
+

tests/test/tchlp40.pp

@@ -0,0 +1,41 @@
+{ methods of the extended class can be called using "inherited" }
+program tchlp40;
+
+{$ifdef fpc}
+  {$mode delphi}
+{$endif}
+{$apptype console}
+
+type
+  TTest = class
+    function Test(aRecurse: Boolean): Integer;
+  end;
+
+  TTestHelper = class helper for TTest
+    function Test(aRecurse: Boolean): Integer;
+  end;
+
+function TTest.Test(aRecurse: Boolean): Integer;
+begin
+  Result := 1;
+end;
+
+function TTestHelper.Test(aRecurse: Boolean): Integer;
+begin
+  if aRecurse then
+    Result := inherited Test(False)
+  else
+    Result := 2;
+end;
+
+var
+  t: TTest;
+  res: Integer;
+begin
+  t := TTest.Create;
+  res := t.Test(True);
+  Writeln('t.Test: ', res);
+  if res <> 1 then
+    Halt(1);
+  Writeln('ok');
+end.

tests/test/tchlp41.pp

@@ -0,0 +1,51 @@
+{ the extended class has higher priority than the parent class when
+  searching for symbols }
+program tchlp41;
+
+{$ifdef fpc}
+  {$mode delphi}
+{$endif}
+{$apptype console}
+
+type
+  TTest = class
+    function Test(aRecurse: Boolean): Integer;
+  end;
+
+  TTestHelper = class helper for TTest
+    function Test(aRecurse: Boolean): Integer;
+  end;
+
+  TTestHelperSub = class helper(TTestHelper) for TTest
+    function Test(aRecurse: Boolean): Integer;
+  end;
+
+function TTest.Test(aRecurse: Boolean): Integer;
+begin
+  Result := 1;
+end;
+
+function TTestHelper.Test(aRecurse: Boolean): Integer;
+begin
+  Result := 2;
+end;
+
+function TTestHelperSub.Test(aRecurse: Boolean): Integer;
+begin
+  if aRecurse then
+    Result := inherited Test(False)
+  else
+    Result := 3;
+end;
+
+var
+  t: TTest;
+  res: Integer;
+begin
+  t := TTest.Create;
+  res := t.Test(True);
+  Writeln('t.Test: ', res);
+  if res <> 1 then
+    Halt(1);
+  Writeln('ok');
+end.

tests/test/tchlp42.pp

@@ -0,0 +1,51 @@
+{ the extended type is searched first for a inherited method even if it's
+  defined as "override" }
+program tchlp42;
+
+{$ifdef fpc}
+  {$mode delphi}
+{$endif}
+{$apptype console}
+
+type
+  TTest = class
+    function Test(aRecurse: Boolean): Integer; virtual;
+  end;
+
+  TObjectHelper = class helper for TObject
+    function Test(aRecurse: Boolean): Integer; virtual;
+  end;
+
+  TTestHelper = class helper(TObjectHelper) for TTest
+    function Test(aRecurse: Boolean): Integer; override;
+  end;
+
+function TTest.Test(aRecurse: Boolean): Integer;
+begin
+  Result := 1;
+end;
+
+function TObjectHelper.Test(aRecurse: Boolean): Integer;
+begin
+  Result := 2;
+end;
+
+function TTestHelper.Test(aRecurse: Boolean): Integer;
+begin
+  if aRecurse then
+    Result := inherited Test(False)
+  else
+    Result := 3;
+end;
+
+var
+  t: TTest;
+  res: Integer;
+begin
+  t := TTest.Create;
+  res := t.Test(True);
+  Writeln('t.Test: ', res);
+  if res <> 1 then
+    Halt(1);
+  Writeln('ok');
+end.

tests/test/tchlp43.pp

@@ -0,0 +1,35 @@
+{ %NORUN }
+
+{ for helpers Self always refers to the extended class }
+program tchlp43;
+
+{$ifdef fpc}
+  {$mode objfpc}
+{$endif}
+
+type
+  TTest = class
+    procedure DoTest(aTest: TTest);
+  end;
+
+  TTestHelper = class helper for TTest
+    procedure Test;
+  end;
+
+procedure TTest.DoTest(aTest: TTest);
+begin
+
+end;
+
+procedure TTestHelper.Test;
+begin
+  DoTest(Self);
+end;
+
+var
+  t: TTest;
+begin
+  t := TTest.Create;
+  t.Test;
+end.
+

tests/test/tchlp44.pp

@@ -0,0 +1,50 @@
+{ in a class helper Self always is of the type of the extended class }
+program tchlp44;
+
+{$ifdef fpc}
+  {$mode delphi}
+{$endif}
+{$apptype console}
+
+type
+  TTest = class
+    function Test: Integer;
+  end;
+
+  TTestSub = class(TTest)
+    function Test: Integer;
+  end;
+
+  TTestHelper = class helper for TTest
+    function AccessTest: Integer;
+  end;
+
+  TTestSubHelper = class helper(TTestHelper) for TTestSub
+  end;
+
+function TTest.Test: Integer;
+begin
+  Result := 1;
+end;
+
+function TTestSub.Test: Integer;
+begin
+  Result := 2;
+end;
+
+function TTestHelper.AccessTest: Integer;
+begin
+  Result := Test;
+end;
+
+var
+  t: TTestSub;
+  res: Integer;
+begin
+  t := TTestSub.Create;
+  res := t.AccessTest;
+  Writeln('t.AccessTest: ', res);
+  if res <> 1 then
+    Halt(1);
+  Writeln('ok');
+end.

tests/test/tchlp45.pp

@@ -0,0 +1,35 @@
+{ %NORUN }
+
+{ tests whether the methods of a parent helper are usable in a derived helper }
+program tchlp45;
+
+{$ifdef fpc}
+  {$mode delphi}
+{$endif}
+{$apptype console}
+
+type
+  TTest = class
+
+  end;
+
+  TTestHelper = class helper for TTest
+    procedure Test;
+  end;
+
+  TTestHelperSub = class helper(TTestHelper) for TTest
+    procedure AccessTest;
+  end;
+
+procedure TTestHelper.Test;
+begin
+
+end;
+
+procedure TTestHelperSub.AccessTest;
+begin
+  Test;
+end;
+
+begin
+end.

tests/test/tchlp46.pp

@@ -0,0 +1,46 @@
+{ test that helpers can access the methods of the parent helper using
+  "inherited" }
+program tchlp46;
+
+{$ifdef fpc}
+  {$mode delphi}
+{$endif}
+{$apptype console}
+
+type
+  TTest = class
+
+  end;
+
+  TTestHelper = class helper for TTest
+    function Test(aRecurse: Boolean): Integer;
+  end;
+
+  TTestHelperSub = class helper(TTestHelper) for TTest
+    function Test(aRecurse: Boolean): Integer;
+  end;
+
+function TTestHelper.Test(aRecurse: Boolean): Integer;
+begin
+  Result := 1;
+end;
+
+function TTestHelperSub.Test(aRecurse: Boolean): Integer;
+begin
+  if aRecurse then
+    Result := inherited Test(False)
+  else
+    Result := 2;
+end;
+
+var
+  t: TTest;
+  res: Integer;
+begin
+  t := TTest.Create;
+  res := t.Test(True);
+  Writeln('t.Test: ', res);
+  if res <> 1 then
+    Halt(1);
+  Writeln('ok');
+end.

tests/test/tchlp47.pp

@@ -0,0 +1,51 @@
+{ a method defined in a parent helper has higher priority than a method defined
+  in the parent of the extended class - test 1}
+program tchlp47;
+
+{$ifdef fpc}
+  {$mode delphi}
+{$endif}
+{$apptype console}
+
+type
+  TTest = class
+    function Test: Integer;
+  end;
+
+  TTestSub = class(TTest)
+  end;
+
+  TTestSubHelper = class helper for TTestSub
+    function Test: Integer;
+  end;
+
+  TTestSubHelperSub = class helper(TTestSubHelper) for TTestSub
+    function AccessTest: Integer;
+  end;
+
+function TTest.Test: Integer;
+begin
+  Result := 1;
+end;
+
+function TTestSubHelper.Test: Integer;
+begin
+  Result := 2;
+end;
+
+function TTestSubHelperSub.AccessTest: Integer;
+begin
+  Result := Test;
+end;
+
+var
+  t: TTestSub;
+  res: Integer;
+begin
+  t := TTestSub.Create;
+  res := t.AccessTest;
+  Writeln('t.AccessTest: ', res);
+  if res <> 2 then
+    Halt(1);
+  Writeln('ok');
+end.

tests/test/tchlp48.pp

@@ -0,0 +1,51 @@
+{ a method defined in a parent helper has higher priority than a method defined
+  in the parent of the extended class - test 2 }
+program tchlp48;
+
+{$ifdef fpc}
+  {$mode delphi}
+{$endif}
+{$apptype console}
+
+type
+  TTest = class
+    function Test: Integer;
+  end;
+
+  TTestSub = class(TTest)
+  end;
+
+  TTestSubHelper = class helper for TTestSub
+    function Test: Integer;
+  end;
+
+  TTestSubHelperSub = class helper(TTestSubHelper) for TTestSub
+    function AccessTest: Integer;
+  end;
+
+function TTest.Test: Integer;
+begin
+  Result := 1;
+end;
+
+function TTestSubHelper.Test: Integer;
+begin
+  Result := 2;
+end;
+
+function TTestSubHelperSub.AccessTest: Integer;
+begin
+  Result := inherited Test;
+end;
+
+var
+  t: TTestSub;
+  res: Integer;
+begin
+  t := TTestSub.Create;
+  res := t.AccessTest;
+  Writeln('t.AccessTest: ', res);
+  if res <> 2 then
+    Halt(1);
+  Writeln('ok');
+end.

tests/test/tchlp49.pp

@@ -0,0 +1,46 @@
+{ a class helper can access methods defined in the parent of the extended
+  class }
+program tchlp49;
+
+{$ifdef fpc}
+  {$mode delphi}
+{$endif}
+{$apptype console}
+
+type
+  TTest = class
+    function Test(aRecurse: Boolean): Integer;
+  end;
+
+  TTestSub = class(TTest)
+  end;
+
+  TTestSubHelper = class helper for TTestSub
+    function Test(aRecurse: Boolean): Integer;
+  end;
+
+function TTest.Test(aRecurse: Boolean): Integer;
+begin
+  Result := 1;
+end;
+
+function TTestSubHelper.Test(aRecurse: Boolean): Integer;
+begin
+  if aRecurse then
+    Result := inherited Test(False)
+  else
+    Result := 2;
+end;
+
+var
+  t: TTestSub;
+  res: Integer;
+begin
+  t := TTestSub.Create;
+  res := t.Test(True);
+  Writeln('t.Test: ', res);
+  if res <> 1 then
+    Halt(1);
+  Writeln('ok');
+end.
+

tests/test/tchlp5.pp

@@ -0,0 +1,29 @@
+{ the size of a class helper is equivalent to that of a pointer }
+program tchlp5;
+
+{$ifdef fpc}
+  {$mode delphi}
+{$endif}
+{$apptype console}
+
+type
+  TTest = class
+    s: String;
+    i32: Integer;
+    b: Boolean;
+    i64: Int64;
+  end;
+
+  TTestHelper = class helper for TTest
+  end;
+
+var
+  res: Integer;
+begin
+  res := SizeOf(TTestHelper);
+  Writeln('SizeOf(TTest): ', SizeOf(TTest));
+  Writeln('SizeOf(TTestHelper): ', res);
+  if res <> SizeOf(Pointer) then
+    Halt(1);
+  Writeln('ok');
+end.

tests/test/tchlp50.pp

@@ -0,0 +1,41 @@
+{ without "inherited" the methods of the helper are called first }
+program tchlp50;
+
+{$ifdef fpc}
+  {$mode delphi}
+{$endif}
+{$apptype console}
+
+type
+  TTest = class
+    function Test(aRecurse: Boolean): Integer;
+  end;
+
+  TTestHelper = class helper for TTest
+    function Test(aRecurse: Boolean): Integer;
+  end;
+
+function TTest.Test(aRecurse: Boolean): Integer;
+begin
+  Result := 1;
+end;
+
+function TTestHelper.Test(aRecurse: Boolean): Integer;
+begin
+  if aRecurse then
+    Result := Test(False)
+  else
+    Result := 2;
+end;
+
+var
+  t: TTest;
+  res: Integer;
+begin
+  t := TTest.Create;
+  res := t.Test(True);
+  Writeln('t.Test: ', res);
+  if res <> 2 then
+    Halt(1);
+  Writeln('ok');
+end.

tests/test/tchlp51.pp

@@ -0,0 +1,47 @@
+{ methods defined in a helper have higher priority than those defined in the
+  extended type }
+program tchlp51;
+
+{$ifdef fpc}
+  {$mode delphi}
+{$endif}
+{$apptype console}
+
+type
+  TTest = class
+    function Test: Integer;
+  end;
+
+  TTestHelper = class helper for TTest
+  private
+    function Test: Integer;
+  public
+    function AccessTest: Integer;
+  end;
+
+function TTest.Test: Integer;
+begin
+  Result := 1;
+end;
+
+function TTestHelper.Test: Integer;
+begin
+  Result := 2;
+end;
+
+function TTestHelper.AccessTest: Integer;
+begin
+  Result := Test;
+end;
+
+var
+  t: TTest;
+  res: Integer;
+begin
+  t := TTest.Create;
+  res := t.AccessTest;
+  Writeln('t.AccessTest: ', res);
+  if res <> 2 then
+    Halt(1);
+  Writeln('ok');
+end.

tests/test/tchlp52.pp

@@ -0,0 +1,73 @@
+{ %NORUN }
+
+{ a helper may introduce an enumerator }
+program tchlp52;
+
+{$ifdef fpc}
+  {$mode delphi}
+{$endif}
+
+type
+  TContainer = class
+    Contents: array[0..5] of Integer;
+    constructor Create;
+  end;
+
+  TContainerEnum = class
+  private
+    fIndex: Integer;
+    fContainer: TContainer;
+  public
+    constructor Create(aContainer: TContainer);
+    function GetCurrent: Integer;
+    function MoveNext: Boolean;
+    property Current: Integer read GetCurrent;
+  end;
+
+  TContainerHelper = class helper for TContainer
+    function GetEnumerator: TContainerEnum;
+  end;
+
+{ TContainer }
+
+constructor TContainer.Create;
+var
+  i: Integer;
+begin
+  for i := Low(Contents) to High(Contents) do
+    Contents[i] := i;
+end;
+
+{ TContainerHelper }
+
+function TContainerHelper.GetEnumerator: TContainerEnum;
+begin
+  Result := TContainerEnum.Create(Self);
+end;
+
+{ TContainerEnum }
+
+constructor TContainerEnum.Create(aContainer: TContainer);
+begin
+  fContainer := aContainer;
+  fIndex := Low(fContainer.Contents) - 1;
+end;
+
+function TContainerEnum.GetCurrent: Integer;
+begin
+  Result := fContainer.Contents[fIndex];
+end;
+
+function TContainerEnum.MoveNext: Boolean;
+begin
+  Inc(fIndex);
+  Result := fIndex <= High(fContainer.Contents);
+end;
+
+var
+  cont: TContainer;
+  i: Integer;
+begin
+  cont := TContainer.Create;
+  for i in cont do ;
+end.

tests/test/tchlp53.pp

@@ -0,0 +1,97 @@
+{ a helper hides an existing enumerator }
+program tchlp53;
+
+{$ifdef fpc}
+  {$mode delphi}
+{$endif}
+{$apptype console}
+
+type
+  TContainerEnum = class;
+
+  TContainer = class
+    Contents: array[0..5] of Integer;
+    function GetEnumerator: TContainerEnum;
+    constructor Create;
+  end;
+
+  TContainerEnum = class
+  private
+    fIndex: Integer;
+    fContainer: TContainer;
+    fForward: Boolean;
+  public
+    constructor Create(aContainer: TContainer; aForward: Boolean);
+    function GetCurrent: Integer;
+    function MoveNext: Boolean;
+    property Current: Integer read GetCurrent;
+  end;
+
+  TContainerHelper = class helper for TContainer
+    function GetEnumerator: TContainerEnum;
+  end;
+
+{ TContainer }
+
+constructor TContainer.Create;
+var
+  i: Integer;
+begin
+  for i := Low(Contents) to High(Contents) do
+    Contents[i] := i;
+end;
+
+function TContainer.GetEnumerator: TContainerEnum;
+begin
+  Result := TContainerEnum.Create(Self, True);
+end;
+
+{ TContainerHelper }
+
+function TContainerHelper.GetEnumerator: TContainerEnum;
+begin
+  Result := TContainerEnum.Create(Self, False);
+end;
+
+{ TContainerEnum }
+
+constructor TContainerEnum.Create(aContainer: TContainer; aForward: Boolean);
+begin
+  fContainer := aContainer;
+  fForward := aForward;
+  if fForward then
+    fIndex := Low(fContainer.Contents) - 1
+  else
+    fIndex := High(fContainer.Contents) + 1;
+end;
+
+function TContainerEnum.GetCurrent: Integer;
+begin
+  Result := fContainer.Contents[fIndex];
+end;
+
+function TContainerEnum.MoveNext: Boolean;
+begin
+  if fForward then begin
+    Inc(fIndex);
+    Result := fIndex <= High(fContainer.Contents);
+  end else begin
+    Dec(fIndex);
+    Result := fIndex >= Low(fContainer.Contents);
+  end;
+end;
+
+var
+  cont: TContainer;
+  i, c: Integer;
+begin
+  cont := TContainer.Create;
+  c := 5;
+  for i in cont do begin
+    if c <> i then
+      Halt(1);
+    Writeln(i);
+    Dec(c);
+  end;
+  Writeln('ok');
+end.

tests/test/tchlp54.pp

@@ -0,0 +1,123 @@
+{ this example tests combinations of class and helpers hierarchies }
+program tchlp54;
+
+{$ifdef fpc}
+  {$mode delphi}
+{$endif}
+{$apptype console}
+
+type
+  TTest1 = class
+  end;
+
+  TTest2 = class(TTest1)
+    class function Test3: Integer;
+  end;
+
+  TTest3 = class(TTest2)
+    class function Test1: Integer;
+    class function Test2: Integer;
+  end;
+
+  TTest4 = class(TTest3)
+  end;
+
+  TTest1Helper = class helper for TTest1
+    class function Test1: Integer;
+    class function Test3: Integer;
+    class function Test4: Integer;
+  end;
+
+  TTest3Helper = class helper for TTest3
+    class function Test2: Integer;
+    class function Test4: Integer;
+  end;
+
+  TTest4Helper = class helper(TTest1Helper) for TTest4
+    class function DoTest1: Integer;
+    class function DoTest2: Integer;
+    class function DoTest3: Integer;
+    class function DoTest4: Integer;
+  end;
+
+class function TTest2.Test3: Integer;
+begin
+  Result := 1;
+end;
+
+class function TTest3.Test1: Integer;
+begin
+  Result := 1;
+end;
+
+class function TTest3.Test2: Integer;
+begin
+  Result := 1;
+end;
+
+class function TTest1Helper.Test1: Integer;
+begin
+  Result := 2;
+end;
+
+class function TTest1Helper.Test3: Integer;
+begin
+  Result := 2;
+end;
+
+class function TTest1Helper.Test4: Integer;
+begin
+  Result := 1;
+end;
+
+class function TTest3Helper.Test2: Integer;
+begin
+  Result := 2;
+end;
+
+class function TTest3Helper.Test4: Integer;
+begin
+  Result := 2;
+end;
+
+class function TTest4Helper.DoTest1: Integer;
+begin
+  Result := Test1;
+end;
+
+class function TTest4Helper.DoTest2: Integer;
+begin
+  Result := Test2;
+end;
+
+class function TTest4Helper.DoTest3: Integer;
+begin
+  Result := Test3;
+end;
+
+class function TTest4Helper.DoTest4: Integer;
+begin
+  Result := Test4;
+end;
+
+var
+  res: Integer;
+begin
+  res := TTest4.DoTest1;
+  Writeln('TTest4.DoTest1: ', res);
+  if res <> 2 then
+    Halt(1);
+  res := TTest4.DoTest2;
+  Writeln('TTest4.DoTest2: ', res);
+  if res <> 2 then
+    Halt(2);
+  res := TTest4.DoTest3;
+  Writeln('TTest4.DoTest3: ', res);
+  if res <> 2 then
+    Halt(3);
+  res := TTest4.DoTest4;
+  Writeln('TTest4.DoTest4: ', res);
+  if res <> 1 then
+    Halt(4);
+  Writeln('ok');
+end.

tests/test/tchlp6.pp

@@ -0,0 +1,34 @@
+{ helpers may introduce new default properties }
+program tchlp6;
+
+{$ifdef fpc}
+  {$mode delphi}
+{$endif}
+{$apptype console}
+
+type
+  TTest = class
+
+  end;
+
+  TTestHelper = class helper for TTest
+    function GetTest(aIndex: Integer): Integer;
+    property Test[Index: Integer]: Integer read GetTest; default;
+  end;
+
+function TTestHelper.GetTest(aIndex: Integer): Integer;
+begin
+  Result := aIndex;
+end;
+
+var
+  t: TTest;
+  res: Integer;
+begin
+  t := TTest.Create;
+  res := t[3];
+  Writeln('value: ', res);
+  if res <> 3 then
+    Halt(1);
+  Writeln('ok');
+end.

tests/test/tchlp7.pp

@@ -0,0 +1,42 @@
+{ helpers may override existing default properties }
+program tchlp7;
+
+{$ifdef fpc}
+  {$mode delphi}
+{$endif}
+{$apptype console}
+
+type
+  TTest = class
+  private
+    function GetTest(aIndex: Integer): Integer;
+  public
+    property Test[Index: Integer]: Integer read GetTest; default;
+  end;
+
+  TTestHelper = class helper for TTest
+    function GetTest(aIndex: Integer): Integer;
+    property Test[Index: Integer]: Integer read GetTest; default;
+  end;
+
+function TTest.GetTest(aIndex: Integer): Integer;
+begin
+  Result := - aIndex;
+end;
+
+function TTestHelper.GetTest(aIndex: Integer): Integer;
+begin
+  Result := aIndex;
+end;
+
+var
+  t: TTest;
+  res: Integer;
+begin
+  t := TTest.Create;
+  res := t[3];
+  Writeln('value: ', res);
+  if res <> 3 then
+    Halt(1);
+  Writeln('ok');
+end.

tests/test/tchlp8.pp

@@ -0,0 +1,38 @@
+{ helpers may introduce new default properties (includes default properties
+  introudced by the helper's parent) }
+program tchlp8;
+
+{$ifdef fpc}
+  {$mode delphi}
+{$endif}
+{$apptype console}
+
+type
+  TTest = class
+
+  end;
+
+  TTestHelper = class helper for TTest
+    function GetTest(aIndex: Integer): Integer;
+    property Test[Index: Integer]: Integer read GetTest; default;
+  end;
+
+  TTestHelperSub = class helper(TTestHelper) for TTest
+  end;
+
+function TTestHelper.GetTest(aIndex: Integer): Integer;
+begin
+  Result := aIndex;
+end;
+
+var
+  t: TTest;
+  res: Integer;
+begin
+  t := TTest.Create;
+  res := t[3];
+  Writeln('value: ', res);
+  if res <> 3 then
+    Halt(1);
+  Writeln('ok');
+end.

tests/test/tchlp9.pp

@@ -0,0 +1,22 @@
+{ %FAIL }
+
+{ inside a helper's declaration the methods/fields of the extended class can't
+  be accessed }
+program tchlp9;
+
+{$ifdef fpc}
+  {$mode delphi}
+{$endif}
+
+type
+  TTest = class
+    Test: Integer;
+    function GetTest: Integer;
+  end;
+
+  TTestHelper = class helper for TTest
+    property AccessTest: Integer read Test;
+  end;
+
+begin
+end.

tests/test/thlp1.pp

@@ -0,0 +1,18 @@
+{ %NORUN }
+
+{ tests the inheritance syntax of helpers }
+program thlp1;
+
+{$ifdef fpc}
+  {$mode delphi}
+{$endif}
+
+type
+  TObjectHelper = class helper for TObject
+  end;
+
+  TObjectHelperSub = class helper(TObjectHelper) for TObject
+  end;
+
+begin
+end.

tests/test/thlp10.pp

@@ -0,0 +1,20 @@
+{ %FAIL }
+
+{ destructors are not allowed }
+program thlp10;
+
+{$ifdef fpc}
+  {$mode delphi}
+{$endif}
+
+type
+  TObjectHelper = class helper for TObject
+    destructor Destroy;
+  end;
+
+destructor TObjectHelper.Destroy;
+begin
+end;
+
+begin
+end.

tests/test/thlp11.pp

@@ -0,0 +1,21 @@
+{ %FAIL }
+
+{ class destructors are not allowed }
+program thlp11;
+
+{$ifdef fpc}
+  {$mode delphi}
+{$endif}
+
+type
+  TObjectHelper = class helper for TObject
+    class destructor Destroy;
+  end;
+
+class destructor TObjectHelper.Destroy;
+begin
+end;
+
+begin
+end.
+