+ add support for MultiHelpers modeswitch by Ryan Joseph for Mantis #35159

+ added tests

git-svn-id: trunk@42026 -

.gitattributes

@@ -13638,6 +13638,22 @@ tests/test/tmsg1.pp svneol=native#text/plain
 tests/test/tmsg2.pp svneol=native#text/plain
 tests/test/tmsg3.pp svneol=native#text/plain
 tests/test/tmsg4.pp svneol=native#text/plain
+tests/test/tmshlp1.pp svneol=native#text/pascal
+tests/test/tmshlp10.pp svneol=native#text/pascal
+tests/test/tmshlp11.pp svneol=native#text/pascal
+tests/test/tmshlp12.pp svneol=native#text/pascal
+tests/test/tmshlp13.pp svneol=native#text/pascal
+tests/test/tmshlp14.pp svneol=native#text/pascal
+tests/test/tmshlp15.pp svneol=native#text/pascal
+tests/test/tmshlp16.pp svneol=native#text/pascal
+tests/test/tmshlp2.pp svneol=native#text/pascal
+tests/test/tmshlp3.pp svneol=native#text/pascal
+tests/test/tmshlp4.pp svneol=native#text/pascal
+tests/test/tmshlp5.pp svneol=native#text/pascal
+tests/test/tmshlp6.pp svneol=native#text/pascal
+tests/test/tmshlp7.pp svneol=native#text/pascal
+tests/test/tmshlp8.pp svneol=native#text/pascal
+tests/test/tmshlp9.pp svneol=native#text/pascal
 tests/test/tmt1.pp svneol=native#text/plain
 tests/test/tmul1.pp svneol=native#text/pascal
 tests/test/tnest1.pp svneol=native#text/plain
@@ -14197,6 +14213,9 @@ tests/test/ulib2a.pp svneol=native#text/plain
 tests/test/umaclocalprocparam3f.pp svneol=native#text/plain
 tests/test/umacpas1.pp svneol=native#text/plain
 tests/test/umainnam.pp svneol=native#text/plain
+tests/test/umshlp1.pp svneol=native#text/pascal
+tests/test/umshlp15a.pp svneol=native#text/pascal
+tests/test/umshlp15b.pp svneol=native#text/pascal
 tests/test/unit3.pp svneol=native#text/pascal
 tests/test/units/character/tgetnumericvalue.pp svneol=native#text/pascal
 tests/test/units/character/tgetnumericvalue2.pp svneol=native#text/pascal

compiler/globtype.pas

@@ -481,7 +481,8 @@ interface
          m_isolike_io,          { I/O as it required by an ISO compatible compiler }
          m_isolike_program_para, { program parameters as it required by an ISO compatible compiler }
          m_isolike_mod,         { mod operation as it is required by an iso compatible compiler }
-         m_array_operators      { use Delphi compatible array operators instead of custom ones ("+") }
+         m_array_operators,     { use Delphi compatible array operators instead of custom ones ("+") }
+         m_multi_helpers        { helpers can appear in multiple scopes simultaneously }
        );
        tmodeswitches = set of tmodeswitch;
 
@@ -670,7 +671,8 @@ interface
          'ISOIO',
          'ISOPROGRAMPARAS',
          'ISOMOD',
-         'ARRAYOPERATORS'
+         'ARRAYOPERATORS',
+         'MULTIHELPERS'
          );
 
 

compiler/htypechk.pas

@@ -2261,6 +2261,33 @@ implementation
             end;
         end;
 
+      function processhelper(hashedid:THashedIDString;helperdef:tobjectdef):boolean;
+        var
+          srsym : tsym;
+          hasoverload,foundanything : boolean;
+        begin
+          result:=false;
+          srsym:=nil;
+          hasoverload:=false;
+          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),foundanything);
+                  { when there is no explicit overload we stop searching }
+                  if foundanything and
+                     not hasoverload then
+                    break;
+                end;
+              helperdef:=helperdef.childof;
+            end;
+          if not hasoverload and assigned(srsym) then
+            exit(true);
+        end;
+
       var
         srsym      : tsym;
         hashedid   : THashedIDString;
@@ -2268,6 +2295,8 @@ implementation
         foundanything : boolean;
         extendeddef : tabstractrecorddef;
         helperdef  : tobjectdef;
+        helperlist : TFPObjectList;
+        i : integer;
       begin
         if FOperator=NOTOKEN then
           hashedid.id:=FProcsym.name
@@ -2287,27 +2316,24 @@ implementation
                )
                and searchhelpers then
              begin
-               if search_last_objectpascal_helper(structdef,nil,helperdef) then
+               if m_multi_helpers in current_settings.modeswitches then
                  begin
-                   srsym:=nil;
+                   helperlist:=get_objectpascal_helpers(structdef);
-                   while assigned(helperdef) do
+                   if assigned(helperlist) and (helperlist.count>0) then
                      begin
-                       srsym:=tsym(helperdef.symtable.FindWithHash(hashedid));
+                       i:=helperlist.count-1;
-                       if assigned(srsym) and
+                       repeat
-                           { Delphi allows hiding a property by a procedure with the same name }
+                         helperdef:=tobjectdef(helperlist[i]);
-                           (srsym.typ=procsym) then
+                         if (helperdef.owner.symtabletype in [staticsymtable,globalsymtable]) or
-                         begin
+                            is_visible_for_object(helperdef.typesym,helperdef) then
-                           hasoverload:=processprocsym(tprocsym(srsym),foundanything);
+                              if processhelper(hashedid,helperdef) then
-                           { when there is no explicit overload we stop searching }
+                                exit;
-                           if foundanything and
+                         dec(i);
-                              not hasoverload then
+                       until (i<0);
-                             break;
-                         end;
-                       helperdef:=helperdef.childof;
                      end;
-                   if not hasoverload and assigned(srsym) then
+                 end
-                     exit;
+               else if search_last_objectpascal_helper(structdef,nil,helperdef) and processhelper(hashedid,helperdef) then
-                 end;
+                  exit;
              end;
            { now search in the type itself }
            srsym:=tsym(structdef.symtable.FindWithHash(hashedid));

compiler/symtable.pas

@@ -383,6 +383,8 @@ interface
     { actually defined (could be disable using "undef")                     }
     function  defined_macro(const s : string):boolean;
     { Look for a system procedure (no overloads supported) }
+    { returns a list of helpers in the current module for the def }
+    function get_objectpascal_helpers(pd : tdef):TFPObjectList;
 
 {*** Object Helpers ***}
     function search_default_property(pd : tabstractrecorddef) : tpropertysym;
@@ -3829,6 +3831,8 @@ implementation
         srsymtable:=nil;
       end;
 
+    function search_best_objectpascal_helper(const name: string;pd : tdef;contextclassh : tabstractrecorddef;out srsym: tsym;out srsymtable: tsymtable):boolean;forward;
+
     function searchsym_in_helper(classh,contextclassh:tobjectdef;const s: TIDString;out srsym:tsym;out srsymtable:TSymtable;flags:tsymbol_search_flags):boolean;
       var
         hashedid      : THashedIDString;
@@ -3890,10 +3894,17 @@ implementation
               end;
             parentclassh:=parentclassh.childof;
           end;
+        { now search in the parents of the extended class (with helpers!) }
         if is_class(classh.extendeddef) then
-          { now search in the parents of the extended class (with helpers!) }
+          begin
-          result:=searchsym_in_class(tobjectdef(classh.extendeddef).childof,contextclassh,s,srsym,srsymtable,flags+[ssf_search_helper]);
+            result:=searchsym_in_class(tobjectdef(classh.extendeddef).childof,contextclassh,s,srsym,srsymtable,flags+[ssf_search_helper]);
-          { addsymref is already called by searchsym_in_class }
+            { addsymref is already called by searchsym_in_class }
+            if result then
+              exit;
+          end;
+        { now search all helpers using the extendeddef as the starting point }
+        if m_multi_helpers in current_settings.modeswitches then
+          result:=search_best_objectpascal_helper(s,classh.extendeddef,contextclassh,srsym,srsymtable);
       end;
 
     function search_specific_assignment_operator(assignment_type:ttoken;from_def,to_def:Tdef):Tprocdef;
@@ -4106,15 +4117,59 @@ implementation
           end;
       end;
 
-    function search_last_objectpascal_helper(pd : tdef;contextclassh : tabstractrecorddef;out odef : tobjectdef):boolean;
+    function search_sym_in_helperdef(const s: string;classh : tobjectdef;contextclassh : tabstractrecorddef;out srsym: tsym;out srsymtable: tsymtable): boolean;
       var
-        s: string;
+        hashedid : THashedIDString;
-        list: TFPObjectList;
+        pdef : tprocdef;
-        i: integer;
+        i : integer;
-        st: tsymtable;
       begin
+        hashedid.id:=s;
         result:=false;
-        odef:=nil;
+        repeat
+          srsymtable:=classh.symtable;
+          srsym:=tsym(srsymtable.FindWithHash(hashedid));
+          if srsym<>nil then
+            begin
+              case srsym.typ of
+                procsym:
+                  begin
+                    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;
+                        srsym:=tprocdef(tprocsym(srsym).procdeflist[i]).procsym;
+                        srsymtable:=srsym.owner;
+                        result:=true;
+                        exit;
+                      end;
+                  end;
+                typesym,
+                fieldvarsym,
+                constsym,
+                enumsym,
+                undefinedsym,
+                propertysym:
+                  begin
+                    result:=true;
+                    exit;
+                  end;
+                else
+                  internalerror(2014041101);
+              end;
+            end;
+
+          { try the helper parent if available }
+          classh:=classh.childof;
+        until classh=nil;
+      end;
+
+    function get_objectpascal_helpers(pd : tdef):TFPObjectList;
+      var
+        s : string;
+        st : tsymtable;
+      begin
+        result:=nil;
         { when there are no helpers active currently then we don't need to do
           anything }
         if current_module.extendeddefs.count=0 then
@@ -4137,7 +4192,42 @@ implementation
           exit;
         { the mangled name is used as the key for tmodule.extendeddefs }
         s:=generate_objectpascal_helper_key(pd);
-        list:=TFPObjectList(current_module.extendeddefs.Find(s));
+        result:=TFPObjectList(current_module.extendeddefs.Find(s));
+      end;
+
+    function search_best_objectpascal_helper(const name: string;pd : tdef;contextclassh : tabstractrecorddef;out srsym: tsym;out srsymtable: tsymtable):boolean;
+      var
+        s : string;
+        list : TFPObjectList;
+        i : integer;
+        st : tsymtable;
+        odef : tobjectdef;
+      begin
+        result:=false;
+        list:=get_objectpascal_helpers(pd);
+        if assigned(list) and (list.count>0) then
+          begin
+            i:=list.count-1;
+            repeat
+              odef:=tobjectdef(list[i]);
+              result:=(odef.owner.symtabletype in [staticsymtable,globalsymtable]) or
+                      is_visible_for_object(tobjectdef(list[i]).typesym,contextclassh);
+              if result then
+                result:=search_sym_in_helperdef(name,odef,contextclassh,srsym,srsymtable);
+              dec(i);
+            until result or (i<0);
+          end;
+      end;
+
+    function search_last_objectpascal_helper(pd : tdef;contextclassh : tabstractrecorddef;out odef : tobjectdef):boolean;
+      var
+        s : string;
+        list : TFPObjectList;
+        i : integer;
+      begin
+        result:=false;
+        odef:=nil;
+        list:=get_objectpascal_helpers(pd);
         if assigned(list) and (list.count>0) then
           begin
             i:=list.count-1;
@@ -4154,72 +4244,38 @@ implementation
       end;
 
     function search_objectpascal_helper(pd : tdef;contextclassh : tabstractrecorddef;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
+        if m_multi_helpers in current_settings.modeswitches then
-          exit;
+          result:=search_best_objectpascal_helper(s,pd,contextclassh,srsym,srsymtable)
+        else
+          begin
+            if search_last_objectpascal_helper(pd,contextclassh,classh) and
+               search_sym_in_helperdef(s,classh,contextclassh,srsym,srsymtable) then
+                result:=true;
+          end;
 
-        hashedid.id:=s;
+        if result then
-
+          begin
-        repeat
+            { we need to know if a procedure references symbols
-          srsymtable:=classh.symtable;
+              in the static symtable, because then it can't be
-          srsym:=tsym(srsymtable.FindWithHash(hashedid));
+              inlined from outside this unit }
-
+            if (srsym.typ=procsym) and
-          if srsym<>nil then
+               assigned(current_procinfo) and
-            begin
+               (srsym.owner.symtabletype=staticsymtable) then
-              case srsym.typ of
+              include(current_procinfo.flags,pi_uses_static_symtable);
-                procsym:
+            addsymref(srsym);
-                  begin
+          end
-                    for i:=0 to tprocsym(srsym).procdeflist.count-1 do
+        else
-                      begin
+          begin
-                        pdef:=tprocdef(tprocsym(srsym).procdeflist[i]);
+            srsym:=nil;
-                        if not is_visible_for_object(pdef.owner,pdef.visibility,contextclassh) then
+            srsymtable:=nil;
-                          continue;
+          end;
-                        { 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;
-                typesym,
-                fieldvarsym,
-                constsym,
-                enumsym,
-                undefinedsym,
-                propertysym:
-                  begin
-                    addsymref(srsym);
-                    result:=true;
-                    exit;
-                  end;
-                else
-                  internalerror(2014041101);
-              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;

tests/test/tmshlp1.pp

@@ -0,0 +1,38 @@
+{ %NORUN }
+
+{$mode objfpc}
+{$modeswitch multihelpers}
+
+program tmshlp1;
+
+type
+	TMyObject = class
+		procedure DoThis_1;
+	end;
+	THelper1 = class helper for TMyObject
+		procedure DoThis_2;
+	end;
+	THelper2 = class helper for TMyObject
+		procedure DoThis_3;
+	end;
+
+procedure TMyObject.DoThis_1;
+begin
+end;
+
+procedure THelper1.DoThis_2;
+begin
+end;
+
+procedure THelper2.DoThis_3;
+begin
+end;
+
+var
+	obj: TMyObject;
+begin
+	obj := TMyObject.Create;
+	obj.DoThis_1;
+	obj.DoThis_2;
+	obj.DoThis_3;
+end.

tests/test/tmshlp10.pp

@@ -0,0 +1,38 @@
+{ %NORUN }
+
+{$mode objfpc}
+{$modeswitch multihelpers}
+
+program tmshlp10;
+
+type
+	TMyObject = class
+		procedure DoThis(param: integer); overload;
+	end;
+	THelper1 = class helper for TMyObject
+		procedure DoThis(param: string); overload;
+	end;
+	THelper2 = class helper for TMyObject
+		procedure DoThis(param: pointer); overload;
+	end;
+
+procedure TMyObject.DoThis(param: integer);
+begin
+end;
+
+procedure THelper1.DoThis(param: string);
+begin
+end;
+
+procedure THelper2.DoThis(param: pointer);
+begin
+end;
+
+var
+	obj: TMyObject;
+begin
+	obj := TMyObject.Create;
+	obj.DoThis(1);
+	obj.DoThis('string');
+	obj.DoThis(nil);
+end.

tests/test/tmshlp11.pp

@@ -0,0 +1,40 @@
+{ %NORUN }
+
+{$mode objfpc}
+{$modeswitch multihelpers}
+
+program tmshlp11;
+
+type
+	TMyObject = class
+		class function Create1: TMyObject;
+	end;
+	THelper1 = class helper for TMyObject
+		class function Create2: TMyObject;
+	end;
+	THelper2 = class helper for TMyObject
+		class function Create3: TMyObject;
+	end;
+
+class function TMyObject.Create1: TMyObject;
+begin
+	result := TMyObject.Create;
+end;
+
+class function THelper1.Create2: TMyObject;
+begin
+	result := TMyObject.Create;
+end;
+
+class function THelper2.Create3: TMyObject;
+begin
+	result := TMyObject.Create;
+end;
+
+var
+	obj: TMyObject;
+begin
+	obj := TMyObject.Create1;
+	obj := TMyObject.Create2;
+	obj := TMyObject.Create3;
+end.

tests/test/tmshlp12.pp

@@ -0,0 +1,43 @@
+{$mode objfpc}
+{$modeswitch multihelpers}
+
+program tmshlp12;
+
+type
+	TMyObject = class
+		procedure DoThis;
+	end;
+	THelper1 = class helper for TMyObject
+		procedure DoThis;
+	end;
+	THelper2 = class helper for TMyObject
+		procedure DoThis;
+	end;
+
+var
+	Res: integer;
+
+procedure TMyObject.DoThis;
+begin
+	Res := 1;
+end;
+
+procedure THelper1.DoThis;
+begin
+	Res := 2;
+end;
+
+procedure THelper2.DoThis;
+begin
+	Res := 3;
+end;
+
+var
+	obj: TMyObject;
+begin
+	obj := TMyObject.Create;
+	obj.DoThis;
+	writeln(Res);
+	if Res <> 3 then
+		Halt(1);
+end.

tests/test/tmshlp13.pp

@@ -0,0 +1,19 @@
+{ %NORUN }
+
+{$mode objfpc}
+{$modeswitch multihelpers}
+
+program tmshlp13;
+
+type
+	THelper1 = class helper for TObject
+		class var field1: integer;
+	end;
+	THelper2 = class helper for TObject
+		class var field2: integer;
+	end;
+
+begin
+	TObject.field1 := 1;
+	TObject.field2 := 2;
+end.

tests/test/tmshlp14.pp

@@ -0,0 +1,21 @@
+{ %NORUN }
+
+{$mode objfpc}
+{$modeswitch multihelpers}
+
+program tmshlp14;
+
+type
+	THelper1 = class helper for TObject
+		type TInteger = integer;
+	end;
+	THelper2 = class helper for TObject
+		type TString = string;
+	end;
+
+var
+	obj: TObject;
+begin
+	writeln(sizeof(TObject.TInteger));
+	writeln(sizeof(TObject.TString));
+end.

tests/test/tmshlp15.pp

@@ -0,0 +1,14 @@
+program tmshlp15;
+
+{$mode objfpc}
+{$modeswitch multihelpers}
+
+uses
+  umshlp15a, umshlp15b;
+
+var
+  o: TObject;
+begin
+  if o.Test <> 2 then
+    Halt(1);
+end.

tests/test/tmshlp16.pp

@@ -0,0 +1,14 @@
+program tmshlp16;
+
+{$mode objfpc}
+{$modeswitch multihelpers}
+
+uses
+  umshlp15b, umshlp15a;
+
+var
+  o: TObject;
+begin
+  if o.Test <> 1 then
+    Halt(1);
+end.

tests/test/tmshlp2.pp

@@ -0,0 +1,38 @@
+{ %NORUN }
+
+{$mode objfpc}
+{$modeswitch advancedrecords}
+{$modeswitch multihelpers}
+
+program tmshlp2;
+
+type
+	TMyObject = record
+		procedure DoThis_1;
+	end;
+	THelper1 = record helper for TMyObject
+		procedure DoThis_2;
+	end;
+	THelper2 = record helper for TMyObject
+		procedure DoThis_3;
+	end;
+
+procedure TMyObject.DoThis_1;
+begin
+end;
+
+procedure THelper1.DoThis_2;
+begin
+end;
+
+procedure THelper2.DoThis_3;
+begin
+end;
+
+var
+	obj: TMyObject;
+begin
+	obj.DoThis_1;
+	obj.DoThis_2;
+	obj.DoThis_3;
+end.

tests/test/tmshlp3.pp

@@ -0,0 +1,32 @@
+{$mode objfpc}
+{$modeswitch typehelpers}
+{$modeswitch multihelpers}
+
+program tmshlp3;
+
+type
+	TStringHelper1 = type helper for String
+		function Length: integer;
+	end;
+
+function TStringHelper1.Length: integer;
+begin
+	result := System.Length(self);
+end;
+
+type
+	TStringHelper2 = type helper for string
+		function LengthSquared: integer;
+	end;
+
+function TStringHelper2.LengthSquared: integer;
+begin
+	result := self.Length * self.Length;
+end;
+
+var
+	s: string = 'abcd';
+begin
+	if (s.Length <> 4) or (s.LengthSquared <> 16 ) then
+		Halt(1);
+end.

tests/test/tmshlp4.pp

@@ -0,0 +1,50 @@
+{ %NORUN }
+
+{$mode objfpc}
+{$modeswitch multihelpers}
+
+program tmshlp4;
+
+type
+	TMyObject = class
+		procedure DoThis_1;
+	end;
+	THelperBase = class helper for TMyObject
+		procedure DoThis_4;
+	end;
+	THelper1 = class helper(THelperBase) for TMyObject
+		procedure DoThis_2;
+	end;
+	THelper2 = class helper(THelperBase) for TMyObject
+		procedure DoThis_3;
+	end;
+
+procedure THelperBase.DoThis_4;
+begin
+	writeln('DoThis_4');
+end;
+
+procedure TMyObject.DoThis_1;
+begin
+	writeln('DoThis_1');
+end;
+
+procedure THelper1.DoThis_2;
+begin
+	writeln('DoThis_2');
+end;
+
+procedure THelper2.DoThis_3;
+begin
+	writeln('DoThis_3');
+end;
+
+var
+	obj: TMyObject;
+begin
+	obj := TMyObject.Create;
+	obj.DoThis_1;
+	obj.DoThis_2;
+	obj.DoThis_3;
+	obj.DoThis_4;
+end.

tests/test/tmshlp5.pp

@@ -0,0 +1,37 @@
+{ %NORUN }
+
+{$mode objfpc}
+{$modeswitch multihelpers}
+
+program tmshlp5;
+
+type
+	TMyObject = class
+		constructor Create1;
+	end;
+	THelper1 = class helper for TMyObject
+		constructor Create2;
+	end;
+	THelper2 = class helper for TMyObject
+		constructor Create3;
+	end;
+
+constructor TMyObject.Create1;
+begin
+end;
+
+constructor THelper1.Create2;
+begin
+end;
+
+constructor THelper2.Create3;
+begin
+end;
+
+var
+	obj: TMyObject;
+begin
+	obj := TMyObject.Create1;
+	obj := TMyObject.Create2;
+	obj := TMyObject.Create3;
+end.

tests/test/tmshlp6.pp

@@ -0,0 +1,37 @@
+{ %NORUN }
+
+{$mode objfpc}
+{$modeswitch multihelpers}
+
+program tmshlp6;
+
+type
+	TMyObject = class
+		m_num: integer;
+		property num1: integer read m_num;
+	end;
+	THelperBase = class helper for TMyObject
+		function GetNum: integer;
+	end;
+	THelper1 = class helper(THelperBase) for TMyObject
+		property num2: integer read GetNum;
+	end;
+	THelper2 = class helper(THelperBase) for TMyObject
+		property num3: integer read GetNum;
+	end;
+
+function THelperBase.GetNum: integer;
+begin
+	result := m_num;
+end;
+
+var
+	obj: TMyObject;
+	num: integer;
+begin
+	obj := TMyObject.Create;
+	// 2^3
+	obj.m_num := 2;
+	num := obj.num1 * obj.num2 * obj.num3;
+	writeln(num);
+end.

tests/test/tmshlp7.pp

@@ -0,0 +1,38 @@
+{ %NORUN }
+
+{$mode delphi}
+{$modeswitch multihelpers}
+
+program tmshlp7;
+
+type
+	TMyObject = class
+		procedure DoThis_1;
+	end;
+	THelper1 = class helper for TMyObject
+		procedure DoThis_2;
+	end;
+	THelper2 = class helper for TMyObject
+		procedure DoThis_3;
+	end;
+
+procedure TMyObject.DoThis_1;
+begin
+end;
+
+procedure THelper1.DoThis_2;
+begin
+end;
+
+procedure THelper2.DoThis_3;
+begin
+end;
+
+var
+	obj: TMyObject;
+begin
+	obj := TMyObject.Create;
+	obj.DoThis_1;
+	obj.DoThis_2;
+	obj.DoThis_3;
+end.

tests/test/tmshlp8.pp

@@ -0,0 +1,36 @@
+{ %NORUN }
+
+{$mode objfpc}
+{$modeswitch typehelpers}
+{$modeswitch multihelpers}
+
+program tmshlp8;
+uses
+	umshlp1;
+
+type
+	TClassHelper = class helper for TObject
+		procedure DoThis;
+	end;
+	TStringHelper = type helper for String
+		function Length: integer;
+	end;
+
+procedure TClassHelper.DoThis;
+begin
+	DoThisExt;
+end;
+
+function TStringHelper.Length: integer;
+begin
+	result := LengthExt;
+end;
+
+var
+	obj: TObject;
+	str: string;
+begin
+	obj := TObject.Create;
+	obj.DoThis;
+	writeln(str.Length + str.LengthTimesTwo);
+end.

tests/test/tmshlp9.pp

@@ -0,0 +1,38 @@
+{ %NORUN }
+
+{$mode objfpc}
+{$modeswitch multihelpers}
+
+program tmshlp9;
+
+type
+	TMyObject = class
+		procedure DoThis_1;
+	end;	
+	THelper1 = class helper for TMyObject
+		procedure DoThis_2;
+	end;
+	THelper2 = class helper for TMyObject
+		procedure DoThis_3;
+	end;
+
+procedure TMyObject.DoThis_1;
+begin
+end;
+
+procedure THelper1.DoThis_2;
+begin
+	DoThis_1;
+end;
+
+procedure THelper2.DoThis_3;
+begin
+	DoThis_2;
+end;
+
+var
+	obj: TMyObject;
+begin
+	obj := TMyObject.Create;
+	obj.DoThis_3;
+end.

tests/test/umshlp1.pp

@@ -0,0 +1,35 @@
+{$mode objfpc}
+{$modeswitch advancedrecords}
+{$modeswitch typehelpers}
+
+unit umshlp1;
+interface
+
+type
+	TExtClassHelper = class helper for TObject
+		procedure DoThisExt;
+	end;
+	TExtStringHelper = type helper for String
+		function LengthExt: integer;
+	end;
+	TExtStringHelperMore = type helper for String
+		function LengthTimesTwo: integer;
+	end;
+
+implementation
+	
+procedure TExtClassHelper.DoThisExt;
+begin	
+end;
+
+function TExtStringHelper.LengthExt: integer;
+begin
+	result := System.Length(self);
+end;
+
+function TExtStringHelperMore.LengthTimesTwo: integer;
+begin
+	result := System.Length(self) * 2;
+end;
+
+end.

tests/test/umshlp15a.pp

@@ -0,0 +1,19 @@
+unit umshlp15a;
+
+{$mode objfpc}
+
+interface
+
+type
+  THelperA = class helper for TObject
+    function Test: LongInt;
+  end;
+
+implementation
+
+function THelperA.Test: LongInt;
+begin
+  Result := 1;
+end;
+
+end.

tests/test/umshlp15b.pp

@@ -0,0 +1,19 @@
+unit umshlp15b;
+
+{$mode objfpc}
+
+interface
+
+type
+  THelperB = class helper for TObject
+    function Test: LongInt;
+  end;
+
+implementation
+
+function THelperB.Test: LongInt;
+begin
+  Result := 2;
+end;
+
+end.