View Issue Details

IDProjectCategoryView StatusLast Update
0035159FPCPatchpublic2019-05-12 23:47
ReporterRyan JosephAssigned ToSven Barth 
PrioritynormalSeverityminorReproducibilityN/A
Status closedResolutionfixed 
Product Version3.3.1Product Build 
Target VersionFixed in Version3.3.1 
Summary0035159: Patch for multi-helpers
DescriptionPatch to include {$modeswitch multihelpers} which allows more than one helper per scope. Full source at https://github.com/genericptr/freepascal/tree/helperscope.
Additional InformationI made the patch using "git format-patch master --stdout > mypatch.patch" but I was not able to figure out how to extract the tests into another patch or combine the commit history.

If you need me to use a different method please give me instructions or you should be able to get what you need from the source at GitHub.
TagsNo tags attached.
Fixed in Revision42026
FPCOldBugId
FPCTarget-
Attached Files
  • patch.diff (88,644 bytes)
    From fbf8f8df8af5d1b41f17152213a69fe657b1ae33 Mon Sep 17 00:00:00 2001
    From: Ryan Joseph <genericptr@gmail.com>
    Date: Wed, 21 Nov 2018 14:14:14 +0700
    Subject: [PATCH 01/12] first draft (no overload support)
    
    ---
     .gitignore               |   8 ++
     compiler/globtype.pas    |   6 +-
     compiler/ncal.pas        |   2 +
     compiler/pexpr.pas       |   3 +
     compiler/ryan_ppcx64.lpi |  77 +++++++++++++++++
     compiler/symtable.pas    | 179 ++++++++++++++++++++++++++-------------
     6 files changed, 215 insertions(+), 60 deletions(-)
     create mode 100644 .gitignore
     create mode 100644 compiler/ryan_ppcx64.lpi
    
    diff --git a/.gitignore b/.gitignore
    new file mode 100644
    index 0000000000..5f32ec99e7
    --- /dev/null
    +++ b/.gitignore
    @@ -0,0 +1,8 @@
    +# Ignore everything
    +*
    +
    +# But not these files...
    +!.gitignore
    +!.pas
    +!.pp
    +!ryan_*.lpi
    \ No newline at end of file
    diff --git a/compiler/globtype.pas b/compiler/globtype.pas
    index 7d23464d57..f154532a5f 100644
    --- a/compiler/globtype.pas
    +++ b/compiler/globtype.pas
    @@ -446,7 +446,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_multiscope_helpers   { ObjFPC mode only - helpers can appear in multiple scopes simultaneously }
            );
            tmodeswitches = set of tmodeswitch;
     
    @@ -635,7 +636,8 @@ interface
              'ISOIO',
              'ISOPROGRAMPARAS',
              'ISOMOD',
    -         'ARRAYOPERATORS'
    +         'ARRAYOPERATORS',
    +         'MULTISCOPEHELPERS'
              );
     
     
    diff --git a/compiler/ncal.pas b/compiler/ncal.pas
    index 0984293d8b..22a1e4d4c5 100644
    --- a/compiler/ncal.pas
    +++ b/compiler/ncal.pas
    @@ -3599,6 +3599,8 @@ implementation
                        ignorevisibility:=(nf_isproperty in flags) or
                                          ((m_delphi in current_settings.modeswitches) and (cnf_anon_inherited in callnodeflags)) or
                                          (cnf_ignore_visibility in callnodeflags);
    +                   if symtableprocentry.realname = 'DoThis' then
    +                   writeln(symtableprocentry.realname);                  
                        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]=[],cnf_anon_inherited in callnodeflags,spezcontext);
    diff --git a/compiler/pexpr.pas b/compiler/pexpr.pas
    index bc0606ed4b..e92fed78cb 100644
    --- a/compiler/pexpr.pas
    +++ b/compiler/pexpr.pas
    @@ -1099,6 +1099,9 @@ implementation
                    begin
                      if not (st.symtabletype in [ObjectSymtable,recordsymtable]) then
                        internalerror(200310031);
    +                 // note: ryan
    +                 // does obj have an overload for the params? if not
    +                 // search helpers with param and change obj
                      p1:=ccallnode.create(para,tprocsym(sym),obj.symtable,p1,callflags,spezcontext);
                    end
                  else
    diff --git a/compiler/ryan_ppcx64.lpi b/compiler/ryan_ppcx64.lpi
    new file mode 100644
    index 0000000000..6a6220e7d5
    --- /dev/null
    +++ b/compiler/ryan_ppcx64.lpi
    @@ -0,0 +1,77 @@
    +<?xml version="1.0"?>
    +<CONFIG>
    +  <ProjectOptions>
    +    <Version Value="9"/>
    +    <PathDelim Value="\"/>
    +    <General>
    +      <Flags>
    +        <MainUnitHasUsesSectionForAllUnits Value="False"/>
    +        <MainUnitHasCreateFormStatements Value="False"/>
    +        <MainUnitHasTitleStatement Value="False"/>
    +        <LRSInOutputDirectory Value="False"/>
    +      </Flags>
    +      <SessionStorage Value="InProjectDir"/>
    +      <MainUnit Value="0"/>
    +      <Title Value="ppcx64"/>
    +    </General>
    +    <BuildModes Count="1">
    +      <Item1 Name="default" Default="True"/>
    +    </BuildModes>
    +    <PublishOptions>
    +      <Version Value="2"/>
    +      <DestinationDirectory Value="$(TestDir)\publishedproject\"/>
    +      <IncludeFileFilter Value="*.(pas|pp|inc|lfm|lpr|lrs|lpi|lpk|sh|xml)"/>
    +      <ExcludeFileFilter Value="*.(bak|ppu|ppw|o|so);*~;backup"/>
    +    </PublishOptions>
    +    <RunParams>
    +      <local>
    +        <FormatVersion Value="1"/>
    +        <LaunchingApplication PathPlusParams="/usr/X11R6/bin/xterm -T 'Lazarus Run Output' -e $(LazarusDir)/tools/runwait.sh $(TargetCmdLine)"/>
    +      </local>
    +    </RunParams>
    +    <Units Count="2">
    +      <Unit0>
    +        <Filename Value="pp.pas"/>
    +        <IsPartOfProject Value="True"/>
    +        <UnitName Value="pp"/>
    +      </Unit0>
    +      <Unit1>
    +        <Filename Value="x86\aasmcpu.pas"/>
    +        <IsPartOfProject Value="True"/>
    +        <UnitName Value="aasmcpu"/>
    +      </Unit1>
    +    </Units>
    +  </ProjectOptions>
    +  <CompilerOptions>
    +    <Version Value="11"/>
    +    <PathDelim Value="\"/>
    +    <Target>
    +      <Filename Value="x86_64\pp"/>
    +    </Target>
    +    <SearchPaths>
    +      <IncludeFiles Value="x86_64"/>
    +      <OtherUnitFiles Value="x86_64;x86;systems"/>
    +      <UnitOutputDirectory Value="x86_64\lazbuild"/>
    +    </SearchPaths>
    +    <Parsing>
    +      <SyntaxOptions>
    +        <CStyleOperator Value="False"/>
    +        <AllowLabel Value="False"/>
    +        <CPPInline Value="False"/>
    +        <UseAnsiStrings Value="False"/>
    +      </SyntaxOptions>
    +    </Parsing>
    +    <Other>
    +      <Verbosity>
    +        <ShowWarn Value="False"/>
    +        <ShowNotes Value="False"/>
    +        <ShowHints Value="False"/>
    +      </Verbosity>
    +      <ConfigFile>
    +        <StopAfterErrCount Value="50"/>
    +      </ConfigFile>
    +      <CustomOptions Value="-dx86_64 -gw -godwarfcpp"/>
    +      <CompilerPath Value="$(CompPath)"/>
    +    </Other>
    +  </CompilerOptions>
    +</CONFIG>
    diff --git a/compiler/symtable.pas b/compiler/symtable.pas
    index 796b2d6736..452d1a8775 100644
    --- a/compiler/symtable.pas
    +++ b/compiler/symtable.pas
    @@ -3971,6 +3971,100 @@ implementation
               end;
           end;
     
    +    // note: ryan
    +    function search_objectdef(const s: string;classh : tobjectdef;contextclassh : tabstractrecorddef;out srsym: tsym; out srsymtable: tsymtable): boolean;
    +      var
    +        hashedid  : THashedIDString;
    +        pdef: tprocdef;
    +        i: integer;
    +      begin
    +        hashedid.id:=s;
    +        result:=false;
    +        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 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;
    +        { 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 ((pd.typ in [recorddef,objectdef]) and
    +            (
    +              not assigned(tabstractrecorddef(pd).objrealname) or
    +              (tabstractrecorddef(pd).objrealname^='')
    +            )
    +           ) or
    +           not assigned(pd.typesym) 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:=generate_objectpascal_helper_key(pd);
    +        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}i]);
    +              result:=(odef.owner.symtabletype in [staticsymtable,globalsymtable]) or
    +                      is_visible_for_object(tobjectdef(list[i]).typesym,contextclassh);
    +              if result then
    +                result := search_objectdef(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;
    @@ -4019,72 +4113,41 @@ 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
    -          exit;
    -
    -        hashedid.id:=s;
    -
    -        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;
    -                        { 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;
    +        // note: ryan
    +        if m_multiscope_helpers in current_settings.modeswitches then
    +          begin
    +            result := search_best_objectpascal_helper(s,pd,contextclassh,srsym,srsymtable);
    +          end
    +        else
    +          begin
    +            if search_last_objectpascal_helper(pd,contextclassh,classh) and
    +               search_objectdef(s,classh,contextclassh,srsym,srsymtable) then
    +                result:=true;
    +          end;
     
    -        srsym:=nil;
    -        srsymtable:=nil;
    +        if result then
    +          begin
    +            { 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 (srsym.typ = procsym) and
    +               assigned(current_procinfo) and
    +               (srsym.owner.symtabletype=staticsymtable) then
    +              include(current_procinfo.flags,pi_uses_static_symtable);
    +            addsymref(srsym);
    +          end
    +        else
    +          begin
    +            srsym:=nil;
    +            srsymtable:=nil;
    +          end;
           end;
     
         function search_objc_helper(pd : tobjectdef;const s : string; out srsym: tsym; out srsymtable: tsymtable):boolean;
    -- 
    2.17.2 (Apple Git-113)
    
    
    From 0d705f89ae57912a09c4cb5ea14bb33e14ecbe46 Mon Sep 17 00:00:00 2001
    From: Ryan Joseph <genericptr@gmail.com>
    Date: Wed, 21 Nov 2018 21:30:52 +0700
    Subject: [PATCH 02/12] first draft with proc overloads
    
    ---
     compiler/ncal.pas     |   2 -
     compiler/pexpr.pas    | 154 +++++++++++++++++++++++++++++++++++++++++-
     compiler/symtable.pas |   2 +-
     3 files changed, 152 insertions(+), 6 deletions(-)
    
    diff --git a/compiler/ncal.pas b/compiler/ncal.pas
    index 22a1e4d4c5..0984293d8b 100644
    --- a/compiler/ncal.pas
    +++ b/compiler/ncal.pas
    @@ -3599,8 +3599,6 @@ implementation
                        ignorevisibility:=(nf_isproperty in flags) or
                                          ((m_delphi in current_settings.modeswitches) and (cnf_anon_inherited in callnodeflags)) or
                                          (cnf_ignore_visibility in callnodeflags);
    -                   if symtableprocentry.realname = 'DoThis' then
    -                   writeln(symtableprocentry.realname);                  
                        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]=[],cnf_anon_inherited in callnodeflags,spezcontext);
    diff --git a/compiler/pexpr.pas b/compiler/pexpr.pas
    index e92fed78cb..d073617804 100644
    --- a/compiler/pexpr.pas
    +++ b/compiler/pexpr.pas
    @@ -76,7 +76,7 @@ implementation
            fmodule,ppu,
            { pass 1 }
            pass_1,
    -       nmat,nadd,nmem,nset,ncnv,ninl,ncon,nld,nflw,nbas,nutils,
    +       nmat,nadd,nmem,nset,ncnv,ninl,ncon,nld,nflw,nbas,nutils,htypechk,
            { parser }
            scanner,
            pbase,pinline,ptype,pgenutil,procinfo,cpuinfo
    @@ -962,6 +962,147 @@ implementation
              end;
           end;
     
    +    // note: ryan
    +    function find_best_helper_candidate_for_proc(para:tnode;var procsym: tprocsym;symtable: tsymtable;callnodeflags: tcallnodeflags;spezcontext: tspecializationcontext; var obj: tabstractrecorddef): boolean;
    +      function find_best_candidate(para:tnode;var procsym: tprocsym;structh: tabstractrecorddef;callnodeflags: tcallnodeflags;spezcontext: tspecializationcontext): boolean;
    +        var
    +          candidates : tcallcandidates;
    +          ignorevisibility : boolean;
    +          bestpd:tabstractprocdef;
    +          srsym:tsym;
    +          srsymtable:TSymtable;
    +        begin
    +          result := false;
    +          // todo: in defaultprops I think we messed up by not using search_struct_member_no_helper
    +          // so overloads are probably broken in classes
    +
    +          { procsym is not from the correct def so we need to search again for it }
    +          if (structh.typ = objectdef) and not searchsym_in_helper(tobjectdef(structh),tobjectdef(structh),upper(procsym.realname),srsym,srsymtable,[ssf_no_addsymref]) {and (srsym.typ = procsym) }then
    +            exit;
    +
    +          { ignore possible private for properties or in delphi mode for anon. inherited (FK) }
    +          ignorevisibility:=((m_delphi in current_settings.modeswitches) and (cnf_anon_inherited in callnodeflags)) or
    +                            (cnf_ignore_visibility in callnodeflags);
    +          candidates:=tcallcandidates.create({procsym,structh.symtable}tprocsym(srsym),srsymtable,para,ignorevisibility,
    +            {allowdefaultparas}true,cnf_objc_id_call in callnodeflags,cnf_unit_specified in callnodeflags,
    +            {callnodeflags*[cnf_anon_inherited,cnf_inherited]=[]}false,cnf_anon_inherited in callnodeflags,spezcontext);
    +          if candidates.count > 0 then
    +            begin
    +              candidates.get_information;
    +              result := candidates.choose_best(bestpd, false) > 0;
    +              if result then
    +                procsym := tprocsym(srsym);
    +            end;
    +          candidates.free;
    +        end;
    +      var
    +        propsym: tpropertysym;
    +        i: integer;
    +        structh: tabstractrecorddef;
    +        pd:tdef;
    +        st:tsymtable;
    +        list: TFPObjectList;
    +        s:string;
    +        odef:tobjectdef;
    +      begin
    +        result:=false;
    +        // note: TEMPORARY
    +        pd := obj;
    +        { 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 ((pd.typ in [recorddef,objectdef]) and
    +            (
    +              not assigned(tabstractrecorddef(pd).objrealname) or
    +              (tabstractrecorddef(pd).objrealname^='')
    +            )
    +           ) or
    +           not assigned(pd.typesym) 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:=generate_objectpascal_helper_key(pd);
    +        list:=TFPObjectList(current_module.extendeddefs.Find(s));
    +        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}obj); // note: what is context here?
    +              if result then
    +                begin
    +                  result := find_best_candidate(para,procsym,odef,callnodeflags,spezcontext);
    +                  if result then
    +                    obj := odef;
    +                end;
    +              dec(i);
    +            until result or (i<0);
    +          end;
    +      end;
    +
    +(*
    +    function find_best_candidate_for_operator(p1, p2: tnode; optoken: ttoken; access: tpropaccesslisttypes; var obj: tabstractrecorddef; out propsym: tpropertysym): boolean;
    +      function find_operator(fromdef: tabstractrecorddef; optoken: ttoken; right:tnode): boolean;
    +        var
    +          candidates : tcallcandidates;
    +          ppn : tcallparanode;
    +          bestpd: tabstractprocdef;
    +        begin
    +          result := false;
    +          // todo: _ASSIGNMENT, _OP_EXPLICIT aren't searchable!
    +          ppn:=ccallparanode.create(right.getcopy,ccallparanode.create(ttypenode.create(fromdef),nil));
    +          ppn.get_paratype;
    +          candidates:=tcallcandidates.create_operator(optoken,ppn);
    +          if candidates.count > 0 then
    +            begin
    +              candidates.get_information;
    +              result := candidates.choose_best(bestpd,false) > 0;
    +            end;
    +          ppn.free;
    +          candidates.free;
    +        end;
    +      var
    +        i: integer;
    +        structh: tabstractrecorddef;
    +      begin
    +        result := false;
    +        { search base first and if there's a matching operator then stop }
    +        if find_operator(obj, optoken, p2) then
    +          exit;
    +        { search default properties }
    +        for i := high(obj.default_props) downto 0 do
    +          begin
    +            propsym := tpropertysym(obj.default_props[i]);
    +            { property is not default }
    +            if not (ppo_defaultproperty in propsym.propoptions) then
    +              continue;
    +            { property doesn't have required access }
    +            if propsym.propaccesslist[access].firstsym = nil then
    +              continue;
    +            structh := tabstractrecorddef(propsym.propdef);
    +            if (structh.typ in [recorddef, objectdef]) and find_operator(structh, optoken, p2) then
    +              begin
    +                obj := structh;
    +                exit(true);
    +              end;
    +            { compare property def with right node result def }
    +            if (compare_defs(structh,p2.resultdef,p1.nodetype)>=te_convert_l6) then
    +              begin
    +                obj := structh;
    +                exit(true);
    +              end;
    +          end;
    +      end;
    +*)
     
         { reads the parameter for a subroutine call }
         procedure do_proc_call(sym:tsym;st:TSymtable;obj:tabstractrecorddef;getaddr:boolean;var again : boolean;var p1:tnode;callflags:tcallnodeflags;spezcontext:tspecializationcontext);
    @@ -1100,8 +1241,15 @@ implementation
                      if not (st.symtabletype in [ObjectSymtable,recordsymtable]) then
                        internalerror(200310031);
                      // note: ryan
    -                 // does obj have an overload for the params? if not
    -                 // search helpers with param and change obj
    +                 { there may be an overloaded method which matches the 
    +                   params which are available now. }
    +                 if (m_multiscope_helpers in current_settings.modeswitches) then
    +                   begin
    +                     if assigned(para) and not assigned(para.resultdef) then
    +                       tcallparanode(para).get_paratype;
    +                     if find_best_helper_candidate_for_proc(para,tprocsym(sym),obj.symtable,callflags,spezcontext,obj) then
    +                       ;//writeln('find_best_helper_candidate_for_proc:',obj.typesym.realname);
    +                   end;
                      p1:=ccallnode.create(para,tprocsym(sym),obj.symtable,p1,callflags,spezcontext);
                    end
                  else
    diff --git a/compiler/symtable.pas b/compiler/symtable.pas
    index 452d1a8775..10f6f18ae7 100644
    --- a/compiler/symtable.pas
    +++ b/compiler/symtable.pas
    @@ -4055,7 +4055,7 @@ implementation
               begin
                 i:=list.count-1;
                 repeat
    -              odef:=tobjectdef(list[{list.count-1}i]);
    +              odef:=tobjectdef(list[i]);
                   result:=(odef.owner.symtabletype in [staticsymtable,globalsymtable]) or
                           is_visible_for_object(tobjectdef(list[i]).typesym,contextclassh);
                   if result then
    -- 
    2.17.2 (Apple Git-113)
    
    
    From 3d116b72454eaff3b828bb6f3e75d92834c31512 Mon Sep 17 00:00:00 2001
    From: Ryan Joseph <genericptr@gmail.com>
    Date: Thu, 22 Nov 2018 11:02:45 +0700
    Subject: [PATCH 03/12] fixed bad design
    
    ---
     compiler/htypechk.pas | 215 ++++++++++++++++++++++++++----------------
     compiler/pexpr.pas    | 155 +-----------------------------
     compiler/symtable.pas |  66 ++++++-------
     3 files changed, 161 insertions(+), 275 deletions(-)
    
    diff --git a/compiler/htypechk.pas b/compiler/htypechk.pas
    index 07c035dc26..5a5b2f6819 100644
    --- a/compiler/htypechk.pas
    +++ b/compiler/htypechk.pas
    @@ -152,22 +152,22 @@ interface
         function token2managementoperator(optoken:ttoken):tmanagementoperator;
     
         { check operator args and result type }
    -
    -    type
    -      toverload_check_flag = (
    -        ocf_check_non_overloadable, { also check operators that are (currently) considered as
    -                                      not overloadable (e.g. the "+" operator for dynamic arrays
    -                                      if modeswitch arrayoperators is active) }
    -        ocf_check_only              { only check whether the operator is overloaded, but don't
    -                                      modify the passed in node (return true if the operator is
    -                                      overloaded, false otherwise) }
    -      );
    -      toverload_check_flags = set of toverload_check_flag;
    -
    +
    +    type
    +      toverload_check_flag = (
    +        ocf_check_non_overloadable, { also check operators that are (currently) considered as
    +                                      not overloadable (e.g. the "+" operator for dynamic arrays
    +                                      if modeswitch arrayoperators is active) }
    +        ocf_check_only              { only check whether the operator is overloaded, but don't
    +                                      modify the passed in node (return true if the operator is
    +                                      overloaded, false otherwise) }
    +      );
    +      toverload_check_flags = set of toverload_check_flag;
    +
         function isbinaryoperatoroverloadable(treetyp:tnodetype;ld:tdef;lt:tnodetype;rd:tdef;rt:tnodetype) : boolean;
         function isoperatoracceptable(pf : tprocdef; optoken : ttoken) : boolean;
    -    function isunaryoverloaded(var t : tnode;ocf:toverload_check_flags) : boolean;
    -    function isbinaryoverloaded(var t : tnode;ocf:toverload_check_flags) : boolean;
    +    function isunaryoverloaded(var t : tnode;ocf:toverload_check_flags) : boolean;
    +    function isbinaryoverloaded(var t : tnode;ocf:toverload_check_flags) : boolean;
     
         { Register Allocation }
         procedure make_not_regable(p : tnode; how: tregableinfoflags);
    @@ -515,9 +515,9 @@ implementation
                         end;
     
                      { <dyn. array> + <dyn. array> is handled by the compiler }
    -                 if (m_array_operators in current_settings.modeswitches) and
    -                     (treetyp=addn) and
    -                     (is_dynamic_array(ld) or is_dynamic_array(rd)) then
    +                 if (m_array_operators in current_settings.modeswitches) and
    +                     (treetyp=addn) and
    +                     (is_dynamic_array(ld) or is_dynamic_array(rd)) then
                         begin
                           allowed:=false;
                           exit;
    @@ -720,7 +720,7 @@ implementation
           end;
     
     
    -    function isunaryoverloaded(var t : tnode;ocf:toverload_check_flags) : boolean;
    +    function isunaryoverloaded(var t : tnode;ocf:toverload_check_flags) : boolean;
           var
             ld      : tdef;
             optoken : ttoken;
    @@ -742,11 +742,11 @@ implementation
             else
               inlinenumber:=in_none;
     
    -        if not (ocf_check_non_overloadable in ocf) and not isunaryoperatoroverloadable(t.nodetype,inlinenumber,ld) then
    +        if not (ocf_check_non_overloadable in ocf) and not isunaryoperatoroverloadable(t.nodetype,inlinenumber,ld) then
               exit;
     
             { operator overload is possible }
    -        result:=not (ocf_check_only in ocf);
    +        result:=not (ocf_check_only in ocf);
     
             optoken:=NOTOKEN;
             case t.nodetype of
    @@ -766,11 +766,11 @@ implementation
             end;
             if (optoken=NOTOKEN) then
               begin
    -            if not (ocf_check_only in ocf) then
    -              begin
    -                CGMessage(parser_e_operator_not_overloaded);
    -                t:=cnothingnode.create;
    -              end;
    +            if not (ocf_check_only in ocf) then
    +              begin
    +                CGMessage(parser_e_operator_not_overloaded);
    +                t:=cnothingnode.create;
    +              end;
                 exit;
               end;
     
    @@ -790,11 +790,11 @@ implementation
               begin
                 candidates.free;
                 ppn.free;
    -            if not (ocf_check_only in ocf) then
    -              begin
    -                CGMessage2(parser_e_operator_not_overloaded_2,ld.typename,arraytokeninfo[optoken].str);
    -                t:=cnothingnode.create;
    -              end;
    +            if not (ocf_check_only in ocf) then
    +              begin
    +                CGMessage2(parser_e_operator_not_overloaded_2,ld.typename,arraytokeninfo[optoken].str);
    +                t:=cnothingnode.create;
    +              end;
                 exit;
               end;
     
    @@ -811,16 +811,16 @@ implementation
               begin
                 candidates.free;
                 ppn.free;
    -            if not (ocf_check_only in ocf) then
    -              begin
    -                CGMessage2(parser_e_operator_not_overloaded_2,ld.typename,arraytokeninfo[optoken].str);
    -                t:=cnothingnode.create;
    -              end;
    +            if not (ocf_check_only in ocf) then
    +              begin
    +                CGMessage2(parser_e_operator_not_overloaded_2,ld.typename,arraytokeninfo[optoken].str);
    +                t:=cnothingnode.create;
    +              end;
                 exit;
               end;
     
             { Multiple candidates left? }
    -        if (cand_cnt>1) and not (ocf_check_only in ocf) then
    +        if (cand_cnt>1) and not (ocf_check_only in ocf) then
               begin
                 CGMessage(type_e_cant_choose_overload_function);
     {$ifdef EXTDEBUG}
    @@ -833,13 +833,13 @@ implementation
               end;
             candidates.free;
     
    -        if ocf_check_only in ocf then
    -          begin
    -            ppn.free;
    -            result:=true;
    -            exit;
    -          end;
    -
    +        if ocf_check_only in ocf then
    +          begin
    +            ppn.free;
    +            result:=true;
    +            exit;
    +          end;
    +
             addsymref(operpd.procsym);
     
             { the nil as symtable signs firstcalln that this is
    @@ -852,7 +852,7 @@ implementation
           end;
     
     
    -    function isbinaryoverloaded(var t : tnode;ocf:toverload_check_flags) : boolean;
    +    function isbinaryoverloaded(var t : tnode;ocf:toverload_check_flags) : boolean;
           var
             rd,ld   : tdef;
             optoken : ttoken;
    @@ -945,14 +945,14 @@ implementation
             { load easier access variables }
             ld:=tbinarynode(t).left.resultdef;
             rd:=tbinarynode(t).right.resultdef;
    -        if not (ocf_check_non_overloadable in ocf) and
    -            not isbinaryoperatoroverloadable(t.nodetype,ld,tbinarynode(t).left.nodetype,rd,tbinarynode(t).right.nodetype) then
    +        if not (ocf_check_non_overloadable in ocf) and
    +            not isbinaryoperatoroverloadable(t.nodetype,ld,tbinarynode(t).left.nodetype,rd,tbinarynode(t).right.nodetype) then
               exit;
     
             { operator overload is possible }
    -        { if we only check for the existance of the overload, then we assume that
    -          it is not overloaded }
    -        result:=not (ocf_check_only in ocf);
    +        { if we only check for the existance of the overload, then we assume that
    +          it is not overloaded }
    +        result:=not (ocf_check_only in ocf);
     
             case t.nodetype of
                equaln:
    @@ -997,19 +997,19 @@ implementation
                  optoken:=_OP_IN;
                else
                  begin
    -               if not (ocf_check_only in ocf) then
    -                 begin
    -                   CGMessage(parser_e_operator_not_overloaded);
    -                   t:=cnothingnode.create;
    -                 end;
    +               if not (ocf_check_only in ocf) then
    +                 begin
    +                   CGMessage(parser_e_operator_not_overloaded);
    +                   t:=cnothingnode.create;
    +                 end;
                    exit;
                  end;
             end;
     
    -        cand_cnt:=search_operator(optoken,(optoken<>_NE) and not (ocf_check_only in ocf));
    +        cand_cnt:=search_operator(optoken,(optoken<>_NE) and not (ocf_check_only in ocf));
     
             { no operator found for "<>" then search for "=" operator }
    -        if (cand_cnt=0) and (optoken=_NE) and not (ocf_check_only in ocf) then
    +        if (cand_cnt=0) and (optoken=_NE) and not (ocf_check_only in ocf) then
               begin
                 ppn.free;
                 ppn:=nil;
    @@ -1021,15 +1021,15 @@ implementation
             if (cand_cnt=0) then
               begin
                 ppn.free;
    -            if not (ocf_check_only in ocf) then
    -              t:=cnothingnode.create;
    -            exit;
    -          end;
    -
    -        if ocf_check_only in ocf then
    -          begin
    -            ppn.free;
    -            result:=true;
    +            if not (ocf_check_only in ocf) then
    +              t:=cnothingnode.create;
    +            exit;
    +          end;
    +
    +        if ocf_check_only in ocf then
    +          begin
    +            ppn.free;
    +            result:=true;
                 exit;
               end;
     
    @@ -2234,6 +2234,33 @@ implementation
                     ProcdefOverloadList.Add(pd);
                 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;
    @@ -2242,6 +2269,8 @@ implementation
             foundanything : boolean;
             extendeddef : tabstractrecorddef;
             helperdef  : tobjectdef;
    +        helperlist : TFPObjectList;
    +        i : integer;
           begin
             if FOperator=NOTOKEN then
               hashedid.id:=FProcsym.name
    @@ -2261,27 +2290,47 @@ implementation
                    )
                    and searchhelpers then
                  begin
    -               if search_last_objectpascal_helper(structdef,nil,helperdef) then
    +               // note: ryan
    +               if (m_multiscope_helpers in current_settings.modeswitches) then
                      begin
    -                   srsym:=nil;
    -                   while assigned(helperdef) do
    +                   helperlist:=get_objectpascal_helpers(structdef);
    +                   if assigned(helperlist) and (helperlist.count>0) then
                          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;
    +                       i:=helperlist.count-1;
    +                       repeat
    +                         helperdef:=tobjectdef(helperlist[i]);
    +                         if (helperdef.owner.symtabletype in [staticsymtable,globalsymtable]) or
    +                            is_visible_for_object(helperdef.typesym,{structdef}helperdef) then
    +                              if processhelper(hashedid,helperdef) then
    +                                exit;
    +                         dec(i);
    +                       until (i<0);
                          end;
    -                   if not hasoverload and assigned(srsym) then
    -                     exit;
    -                 end;
    +                 end
    +               else if search_last_objectpascal_helper(structdef,nil,helperdef) and processhelper(hashedid,helperdef) then
    +                  exit;
    +
    +               //if processhelper 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),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;
    +               //  end;
                  end;
                { now search in the type itself }
                srsym:=tsym(structdef.symtable.FindWithHash(hashedid));
    diff --git a/compiler/pexpr.pas b/compiler/pexpr.pas
    index d073617804..f14dbe8a3f 100644
    --- a/compiler/pexpr.pas
    +++ b/compiler/pexpr.pas
    @@ -962,148 +962,6 @@ implementation
              end;
           end;
     
    -    // note: ryan
    -    function find_best_helper_candidate_for_proc(para:tnode;var procsym: tprocsym;symtable: tsymtable;callnodeflags: tcallnodeflags;spezcontext: tspecializationcontext; var obj: tabstractrecorddef): boolean;
    -      function find_best_candidate(para:tnode;var procsym: tprocsym;structh: tabstractrecorddef;callnodeflags: tcallnodeflags;spezcontext: tspecializationcontext): boolean;
    -        var
    -          candidates : tcallcandidates;
    -          ignorevisibility : boolean;
    -          bestpd:tabstractprocdef;
    -          srsym:tsym;
    -          srsymtable:TSymtable;
    -        begin
    -          result := false;
    -          // todo: in defaultprops I think we messed up by not using search_struct_member_no_helper
    -          // so overloads are probably broken in classes
    -
    -          { procsym is not from the correct def so we need to search again for it }
    -          if (structh.typ = objectdef) and not searchsym_in_helper(tobjectdef(structh),tobjectdef(structh),upper(procsym.realname),srsym,srsymtable,[ssf_no_addsymref]) {and (srsym.typ = procsym) }then
    -            exit;
    -
    -          { ignore possible private for properties or in delphi mode for anon. inherited (FK) }
    -          ignorevisibility:=((m_delphi in current_settings.modeswitches) and (cnf_anon_inherited in callnodeflags)) or
    -                            (cnf_ignore_visibility in callnodeflags);
    -          candidates:=tcallcandidates.create({procsym,structh.symtable}tprocsym(srsym),srsymtable,para,ignorevisibility,
    -            {allowdefaultparas}true,cnf_objc_id_call in callnodeflags,cnf_unit_specified in callnodeflags,
    -            {callnodeflags*[cnf_anon_inherited,cnf_inherited]=[]}false,cnf_anon_inherited in callnodeflags,spezcontext);
    -          if candidates.count > 0 then
    -            begin
    -              candidates.get_information;
    -              result := candidates.choose_best(bestpd, false) > 0;
    -              if result then
    -                procsym := tprocsym(srsym);
    -            end;
    -          candidates.free;
    -        end;
    -      var
    -        propsym: tpropertysym;
    -        i: integer;
    -        structh: tabstractrecorddef;
    -        pd:tdef;
    -        st:tsymtable;
    -        list: TFPObjectList;
    -        s:string;
    -        odef:tobjectdef;
    -      begin
    -        result:=false;
    -        // note: TEMPORARY
    -        pd := obj;
    -        { 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 ((pd.typ in [recorddef,objectdef]) and
    -            (
    -              not assigned(tabstractrecorddef(pd).objrealname) or
    -              (tabstractrecorddef(pd).objrealname^='')
    -            )
    -           ) or
    -           not assigned(pd.typesym) 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:=generate_objectpascal_helper_key(pd);
    -        list:=TFPObjectList(current_module.extendeddefs.Find(s));
    -        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}obj); // note: what is context here?
    -              if result then
    -                begin
    -                  result := find_best_candidate(para,procsym,odef,callnodeflags,spezcontext);
    -                  if result then
    -                    obj := odef;
    -                end;
    -              dec(i);
    -            until result or (i<0);
    -          end;
    -      end;
    -
    -(*
    -    function find_best_candidate_for_operator(p1, p2: tnode; optoken: ttoken; access: tpropaccesslisttypes; var obj: tabstractrecorddef; out propsym: tpropertysym): boolean;
    -      function find_operator(fromdef: tabstractrecorddef; optoken: ttoken; right:tnode): boolean;
    -        var
    -          candidates : tcallcandidates;
    -          ppn : tcallparanode;
    -          bestpd: tabstractprocdef;
    -        begin
    -          result := false;
    -          // todo: _ASSIGNMENT, _OP_EXPLICIT aren't searchable!
    -          ppn:=ccallparanode.create(right.getcopy,ccallparanode.create(ttypenode.create(fromdef),nil));
    -          ppn.get_paratype;
    -          candidates:=tcallcandidates.create_operator(optoken,ppn);
    -          if candidates.count > 0 then
    -            begin
    -              candidates.get_information;
    -              result := candidates.choose_best(bestpd,false) > 0;
    -            end;
    -          ppn.free;
    -          candidates.free;
    -        end;
    -      var
    -        i: integer;
    -        structh: tabstractrecorddef;
    -      begin
    -        result := false;
    -        { search base first and if there's a matching operator then stop }
    -        if find_operator(obj, optoken, p2) then
    -          exit;
    -        { search default properties }
    -        for i := high(obj.default_props) downto 0 do
    -          begin
    -            propsym := tpropertysym(obj.default_props[i]);
    -            { property is not default }
    -            if not (ppo_defaultproperty in propsym.propoptions) then
    -              continue;
    -            { property doesn't have required access }
    -            if propsym.propaccesslist[access].firstsym = nil then
    -              continue;
    -            structh := tabstractrecorddef(propsym.propdef);
    -            if (structh.typ in [recorddef, objectdef]) and find_operator(structh, optoken, p2) then
    -              begin
    -                obj := structh;
    -                exit(true);
    -              end;
    -            { compare property def with right node result def }
    -            if (compare_defs(structh,p2.resultdef,p1.nodetype)>=te_convert_l6) then
    -              begin
    -                obj := structh;
    -                exit(true);
    -              end;
    -          end;
    -      end;
    -*)
    -
         { reads the parameter for a subroutine call }
         procedure do_proc_call(sym:tsym;st:TSymtable;obj:tabstractrecorddef;getaddr:boolean;var again : boolean;var p1:tnode;callflags:tcallnodeflags;spezcontext:tspecializationcontext);
           var
    @@ -1240,16 +1098,6 @@ implementation
                    begin
                      if not (st.symtabletype in [ObjectSymtable,recordsymtable]) then
                        internalerror(200310031);
    -                 // note: ryan
    -                 { there may be an overloaded method which matches the 
    -                   params which are available now. }
    -                 if (m_multiscope_helpers in current_settings.modeswitches) then
    -                   begin
    -                     if assigned(para) and not assigned(para.resultdef) then
    -                       tcallparanode(para).get_paratype;
    -                     if find_best_helper_candidate_for_proc(para,tprocsym(sym),obj.symtable,callflags,spezcontext,obj) then
    -                       ;//writeln('find_best_helper_candidate_for_proc:',obj.typesym.realname);
    -                   end;
                      p1:=ccallnode.create(para,tprocsym(sym),obj.symtable,p1,callflags,spezcontext);
                    end
                  else
    @@ -2083,7 +1931,8 @@ implementation
                       def:=voidpointertype
                     else
                       def:=node.resultdef;
    -              result:=search_objectpascal_helper(def,nil,pattern,srsym,srsymtable);
    +              { allow multiscope searches }
    +              result:=search_objectpascal_helper(def,nil,false,pattern,srsym,srsymtable);
                   if result then
                     begin
                       if not (srsymtable.symtabletype=objectsymtable) or
    diff --git a/compiler/symtable.pas b/compiler/symtable.pas
    index 10f6f18ae7..f557b11376 100644
    --- a/compiler/symtable.pas
    +++ b/compiler/symtable.pas
    @@ -358,7 +358,7 @@ interface
         function  search_last_objectpascal_helper(pd : tdef;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 : tdef;contextclassh : tabstractrecorddef;const s : string; out srsym: tsym; out srsymtable: tsymtable):boolean;
    +    function  search_objectpascal_helper(pd : tdef;contextclassh : tabstractrecorddef;lastonly : boolean;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, }
    @@ -368,6 +368,9 @@ interface
         { actually defined (could be disable using "undef")                     }
         function  defined_macro(const s : string):boolean;
         { Look for a system procedure (no overloads supported) }
    +    // note: ryan
    +    { 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;
    @@ -3569,7 +3572,7 @@ implementation
                     if (classh.objecttype in objecttypes_with_helpers) and
                         (ssf_search_helper in flags) then
                       begin
    -                    result:=search_objectpascal_helper(classh,contextclassh,s,srsym,srsymtable);
    +                    result:=search_objectpascal_helper(classh,contextclassh,true,s,srsym,srsymtable);
                         { an eventual overload inside the extended type's hierarchy
                           will be found by tcallcandidates }
                         if result then
    @@ -3604,7 +3607,7 @@ implementation
             result:=false;
             hashedid.id:=s;
             { search for a record helper method first }
    -        result:=search_objectpascal_helper(recordh,recordh,s,srsym,srsymtable);
    +        result:=search_objectpascal_helper(recordh,recordh,false,s,srsym,srsymtable);
             if result then
               { an eventual overload inside the extended type's hierarchy
                 will be found by tcallcandidates }
    @@ -4019,15 +4022,13 @@ implementation
             until classh=nil;
           end;
     
    -    function search_best_objectpascal_helper(const name: string;pd : tdef;contextclassh : tabstractrecorddef;out srsym: tsym; out srsymtable: tsymtable):boolean;
    +    // note: ryan
    +    function get_objectpascal_helpers(pd : tdef):TFPObjectList;
           var
             s: string;
    -        list: TFPObjectList;
    -        i: integer;
             st: tsymtable;
    -        odef : tobjectdef;
           begin
    -        result:=false;
    +        result:=nil;
             { when there are no helpers active currently then we don't need to do
               anything }
             if current_module.extendeddefs.count=0 then
    @@ -4050,7 +4051,19 @@ 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;
    @@ -4070,33 +4083,10 @@ implementation
             s: string;
             list: TFPObjectList;
             i: integer;
    -        st: tsymtable;
           begin
             result:=false;
             odef:=nil;
    -        { 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 ((pd.typ in [recorddef,objectdef]) and
    -            (
    -              not assigned(tabstractrecorddef(pd).objrealname) or
    -              (tabstractrecorddef(pd).objrealname^='')
    -            )
    -           ) or
    -           not assigned(pd.typesym) 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:=generate_objectpascal_helper_key(pd);
    -        list:=TFPObjectList(current_module.extendeddefs.Find(s));
    +        list:=get_objectpascal_helpers(pd);
             if assigned(list) and (list.count>0) then
               begin
                 i:=list.count-1;
    @@ -4112,7 +4102,7 @@ implementation
               end;
           end;
     
    -    function search_objectpascal_helper(pd : tdef;contextclassh : tabstractrecorddef;const s: string; out srsym: tsym; out srsymtable: tsymtable):boolean;
    +    function search_objectpascal_helper(pd : tdef;contextclassh : tabstractrecorddef;lastonly : boolean;const s: string; out srsym: tsym; out srsymtable: tsymtable):boolean;
           var
             classh : tobjectdef;
           begin
    @@ -4121,10 +4111,8 @@ implementation
             { if there is no class helper for the class then there is no need to
               search further }
             // note: ryan
    -        if m_multiscope_helpers in current_settings.modeswitches then
    -          begin
    -            result := search_best_objectpascal_helper(s,pd,contextclassh,srsym,srsymtable);
    -          end
    +        if not lastonly and (m_multiscope_helpers in current_settings.modeswitches) then
    +          result := search_best_objectpascal_helper(s,pd,contextclassh,srsym,srsymtable)
             else
               begin
                 if search_last_objectpascal_helper(pd,contextclassh,classh) and
    @@ -4274,7 +4262,7 @@ implementation
             if (oo_is_formal in pd.objectoptions) then
               pd:=find_real_class_definition(tobjectdef(pd),true);
     
    -        if search_objectpascal_helper(pd, pd, s, result, srsymtable) then
    +        if search_objectpascal_helper(pd, pd, true, s, result, srsymtable) then
               exit;
     
             result:=search_struct_member_no_helper(pd,s);
    -- 
    2.17.2 (Apple Git-113)
    
    
    From 4a96a18e6a5e1b9bd5827b58da8e97d14adf1f6b Mon Sep 17 00:00:00 2001
    From: Ryan Joseph <genericptr@gmail.com>
    Date: Sat, 24 Nov 2018 09:56:43 +0700
    Subject: [PATCH 04/12] some cleanup
    
    ---
     compiler/htypechk.pas | 25 +------------------------
     compiler/symtable.pas |  4 ----
     2 files changed, 1 insertion(+), 28 deletions(-)
    
    diff --git a/compiler/htypechk.pas b/compiler/htypechk.pas
    index 5a5b2f6819..bd5dd30f71 100644
    --- a/compiler/htypechk.pas
    +++ b/compiler/htypechk.pas
    @@ -2290,7 +2290,6 @@ implementation
                    )
                    and searchhelpers then
                  begin
    -               // note: ryan
                    if (m_multiscope_helpers in current_settings.modeswitches) then
                      begin
                        helperlist:=get_objectpascal_helpers(structdef);
    @@ -2300,7 +2299,7 @@ implementation
                            repeat
                              helperdef:=tobjectdef(helperlist[i]);
                              if (helperdef.owner.symtabletype in [staticsymtable,globalsymtable]) or
    -                            is_visible_for_object(helperdef.typesym,{structdef}helperdef) then
    +                            is_visible_for_object(helperdef.typesym,helperdef) then
                                   if processhelper(hashedid,helperdef) then
                                     exit;
                              dec(i);
    @@ -2309,28 +2308,6 @@ implementation
                      end
                    else if search_last_objectpascal_helper(structdef,nil,helperdef) and processhelper(hashedid,helperdef) then
                       exit;
    -
    -               //if processhelper 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),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;
    -               //  end;
                  end;
                { now search in the type itself }
                srsym:=tsym(structdef.symtable.FindWithHash(hashedid));
    diff --git a/compiler/symtable.pas b/compiler/symtable.pas
    index f557b11376..798ee696de 100644
    --- a/compiler/symtable.pas
    +++ b/compiler/symtable.pas
    @@ -368,7 +368,6 @@ interface
         { actually defined (could be disable using "undef")                     }
         function  defined_macro(const s : string):boolean;
         { Look for a system procedure (no overloads supported) }
    -    // note: ryan
         { returns a list of helpers in the current module for the def }
         function get_objectpascal_helpers(pd : tdef):TFPObjectList;
     
    @@ -3974,7 +3973,6 @@ implementation
               end;
           end;
     
    -    // note: ryan
         function search_objectdef(const s: string;classh : tobjectdef;contextclassh : tabstractrecorddef;out srsym: tsym; out srsymtable: tsymtable): boolean;
           var
             hashedid  : THashedIDString;
    @@ -4022,7 +4020,6 @@ implementation
             until classh=nil;
           end;
     
    -    // note: ryan
         function get_objectpascal_helpers(pd : tdef):TFPObjectList;
           var
             s: string;
    @@ -4110,7 +4107,6 @@ implementation
     
             { if there is no class helper for the class then there is no need to
               search further }
    -        // note: ryan
             if not lastonly and (m_multiscope_helpers in current_settings.modeswitches) then
               result := search_best_objectpascal_helper(s,pd,contextclassh,srsym,srsymtable)
             else
    -- 
    2.17.2 (Apple Git-113)
    
    
    From 594d73547384e5d382e1095fc626099519c28fe3 Mon Sep 17 00:00:00 2001
    From: Ryan Joseph <genericptr@gmail.com>
    Date: Mon, 26 Nov 2018 09:16:47 +0700
    Subject: [PATCH 05/12] removed "lastonly" param from
     search_objectpascal_helper
    
    ---
     compiler/pexpr.pas    |  2 +-
     compiler/symtable.pas | 12 ++++++------
     2 files changed, 7 insertions(+), 7 deletions(-)
    
    diff --git a/compiler/pexpr.pas b/compiler/pexpr.pas
    index f14dbe8a3f..39bb5e1de5 100644
    --- a/compiler/pexpr.pas
    +++ b/compiler/pexpr.pas
    @@ -1932,7 +1932,7 @@ implementation
                     else
                       def:=node.resultdef;
                   { allow multiscope searches }
    -              result:=search_objectpascal_helper(def,nil,false,pattern,srsym,srsymtable);
    +              result:=search_objectpascal_helper(def,nil,pattern,srsym,srsymtable);
                   if result then
                     begin
                       if not (srsymtable.symtabletype=objectsymtable) or
    diff --git a/compiler/symtable.pas b/compiler/symtable.pas
    index 798ee696de..1a3f917885 100644
    --- a/compiler/symtable.pas
    +++ b/compiler/symtable.pas
    @@ -358,7 +358,7 @@ interface
         function  search_last_objectpascal_helper(pd : tdef;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 : tdef;contextclassh : tabstractrecorddef;lastonly : boolean;const s : string;out srsym: tsym; out srsymtable: tsymtable):boolean;
    +    function  search_objectpascal_helper(pd : tdef;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, }
    @@ -3571,7 +3571,7 @@ implementation
                     if (classh.objecttype in objecttypes_with_helpers) and
                         (ssf_search_helper in flags) then
                       begin
    -                    result:=search_objectpascal_helper(classh,contextclassh,true,s,srsym,srsymtable);
    +                    result:=search_objectpascal_helper(classh,contextclassh,s,srsym,srsymtable);
                         { an eventual overload inside the extended type's hierarchy
                           will be found by tcallcandidates }
                         if result then
    @@ -3606,7 +3606,7 @@ implementation
             result:=false;
             hashedid.id:=s;
             { search for a record helper method first }
    -        result:=search_objectpascal_helper(recordh,recordh,false,s,srsym,srsymtable);
    +        result:=search_objectpascal_helper(recordh,recordh,s,srsym,srsymtable);
             if result then
               { an eventual overload inside the extended type's hierarchy
                 will be found by tcallcandidates }
    @@ -4099,7 +4099,7 @@ implementation
               end;
           end;
     
    -    function search_objectpascal_helper(pd : tdef;contextclassh : tabstractrecorddef;lastonly : boolean;const s: string; out srsym: tsym; out srsymtable: tsymtable):boolean;
    +    function search_objectpascal_helper(pd : tdef;contextclassh : tabstractrecorddef;const s: string; out srsym: tsym; out srsymtable: tsymtable):boolean;
           var
             classh : tobjectdef;
           begin
    @@ -4107,7 +4107,7 @@ implementation
     
             { if there is no class helper for the class then there is no need to
               search further }
    -        if not lastonly and (m_multiscope_helpers in current_settings.modeswitches) then
    +        if m_multiscope_helpers in current_settings.modeswitches then
               result := search_best_objectpascal_helper(s,pd,contextclassh,srsym,srsymtable)
             else
               begin
    @@ -4258,7 +4258,7 @@ implementation
             if (oo_is_formal in pd.objectoptions) then
               pd:=find_real_class_definition(tobjectdef(pd),true);
     
    -        if search_objectpascal_helper(pd, pd, true, s, result, srsymtable) then
    +        if search_objectpascal_helper(pd, pd, s, result, srsymtable) then
               exit;
     
             result:=search_struct_member_no_helper(pd,s);
    -- 
    2.17.2 (Apple Git-113)
    
    
    From 7c961f10bba62739bc524989eceff4d9f532242f Mon Sep 17 00:00:00 2001
    From: Ryan Joseph <genericptr@gmail.com>
    Date: Sun, 24 Feb 2019 12:49:11 -0500
    Subject: [PATCH 06/12] changed mode switch to "multi helpers" and fixed bug in
     searchsym_in_helper
    
    ---
     compiler/globtype.pas |  4 ++--
     compiler/htypechk.pas |  2 +-
     compiler/ppu.pas      |  2 +-
     compiler/symtable.pas | 17 +++++++++++++----
     4 files changed, 17 insertions(+), 8 deletions(-)
    
    diff --git a/compiler/globtype.pas b/compiler/globtype.pas
    index f154532a5f..06011517d2 100644
    --- a/compiler/globtype.pas
    +++ b/compiler/globtype.pas
    @@ -447,7 +447,7 @@ interface
              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_multiscope_helpers   { ObjFPC mode only - helpers can appear in multiple scopes simultaneously }
    +         m_multi_helpers        { ObjFPC mode only - helpers can appear in multiple scopes simultaneously }
            );
            tmodeswitches = set of tmodeswitch;
     
    @@ -637,7 +637,7 @@ interface
              'ISOPROGRAMPARAS',
              'ISOMOD',
              'ARRAYOPERATORS',
    -         'MULTISCOPEHELPERS'
    +         'MULTIHELPERS'
              );
     
     
    diff --git a/compiler/htypechk.pas b/compiler/htypechk.pas
    index bd5dd30f71..63b12c31fe 100644
    --- a/compiler/htypechk.pas
    +++ b/compiler/htypechk.pas
    @@ -2290,7 +2290,7 @@ implementation
                    )
                    and searchhelpers then
                  begin
    -               if (m_multiscope_helpers in current_settings.modeswitches) then
    +               if (m_multi_helpers in current_settings.modeswitches) then
                      begin
                        helperlist:=get_objectpascal_helpers(structdef);
                        if assigned(helperlist) and (helperlist.count>0) then
    diff --git a/compiler/ppu.pas b/compiler/ppu.pas
    index 10c42e7eb8..31011be3e8 100644
    --- a/compiler/ppu.pas
    +++ b/compiler/ppu.pas
    @@ -43,7 +43,7 @@ type
     {$endif Test_Double_checksum}
     
     const
    -  CurrentPPUVersion = 201;
    +  CurrentPPUVersion = 203;
     
     { unit flags }
       uf_init                = $000001; { unit has initialization section }
    diff --git a/compiler/symtable.pas b/compiler/symtable.pas
    index 1a3f917885..f654b2ee46 100644
    --- a/compiler/symtable.pas
    +++ b/compiler/symtable.pas
    @@ -3696,6 +3696,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;
    @@ -3757,10 +3759,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!) }
    -          result:=searchsym_in_class(tobjectdef(classh.extendeddef).childof,contextclassh,s,srsym,srsymtable,flags+[ssf_search_helper]);
    -          { addsymref is already called by searchsym_in_class }
    +          begin
    +            result:=searchsym_in_class(tobjectdef(classh.extendeddef).childof,contextclassh,s,srsym,srsymtable,flags+[ssf_search_helper]);
    +            { 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;
    @@ -4107,7 +4116,7 @@ implementation
     
             { if there is no class helper for the class then there is no need to
               search further }
    -        if m_multiscope_helpers in current_settings.modeswitches then
    +        if m_multi_helpers in current_settings.modeswitches then
               result := search_best_objectpascal_helper(s,pd,contextclassh,srsym,srsymtable)
             else
               begin
    -- 
    2.17.2 (Apple Git-113)
    
    
    From a6c08d0ce5b1ef4ed07f59844efaef46153b69b1 Mon Sep 17 00:00:00 2001
    From: Ryan Joseph <genericptr@gmail.com>
    Date: Sun, 24 Feb 2019 15:53:20 -0500
    Subject: [PATCH 07/12] added tests (tmshlp*.pp)
    
    ---
     .gitignore              | 29 +++++++++++++++++++------
     tests/test/tmshlp1.pas  | 36 +++++++++++++++++++++++++++++++
     tests/test/tmshlp10.pas | 36 +++++++++++++++++++++++++++++++
     tests/test/tmshlp11.pas | 38 ++++++++++++++++++++++++++++++++
     tests/test/tmshlp2.pas  | 36 +++++++++++++++++++++++++++++++
     tests/test/tmshlp3.pas  | 32 +++++++++++++++++++++++++++
     tests/test/tmshlp4.pas  | 48 +++++++++++++++++++++++++++++++++++++++++
     tests/test/tmshlp5.pas  | 35 ++++++++++++++++++++++++++++++
     tests/test/tmshlp6.pas  | 26 ++++++++++++++++++++++
     tests/test/tmshlp7.pas  | 27 +++++++++++++++++++++++
     tests/test/tmshlp8.pas  | 34 +++++++++++++++++++++++++++++
     tests/test/tmshlp9.pas  | 36 +++++++++++++++++++++++++++++++
     12 files changed, 406 insertions(+), 7 deletions(-)
     create mode 100644 tests/test/tmshlp1.pas
     create mode 100644 tests/test/tmshlp10.pas
     create mode 100644 tests/test/tmshlp11.pas
     create mode 100644 tests/test/tmshlp2.pas
     create mode 100644 tests/test/tmshlp3.pas
     create mode 100644 tests/test/tmshlp4.pas
     create mode 100644 tests/test/tmshlp5.pas
     create mode 100644 tests/test/tmshlp6.pas
     create mode 100644 tests/test/tmshlp7.pas
     create mode 100644 tests/test/tmshlp8.pas
     create mode 100644 tests/test/tmshlp9.pas
    
    diff --git a/.gitignore b/.gitignore
    index 5f32ec99e7..64fdb156d0 100644
    --- a/.gitignore
    +++ b/.gitignore
    @@ -1,8 +1,23 @@
    -# Ignore everything
    -*
    +# files
    +pp
    +fpmake
    +rtl/darwin/fpcmade.x86_64-darwin
    +fpmake_proc1 copy.inc
    +tests/*.x86_64-darwin
    +rtl/Package.fpc
    +tests/createlst
    +tests/gparmake
     
    -# But not these files...
    -!.gitignore
    -!.pas
    -!.pp
    -!ryan_*.lpi
    \ No newline at end of file
    +# directories
    +lazbuild/
    +x86_64-darwin/
    +tests/tstunits/
    +tests/utils
    +
    +# patterns
    +*.app
    +*.o
    +*.ppu
    +*.fpm
    +*.rsj
    +*.lst
    \ No newline at end of file
    diff --git a/tests/test/tmshlp1.pas b/tests/test/tmshlp1.pas
    new file mode 100644
    index 0000000000..efab230519
    --- /dev/null
    +++ b/tests/test/tmshlp1.pas
    @@ -0,0 +1,36 @@
    +{$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.
    diff --git a/tests/test/tmshlp10.pas b/tests/test/tmshlp10.pas
    new file mode 100644
    index 0000000000..db02f1e09f
    --- /dev/null
    +++ b/tests/test/tmshlp10.pas
    @@ -0,0 +1,36 @@
    +{$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.
    diff --git a/tests/test/tmshlp11.pas b/tests/test/tmshlp11.pas
    new file mode 100644
    index 0000000000..87b52f625a
    --- /dev/null
    +++ b/tests/test/tmshlp11.pas
    @@ -0,0 +1,38 @@
    +{$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.
    diff --git a/tests/test/tmshlp2.pas b/tests/test/tmshlp2.pas
    new file mode 100644
    index 0000000000..177505f567
    --- /dev/null
    +++ b/tests/test/tmshlp2.pas
    @@ -0,0 +1,36 @@
    +{$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.
    diff --git a/tests/test/tmshlp3.pas b/tests/test/tmshlp3.pas
    new file mode 100644
    index 0000000000..ca030de79c
    --- /dev/null
    +++ b/tests/test/tmshlp3.pas
    @@ -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.
    \ No newline at end of file
    diff --git a/tests/test/tmshlp4.pas b/tests/test/tmshlp4.pas
    new file mode 100644
    index 0000000000..c90995a09d
    --- /dev/null
    +++ b/tests/test/tmshlp4.pas
    @@ -0,0 +1,48 @@
    +{$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.
    diff --git a/tests/test/tmshlp5.pas b/tests/test/tmshlp5.pas
    new file mode 100644
    index 0000000000..d0dc99b607
    --- /dev/null
    +++ b/tests/test/tmshlp5.pas
    @@ -0,0 +1,35 @@
    +{$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.
    diff --git a/tests/test/tmshlp6.pas b/tests/test/tmshlp6.pas
    new file mode 100644
    index 0000000000..985bf8f9b8
    --- /dev/null
    +++ b/tests/test/tmshlp6.pas
    @@ -0,0 +1,26 @@
    +{%FAIL}
    +{$mode objfpc}
    +{$modeswitch multihelpers}
    +
    +program tmshlp6;
    +
    +type
    +	TMyObject = class
    +		m_num: integer;
    +		property num1: integer read m_num;
    +	end;
    +	THelper1 = class helper for TMyObject
    +		property num2: integer read m_num;
    +	end;
    +	THelper2 = class helper for TMyObject
    +		property num3: integer read m_num;
    +	end;
    +
    +var
    +	obj: TMyObject;
    +	num: integer;
    +begin
    +	obj := TMyObject.Create;
    +	obj.m_num := 1;
    +	num := obj.num1 + obj.num2 + obj.num3;
    +end.
    diff --git a/tests/test/tmshlp7.pas b/tests/test/tmshlp7.pas
    new file mode 100644
    index 0000000000..5702b0959a
    --- /dev/null
    +++ b/tests/test/tmshlp7.pas
    @@ -0,0 +1,27 @@
    +{$mode objfpc}
    +{$modeswitch advancedrecords}
    +{$modeswitch typehelpers}
    +
    +unit tmshlp7;
    +interface
    +
    +type
    +	TExtClassHelper = class helper for TObject
    +		procedure DoThisExt;
    +	end;
    +	TExtStringHelper = type helper for String
    +		function LengthExt: integer;
    +	end;
    +
    +implementation
    +	
    +procedure TExtClassHelper.DoThisExt;
    +begin	
    +end;
    +
    +function TExtStringHelper.LengthExt: integer;
    +begin
    +	result := System.Length(self);
    +end;
    +
    +end.
    diff --git a/tests/test/tmshlp8.pas b/tests/test/tmshlp8.pas
    new file mode 100644
    index 0000000000..242a54b968
    --- /dev/null
    +++ b/tests/test/tmshlp8.pas
    @@ -0,0 +1,34 @@
    +{$mode objfpc}
    +{$modeswitch typehelpers}
    +{$modeswitch multihelpers}
    +
    +program tmshlp8;
    +uses
    +	tmshlp7;
    +
    +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);
    +end.
    diff --git a/tests/test/tmshlp9.pas b/tests/test/tmshlp9.pas
    new file mode 100644
    index 0000000000..dbd830e425
    --- /dev/null
    +++ b/tests/test/tmshlp9.pas
    @@ -0,0 +1,36 @@
    +{$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.
    -- 
    2.17.2 (Apple Git-113)
    
    
    From 505fb9b0791beda06ce18fddbc74ddf1ae632a51 Mon Sep 17 00:00:00 2001
    From: Ryan Joseph <genericptr@gmail.com>
    Date: Sun, 24 Feb 2019 16:07:47 -0500
    Subject: [PATCH 08/12] updated gitignore
    
    ---
     .gitignore | 1 +
     1 file changed, 1 insertion(+)
    
    diff --git a/.gitignore b/.gitignore
    index 64fdb156d0..16d38503e5 100644
    --- a/.gitignore
    +++ b/.gitignore
    @@ -7,6 +7,7 @@ tests/*.x86_64-darwin
     rtl/Package.fpc
     tests/createlst
     tests/gparmake
    +compiler/ryan_ppcx64.lpi
     
     # directories
     lazbuild/
    -- 
    2.17.2 (Apple Git-113)
    
    
    From 212319f84e08d2b1e5bee274261f9ab7414ee826 Mon Sep 17 00:00:00 2001
    From: Ryan Joseph <genericptr@gmail.com>
    Date: Mon, 25 Feb 2019 09:46:55 -0500
    Subject: [PATCH 09/12] renamed tests with proper suffix
    
    ---
     tests/test/{tmshlp1.pas => tmshlp1.pp}   |  0
     tests/test/{tmshlp10.pas => tmshlp10.pp} |  0
     tests/test/{tmshlp11.pas => tmshlp11.pp} |  0
     tests/test/{tmshlp2.pas => tmshlp2.pp}   |  0
     tests/test/{tmshlp3.pas => tmshlp3.pp}   |  0
     tests/test/{tmshlp4.pas => tmshlp4.pp}   |  0
     tests/test/{tmshlp5.pas => tmshlp5.pp}   |  0
     tests/test/tmshlp6.pas                   | 26 ------------------
     tests/test/tmshlp6.pp                    | 35 ++++++++++++++++++++++++
     tests/test/{tmshlp7.pas => tmshlp7.pp}   |  0
     tests/test/{tmshlp8.pas => tmshlp8.pp}   |  0
     tests/test/{tmshlp9.pas => tmshlp9.pp}   |  0
     12 files changed, 35 insertions(+), 26 deletions(-)
     rename tests/test/{tmshlp1.pas => tmshlp1.pp} (100%)
     rename tests/test/{tmshlp10.pas => tmshlp10.pp} (100%)
     rename tests/test/{tmshlp11.pas => tmshlp11.pp} (100%)
     rename tests/test/{tmshlp2.pas => tmshlp2.pp} (100%)
     rename tests/test/{tmshlp3.pas => tmshlp3.pp} (100%)
     rename tests/test/{tmshlp4.pas => tmshlp4.pp} (100%)
     rename tests/test/{tmshlp5.pas => tmshlp5.pp} (100%)
     delete mode 100644 tests/test/tmshlp6.pas
     create mode 100644 tests/test/tmshlp6.pp
     rename tests/test/{tmshlp7.pas => tmshlp7.pp} (100%)
     rename tests/test/{tmshlp8.pas => tmshlp8.pp} (100%)
     rename tests/test/{tmshlp9.pas => tmshlp9.pp} (100%)
    
    diff --git a/tests/test/tmshlp1.pas b/tests/test/tmshlp1.pp
    similarity index 100%
    rename from tests/test/tmshlp1.pas
    rename to tests/test/tmshlp1.pp
    diff --git a/tests/test/tmshlp10.pas b/tests/test/tmshlp10.pp
    similarity index 100%
    rename from tests/test/tmshlp10.pas
    rename to tests/test/tmshlp10.pp
    diff --git a/tests/test/tmshlp11.pas b/tests/test/tmshlp11.pp
    similarity index 100%
    rename from tests/test/tmshlp11.pas
    rename to tests/test/tmshlp11.pp
    diff --git a/tests/test/tmshlp2.pas b/tests/test/tmshlp2.pp
    similarity index 100%
    rename from tests/test/tmshlp2.pas
    rename to tests/test/tmshlp2.pp
    diff --git a/tests/test/tmshlp3.pas b/tests/test/tmshlp3.pp
    similarity index 100%
    rename from tests/test/tmshlp3.pas
    rename to tests/test/tmshlp3.pp
    diff --git a/tests/test/tmshlp4.pas b/tests/test/tmshlp4.pp
    similarity index 100%
    rename from tests/test/tmshlp4.pas
    rename to tests/test/tmshlp4.pp
    diff --git a/tests/test/tmshlp5.pas b/tests/test/tmshlp5.pp
    similarity index 100%
    rename from tests/test/tmshlp5.pas
    rename to tests/test/tmshlp5.pp
    diff --git a/tests/test/tmshlp6.pas b/tests/test/tmshlp6.pas
    deleted file mode 100644
    index 985bf8f9b8..0000000000
    --- a/tests/test/tmshlp6.pas
    +++ /dev/null
    @@ -1,26 +0,0 @@
    -{%FAIL}
    -{$mode objfpc}
    -{$modeswitch multihelpers}
    -
    -program tmshlp6;
    -
    -type
    -	TMyObject = class
    -		m_num: integer;
    -		property num1: integer read m_num;
    -	end;
    -	THelper1 = class helper for TMyObject
    -		property num2: integer read m_num;
    -	end;
    -	THelper2 = class helper for TMyObject
    -		property num3: integer read m_num;
    -	end;
    -
    -var
    -	obj: TMyObject;
    -	num: integer;
    -begin
    -	obj := TMyObject.Create;
    -	obj.m_num := 1;
    -	num := obj.num1 + obj.num2 + obj.num3;
    -end.
    diff --git a/tests/test/tmshlp6.pp b/tests/test/tmshlp6.pp
    new file mode 100644
    index 0000000000..ff10addbfe
    --- /dev/null
    +++ b/tests/test/tmshlp6.pp
    @@ -0,0 +1,35 @@
    +{$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.
    diff --git a/tests/test/tmshlp7.pas b/tests/test/tmshlp7.pp
    similarity index 100%
    rename from tests/test/tmshlp7.pas
    rename to tests/test/tmshlp7.pp
    diff --git a/tests/test/tmshlp8.pas b/tests/test/tmshlp8.pp
    similarity index 100%
    rename from tests/test/tmshlp8.pas
    rename to tests/test/tmshlp8.pp
    diff --git a/tests/test/tmshlp9.pas b/tests/test/tmshlp9.pp
    similarity index 100%
    rename from tests/test/tmshlp9.pas
    rename to tests/test/tmshlp9.pp
    -- 
    2.17.2 (Apple Git-113)
    
    
    From 1fadd1915f60ae3ddf120f5cd67f828f0ac092da Mon Sep 17 00:00:00 2001
    From: Ryan Joseph <genericptr@gmail.com>
    Date: Mon, 25 Feb 2019 10:26:12 -0500
    Subject: [PATCH 10/12] disabled m_multi_helpers in $mode delphi
    
    ---
     compiler/htypechk.pas  |  2 +-
     compiler/symtable.pas  |  4 ++--
     tests/test/tmshlp12.pp | 37 +++++++++++++++++++++++++++++++++++++
     3 files changed, 40 insertions(+), 3 deletions(-)
     create mode 100644 tests/test/tmshlp12.pp
    
    diff --git a/compiler/htypechk.pas b/compiler/htypechk.pas
    index 63b12c31fe..63e94f727e 100644
    --- a/compiler/htypechk.pas
    +++ b/compiler/htypechk.pas
    @@ -2290,7 +2290,7 @@ implementation
                    )
                    and searchhelpers then
                  begin
    -               if (m_multi_helpers in current_settings.modeswitches) then
    +               if (m_multi_helpers in current_settings.modeswitches) and not (m_delphi in current_settings.modeswitches) then
                      begin
                        helperlist:=get_objectpascal_helpers(structdef);
                        if assigned(helperlist) and (helperlist.count>0) then
    diff --git a/compiler/symtable.pas b/compiler/symtable.pas
    index f654b2ee46..07ac7f6ab9 100644
    --- a/compiler/symtable.pas
    +++ b/compiler/symtable.pas
    @@ -3768,7 +3768,7 @@ implementation
                   exit;
               end;
             { now search all helpers using the extendeddef as the starting point }
    -        if m_multi_helpers in current_settings.modeswitches then
    +        if (m_multi_helpers in current_settings.modeswitches) and not (m_delphi in current_settings.modeswitches) then
               result:=search_best_objectpascal_helper(s,classh.extendeddef,contextclassh,srsym,srsymtable);
           end;
     
    @@ -4116,7 +4116,7 @@ implementation
     
             { if there is no class helper for the class then there is no need to
               search further }
    -        if m_multi_helpers in current_settings.modeswitches then
    +        if (m_multi_helpers in current_settings.modeswitches) and not (m_delphi in current_settings.modeswitches) then
               result := search_best_objectpascal_helper(s,pd,contextclassh,srsym,srsymtable)
             else
               begin
    diff --git a/tests/test/tmshlp12.pp b/tests/test/tmshlp12.pp
    new file mode 100644
    index 0000000000..bdb3e6e9c0
    --- /dev/null
    +++ b/tests/test/tmshlp12.pp
    @@ -0,0 +1,37 @@
    +{%FAIL}
    +{$mode delphi}
    +{$modeswitch multihelpers}
    +
    +program tmshlp12;
    +
    +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.
    -- 
    2.17.2 (Apple Git-113)
    
    
    From 649f1022dd61574e9d79411bafff9cd261768bfc Mon Sep 17 00:00:00 2001
    From: Ryan Joseph <genericptr@gmail.com>
    Date: Mon, 25 Feb 2019 10:47:06 -0500
    Subject: [PATCH 11/12] added 2 more tests
    
    ---
     tests/test/tmshlp13.pp | 17 +++++++++++++++++
     tests/test/tmshlp14.pp | 19 +++++++++++++++++++
     2 files changed, 36 insertions(+)
     create mode 100644 tests/test/tmshlp13.pp
     create mode 100644 tests/test/tmshlp14.pp
    
    diff --git a/tests/test/tmshlp13.pp b/tests/test/tmshlp13.pp
    new file mode 100644
    index 0000000000..023b95252d
    --- /dev/null
    +++ b/tests/test/tmshlp13.pp
    @@ -0,0 +1,17 @@
    +{$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.
    diff --git a/tests/test/tmshlp14.pp b/tests/test/tmshlp14.pp
    new file mode 100644
    index 0000000000..26cf23e0d8
    --- /dev/null
    +++ b/tests/test/tmshlp14.pp
    @@ -0,0 +1,19 @@
    +{$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.
    -- 
    2.17.2 (Apple Git-113)
    
    
    From de559132464b8ab68e427550e530f295391c5efc Mon Sep 17 00:00:00 2001
    From: Ryan Joseph <genericptr@gmail.com>
    Date: Mon, 25 Feb 2019 13:28:55 -0500
    Subject: [PATCH 12/12] reverted m_multi_helpers to be allowed in Delphi mode
    
    ---
     compiler/globtype.pas | 2 +-
     compiler/htypechk.pas | 2 +-
     compiler/symtable.pas | 4 ++--
     3 files changed, 4 insertions(+), 4 deletions(-)
    
    diff --git a/compiler/globtype.pas b/compiler/globtype.pas
    index 06011517d2..c1e530d5b1 100644
    --- a/compiler/globtype.pas
    +++ b/compiler/globtype.pas
    @@ -447,7 +447,7 @@ interface
              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_multi_helpers        { ObjFPC mode only - helpers can appear in multiple scopes simultaneously }
    +         m_multi_helpers        { helpers can appear in multiple scopes simultaneously }
            );
            tmodeswitches = set of tmodeswitch;
     
    diff --git a/compiler/htypechk.pas b/compiler/htypechk.pas
    index 63e94f727e..20b65c5dad 100644
    --- a/compiler/htypechk.pas
    +++ b/compiler/htypechk.pas
    @@ -2290,7 +2290,7 @@ implementation
                    )
                    and searchhelpers then
                  begin
    -               if (m_multi_helpers in current_settings.modeswitches) and not (m_delphi in current_settings.modeswitches) then
    +               if m_multi_helpers in current_settings.modeswitches then
                      begin
                        helperlist:=get_objectpascal_helpers(structdef);
                        if assigned(helperlist) and (helperlist.count>0) then
    diff --git a/compiler/symtable.pas b/compiler/symtable.pas
    index 07ac7f6ab9..f654b2ee46 100644
    --- a/compiler/symtable.pas
    +++ b/compiler/symtable.pas
    @@ -3768,7 +3768,7 @@ implementation
                   exit;
               end;
             { now search all helpers using the extendeddef as the starting point }
    -        if (m_multi_helpers in current_settings.modeswitches) and not (m_delphi in current_settings.modeswitches) then
    +        if m_multi_helpers in current_settings.modeswitches then
               result:=search_best_objectpascal_helper(s,classh.extendeddef,contextclassh,srsym,srsymtable);
           end;
     
    @@ -4116,7 +4116,7 @@ implementation
     
             { if there is no class helper for the class then there is no need to
               search further }
    -        if (m_multi_helpers in current_settings.modeswitches) and not (m_delphi in current_settings.modeswitches) then
    +        if m_multi_helpers in current_settings.modeswitches then
               result := search_best_objectpascal_helper(s,pd,contextclassh,srsym,srsymtable)
             else
               begin
    -- 
    2.17.2 (Apple Git-113)
    
    
    patch.diff (88,644 bytes)
  • multi-helpers.diff (31,413 bytes)
    From cc0dce84472867dc6c35ab48bc0ad0060cacc081 Mon Sep 17 00:00:00 2001
    From: Ryan Joseph <genericptr@gmail.com>
    Date: Wed, 21 Nov 2018 14:14:14 +0700
    Subject: [PATCH] m_multi_helpers for multi-scope helpers
    
    ---
     .gitignore               |  24 +++++
     compiler/globtype.pas    |   6 +-
     compiler/htypechk.pas    |  62 +++++++++----
     compiler/pexpr.pas       |   4 +-
     compiler/ryan_ppcx64.lpi |  77 ++++++++++++++++
     compiler/symtable.pas    | 192 +++++++++++++++++++++++++--------------
     tests/test/tmshlp1.pp    |  36 ++++++++
     tests/test/tmshlp10.pp   |  36 ++++++++
     tests/test/tmshlp11.pp   |  38 ++++++++
     tests/test/tmshlp12.pp   |  37 ++++++++
     tests/test/tmshlp13.pp   |  17 ++++
     tests/test/tmshlp14.pp   |  19 ++++
     tests/test/tmshlp2.pp    |  36 ++++++++
     tests/test/tmshlp3.pp    |  32 +++++++
     tests/test/tmshlp4.pp    |  48 ++++++++++
     tests/test/tmshlp5.pp    |  35 +++++++
     tests/test/tmshlp6.pp    |  35 +++++++
     tests/test/tmshlp7.pp    |  27 ++++++
     tests/test/tmshlp8.pp    |  34 +++++++
     tests/test/tmshlp9.pp    |  36 ++++++++
     20 files changed, 741 insertions(+), 90 deletions(-)
     create mode 100644 .gitignore
     create mode 100644 compiler/ryan_ppcx64.lpi
     create mode 100644 tests/test/tmshlp1.pp
     create mode 100644 tests/test/tmshlp10.pp
     create mode 100644 tests/test/tmshlp11.pp
     create mode 100644 tests/test/tmshlp12.pp
     create mode 100644 tests/test/tmshlp13.pp
     create mode 100644 tests/test/tmshlp14.pp
     create mode 100644 tests/test/tmshlp2.pp
     create mode 100644 tests/test/tmshlp3.pp
     create mode 100644 tests/test/tmshlp4.pp
     create mode 100644 tests/test/tmshlp5.pp
     create mode 100644 tests/test/tmshlp6.pp
     create mode 100644 tests/test/tmshlp7.pp
     create mode 100644 tests/test/tmshlp8.pp
     create mode 100644 tests/test/tmshlp9.pp
    
    diff --git a/.gitignore b/.gitignore
    new file mode 100644
    index 0000000000..16d38503e5
    --- /dev/null
    +++ b/.gitignore
    @@ -0,0 +1,24 @@
    +# files
    +pp
    +fpmake
    +rtl/darwin/fpcmade.x86_64-darwin
    +fpmake_proc1 copy.inc
    +tests/*.x86_64-darwin
    +rtl/Package.fpc
    +tests/createlst
    +tests/gparmake
    +compiler/ryan_ppcx64.lpi
    +
    +# directories
    +lazbuild/
    +x86_64-darwin/
    +tests/tstunits/
    +tests/utils
    +
    +# patterns
    +*.app
    +*.o
    +*.ppu
    +*.fpm
    +*.rsj
    +*.lst
    \ No newline at end of file
    diff --git a/compiler/globtype.pas b/compiler/globtype.pas
    index f883227ca1..5973e8d7d7 100644
    --- a/compiler/globtype.pas
    +++ b/compiler/globtype.pas
    @@ -454,7 +454,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;
     
    @@ -643,7 +644,8 @@ interface
              'ISOIO',
              'ISOPROGRAMPARAS',
              'ISOMOD',
    -         'ARRAYOPERATORS'
    +         'ARRAYOPERATORS',
    +         'MULTIHELPERS'
              );
     
     
    diff --git a/compiler/htypechk.pas b/compiler/htypechk.pas
    index 4e97f903a9..7402930b7f 100644
    --- a/compiler/htypechk.pas
    +++ b/compiler/htypechk.pas
    @@ -2242,6 +2242,33 @@ implementation
                     ProcdefOverloadList.Add(pd);
                 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;
    @@ -2250,6 +2277,8 @@ implementation
             foundanything : boolean;
             extendeddef : tabstractrecorddef;
             helperdef  : tobjectdef;
    +        helperlist : TFPObjectList;
    +        i : integer;
           begin
             if FOperator=NOTOKEN then
               hashedid.id:=FProcsym.name
    @@ -2269,27 +2298,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;
    -                   while assigned(helperdef) do
    +                   helperlist:=get_objectpascal_helpers(structdef);
    +                   if assigned(helperlist) and (helperlist.count>0) then
                          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;
    +                       i:=helperlist.count-1;
    +                       repeat
    +                         helperdef:=tobjectdef(helperlist[i]);
    +                         if (helperdef.owner.symtabletype in [staticsymtable,globalsymtable]) or
    +                            is_visible_for_object(helperdef.typesym,helperdef) then
    +                              if processhelper(hashedid,helperdef) then
    +                                exit;
    +                         dec(i);
    +                       until (i<0);
                          end;
    -                   if not hasoverload and assigned(srsym) then
    -                     exit;
    -                 end;
    +                 end
    +               else if search_last_objectpascal_helper(structdef,nil,helperdef) and processhelper(hashedid,helperdef) then
    +                  exit;
                  end;
                { now search in the type itself }
                srsym:=tsym(structdef.symtable.FindWithHash(hashedid));
    diff --git a/compiler/pexpr.pas b/compiler/pexpr.pas
    index 251c613ef1..ccb9571cca 100644
    --- a/compiler/pexpr.pas
    +++ b/compiler/pexpr.pas
    @@ -76,7 +76,7 @@ implementation
            fmodule,ppu,
            { pass 1 }
            pass_1,
    -       nmat,nadd,nmem,nset,ncnv,ninl,ncon,nld,nflw,nbas,nutils,
    +       nmat,nadd,nmem,nset,ncnv,ninl,ncon,nld,nflw,nbas,nutils,htypechk,
            { parser }
            scanner,
            pbase,pinline,ptype,pgenutil,procinfo,cpuinfo
    @@ -963,7 +963,6 @@ implementation
              end;
           end;
     
    -
         { reads the parameter for a subroutine call }
         procedure do_proc_call(sym:tsym;st:TSymtable;obj:tabstractrecorddef;getaddr:boolean;var again : boolean;var p1:tnode;callflags:tcallnodeflags;spezcontext:tspecializationcontext);
           var
    @@ -1967,6 +1966,7 @@ implementation
                       def:=voidpointertype
                     else
                       def:=node.resultdef;
    +              { allow multiscope searches }
                   result:=search_objectpascal_helper(def,nil,pattern,srsym,srsymtable);
                   if result then
                     begin
    diff --git a/compiler/ryan_ppcx64.lpi b/compiler/ryan_ppcx64.lpi
    new file mode 100644
    index 0000000000..6a6220e7d5
    --- /dev/null
    +++ b/compiler/ryan_ppcx64.lpi
    @@ -0,0 +1,77 @@
    +<?xml version="1.0"?>
    +<CONFIG>
    +  <ProjectOptions>
    +    <Version Value="9"/>
    +    <PathDelim Value="\"/>
    +    <General>
    +      <Flags>
    +        <MainUnitHasUsesSectionForAllUnits Value="False"/>
    +        <MainUnitHasCreateFormStatements Value="False"/>
    +        <MainUnitHasTitleStatement Value="False"/>
    +        <LRSInOutputDirectory Value="False"/>
    +      </Flags>
    +      <SessionStorage Value="InProjectDir"/>
    +      <MainUnit Value="0"/>
    +      <Title Value="ppcx64"/>
    +    </General>
    +    <BuildModes Count="1">
    +      <Item1 Name="default" Default="True"/>
    +    </BuildModes>
    +    <PublishOptions>
    +      <Version Value="2"/>
    +      <DestinationDirectory Value="$(TestDir)\publishedproject\"/>
    +      <IncludeFileFilter Value="*.(pas|pp|inc|lfm|lpr|lrs|lpi|lpk|sh|xml)"/>
    +      <ExcludeFileFilter Value="*.(bak|ppu|ppw|o|so);*~;backup"/>
    +    </PublishOptions>
    +    <RunParams>
    +      <local>
    +        <FormatVersion Value="1"/>
    +        <LaunchingApplication PathPlusParams="/usr/X11R6/bin/xterm -T 'Lazarus Run Output' -e $(LazarusDir)/tools/runwait.sh $(TargetCmdLine)"/>
    +      </local>
    +    </RunParams>
    +    <Units Count="2">
    +      <Unit0>
    +        <Filename Value="pp.pas"/>
    +        <IsPartOfProject Value="True"/>
    +        <UnitName Value="pp"/>
    +      </Unit0>
    +      <Unit1>
    +        <Filename Value="x86\aasmcpu.pas"/>
    +        <IsPartOfProject Value="True"/>
    +        <UnitName Value="aasmcpu"/>
    +      </Unit1>
    +    </Units>
    +  </ProjectOptions>
    +  <CompilerOptions>
    +    <Version Value="11"/>
    +    <PathDelim Value="\"/>
    +    <Target>
    +      <Filename Value="x86_64\pp"/>
    +    </Target>
    +    <SearchPaths>
    +      <IncludeFiles Value="x86_64"/>
    +      <OtherUnitFiles Value="x86_64;x86;systems"/>
    +      <UnitOutputDirectory Value="x86_64\lazbuild"/>
    +    </SearchPaths>
    +    <Parsing>
    +      <SyntaxOptions>
    +        <CStyleOperator Value="False"/>
    +        <AllowLabel Value="False"/>
    +        <CPPInline Value="False"/>
    +        <UseAnsiStrings Value="False"/>
    +      </SyntaxOptions>
    +    </Parsing>
    +    <Other>
    +      <Verbosity>
    +        <ShowWarn Value="False"/>
    +        <ShowNotes Value="False"/>
    +        <ShowHints Value="False"/>
    +      </Verbosity>
    +      <ConfigFile>
    +        <StopAfterErrCount Value="50"/>
    +      </ConfigFile>
    +      <CustomOptions Value="-dx86_64 -gw -godwarfcpp"/>
    +      <CompilerPath Value="$(CompPath)"/>
    +    </Other>
    +  </CompilerOptions>
    +</CONFIG>
    diff --git a/compiler/symtable.pas b/compiler/symtable.pas
    index c7abd7da58..38f7777a12 100644
    --- a/compiler/symtable.pas
    +++ b/compiler/symtable.pas
    @@ -373,7 +373,7 @@ interface
         function  search_last_objectpascal_helper(pd : tdef;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 : tdef;contextclassh : tabstractrecorddef;const s : string; out srsym: tsym; out srsymtable: tsymtable):boolean;
    +    function  search_objectpascal_helper(pd : tdef;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, }
    @@ -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!) }
    -          result:=searchsym_in_class(tobjectdef(classh.extendeddef).childof,contextclassh,s,srsym,srsymtable,flags+[ssf_search_helper]);
    -          { addsymref is already called by searchsym_in_class }
    +          begin
    +            result:=searchsym_in_class(tobjectdef(classh.extendeddef).childof,contextclassh,s,srsym,srsymtable,flags+[ssf_search_helper]);
    +            { 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_objectdef(const s: string;classh : tobjectdef;contextclassh : tabstractrecorddef;out srsym: tsym; out srsymtable: tsymtable): boolean;
           var
    -        s: string;
    -        list: TFPObjectList;
    +        hashedid  : THashedIDString;
    +        pdef: tprocdef;
             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_objectdef(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
    -          exit;
    -
    -        hashedid.id:=s;
    -
    -        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;
    -                        { 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;
    +        if m_multi_helpers in current_settings.modeswitches then
    +          result := search_best_objectpascal_helper(s,pd,contextclassh,srsym,srsymtable)
    +        else
    +          begin
    +            if search_last_objectpascal_helper(pd,contextclassh,classh) and
    +               search_objectdef(s,classh,contextclassh,srsym,srsymtable) then
    +                result:=true;
    +          end;
     
    -        srsym:=nil;
    -        srsymtable:=nil;
    +        if result then
    +          begin
    +            { 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 (srsym.typ = procsym) and
    +               assigned(current_procinfo) and
    +               (srsym.owner.symtabletype=staticsymtable) then
    +              include(current_procinfo.flags,pi_uses_static_symtable);
    +            addsymref(srsym);
    +          end
    +        else
    +          begin
    +            srsym:=nil;
    +            srsymtable:=nil;
    +          end;
           end;
     
         function search_objc_helper(pd : tobjectdef;const s : string; out srsym: tsym; out srsymtable: tsymtable):boolean;
    diff --git a/tests/test/tmshlp1.pp b/tests/test/tmshlp1.pp
    new file mode 100644
    index 0000000000..efab230519
    --- /dev/null
    +++ b/tests/test/tmshlp1.pp
    @@ -0,0 +1,36 @@
    +{$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.
    diff --git a/tests/test/tmshlp10.pp b/tests/test/tmshlp10.pp
    new file mode 100644
    index 0000000000..db02f1e09f
    --- /dev/null
    +++ b/tests/test/tmshlp10.pp
    @@ -0,0 +1,36 @@
    +{$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.
    diff --git a/tests/test/tmshlp11.pp b/tests/test/tmshlp11.pp
    new file mode 100644
    index 0000000000..87b52f625a
    --- /dev/null
    +++ b/tests/test/tmshlp11.pp
    @@ -0,0 +1,38 @@
    +{$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.
    diff --git a/tests/test/tmshlp12.pp b/tests/test/tmshlp12.pp
    new file mode 100644
    index 0000000000..bdb3e6e9c0
    --- /dev/null
    +++ b/tests/test/tmshlp12.pp
    @@ -0,0 +1,37 @@
    +{%FAIL}
    +{$mode delphi}
    +{$modeswitch multihelpers}
    +
    +program tmshlp12;
    +
    +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.
    diff --git a/tests/test/tmshlp13.pp b/tests/test/tmshlp13.pp
    new file mode 100644
    index 0000000000..023b95252d
    --- /dev/null
    +++ b/tests/test/tmshlp13.pp
    @@ -0,0 +1,17 @@
    +{$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.
    diff --git a/tests/test/tmshlp14.pp b/tests/test/tmshlp14.pp
    new file mode 100644
    index 0000000000..26cf23e0d8
    --- /dev/null
    +++ b/tests/test/tmshlp14.pp
    @@ -0,0 +1,19 @@
    +{$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.
    diff --git a/tests/test/tmshlp2.pp b/tests/test/tmshlp2.pp
    new file mode 100644
    index 0000000000..177505f567
    --- /dev/null
    +++ b/tests/test/tmshlp2.pp
    @@ -0,0 +1,36 @@
    +{$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.
    diff --git a/tests/test/tmshlp3.pp b/tests/test/tmshlp3.pp
    new file mode 100644
    index 0000000000..ca030de79c
    --- /dev/null
    +++ b/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.
    \ No newline at end of file
    diff --git a/tests/test/tmshlp4.pp b/tests/test/tmshlp4.pp
    new file mode 100644
    index 0000000000..c90995a09d
    --- /dev/null
    +++ b/tests/test/tmshlp4.pp
    @@ -0,0 +1,48 @@
    +{$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.
    diff --git a/tests/test/tmshlp5.pp b/tests/test/tmshlp5.pp
    new file mode 100644
    index 0000000000..d0dc99b607
    --- /dev/null
    +++ b/tests/test/tmshlp5.pp
    @@ -0,0 +1,35 @@
    +{$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.
    diff --git a/tests/test/tmshlp6.pp b/tests/test/tmshlp6.pp
    new file mode 100644
    index 0000000000..ff10addbfe
    --- /dev/null
    +++ b/tests/test/tmshlp6.pp
    @@ -0,0 +1,35 @@
    +{$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.
    diff --git a/tests/test/tmshlp7.pp b/tests/test/tmshlp7.pp
    new file mode 100644
    index 0000000000..5702b0959a
    --- /dev/null
    +++ b/tests/test/tmshlp7.pp
    @@ -0,0 +1,27 @@
    +{$mode objfpc}
    +{$modeswitch advancedrecords}
    +{$modeswitch typehelpers}
    +
    +unit tmshlp7;
    +interface
    +
    +type
    +	TExtClassHelper = class helper for TObject
    +		procedure DoThisExt;
    +	end;
    +	TExtStringHelper = type helper for String
    +		function LengthExt: integer;
    +	end;
    +
    +implementation
    +	
    +procedure TExtClassHelper.DoThisExt;
    +begin	
    +end;
    +
    +function TExtStringHelper.LengthExt: integer;
    +begin
    +	result := System.Length(self);
    +end;
    +
    +end.
    diff --git a/tests/test/tmshlp8.pp b/tests/test/tmshlp8.pp
    new file mode 100644
    index 0000000000..242a54b968
    --- /dev/null
    +++ b/tests/test/tmshlp8.pp
    @@ -0,0 +1,34 @@
    +{$mode objfpc}
    +{$modeswitch typehelpers}
    +{$modeswitch multihelpers}
    +
    +program tmshlp8;
    +uses
    +	tmshlp7;
    +
    +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);
    +end.
    diff --git a/tests/test/tmshlp9.pp b/tests/test/tmshlp9.pp
    new file mode 100644
    index 0000000000..dbd830e425
    --- /dev/null
    +++ b/tests/test/tmshlp9.pp
    @@ -0,0 +1,36 @@
    +{$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.
    -- 
    2.17.2 (Apple Git-113)
    
    
    multi-helpers.diff (31,413 bytes)
  • patch_3_25.diff (29,042 bytes)
    From ffe084bc0381046531b64a005f38a0698f985ba2 Mon Sep 17 00:00:00 2001
    From: Ryan Joseph <genericptr@gmail.com>
    Date: Wed, 21 Nov 2018 14:14:14 +0700
    Subject: [PATCH] multi-helpers
    
    ---
     .gitignore             |  24 ++++++
     compiler/globtype.pas  |   6 +-
     compiler/htypechk.pas  |  62 +++++++++----
     compiler/pexpr.pas     |   4 +-
     compiler/ppu.pas       |   2 +-
     compiler/symtable.pas  | 192 ++++++++++++++++++++++++++---------------
     tests/test/tmshlp1.pp  |  36 ++++++++
     tests/test/tmshlp10.pp |  36 ++++++++
     tests/test/tmshlp11.pp |  38 ++++++++
     tests/test/tmshlp12.pp |  37 ++++++++
     tests/test/tmshlp13.pp |  17 ++++
     tests/test/tmshlp14.pp |  19 ++++
     tests/test/tmshlp2.pp  |  36 ++++++++
     tests/test/tmshlp3.pp  |  32 +++++++
     tests/test/tmshlp4.pp  |  48 +++++++++++
     tests/test/tmshlp5.pp  |  35 ++++++++
     tests/test/tmshlp6.pp  |  35 ++++++++
     tests/test/tmshlp7.pp  |  27 ++++++
     tests/test/tmshlp8.pp  |  34 ++++++++
     tests/test/tmshlp9.pp  |  36 ++++++++
     20 files changed, 665 insertions(+), 91 deletions(-)
     create mode 100644 .gitignore
     create mode 100644 tests/test/tmshlp1.pp
     create mode 100644 tests/test/tmshlp10.pp
     create mode 100644 tests/test/tmshlp11.pp
     create mode 100644 tests/test/tmshlp12.pp
     create mode 100644 tests/test/tmshlp13.pp
     create mode 100644 tests/test/tmshlp14.pp
     create mode 100644 tests/test/tmshlp2.pp
     create mode 100644 tests/test/tmshlp3.pp
     create mode 100644 tests/test/tmshlp4.pp
     create mode 100644 tests/test/tmshlp5.pp
     create mode 100644 tests/test/tmshlp6.pp
     create mode 100644 tests/test/tmshlp7.pp
     create mode 100644 tests/test/tmshlp8.pp
     create mode 100644 tests/test/tmshlp9.pp
    
    diff --git a/.gitignore b/.gitignore
    new file mode 100644
    index 0000000000..16d38503e5
    --- /dev/null
    +++ b/.gitignore
    @@ -0,0 +1,24 @@
    +# files
    +pp
    +fpmake
    +rtl/darwin/fpcmade.x86_64-darwin
    +fpmake_proc1 copy.inc
    +tests/*.x86_64-darwin
    +rtl/Package.fpc
    +tests/createlst
    +tests/gparmake
    +compiler/ryan_ppcx64.lpi
    +
    +# directories
    +lazbuild/
    +x86_64-darwin/
    +tests/tstunits/
    +tests/utils
    +
    +# patterns
    +*.app
    +*.o
    +*.ppu
    +*.fpm
    +*.rsj
    +*.lst
    \ No newline at end of file
    diff --git a/compiler/globtype.pas b/compiler/globtype.pas
    index 7d23464d57..c1e530d5b1 100644
    --- a/compiler/globtype.pas
    +++ b/compiler/globtype.pas
    @@ -446,7 +446,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;
     
    @@ -635,7 +636,8 @@ interface
              'ISOIO',
              'ISOPROGRAMPARAS',
              'ISOMOD',
    -         'ARRAYOPERATORS'
    +         'ARRAYOPERATORS',
    +         'MULTIHELPERS'
              );
     
     
    diff --git a/compiler/htypechk.pas b/compiler/htypechk.pas
    index 07c035dc26..06c0ca4b5c 100644
    --- a/compiler/htypechk.pas
    +++ b/compiler/htypechk.pas
    @@ -2234,6 +2234,33 @@ implementation
                     ProcdefOverloadList.Add(pd);
                 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;
    @@ -2242,6 +2269,8 @@ implementation
             foundanything : boolean;
             extendeddef : tabstractrecorddef;
             helperdef  : tobjectdef;
    +        helperlist : TFPObjectList;
    +        i : integer;
           begin
             if FOperator=NOTOKEN then
               hashedid.id:=FProcsym.name
    @@ -2261,27 +2290,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;
    -                   while assigned(helperdef) do
    +                   helperlist:=get_objectpascal_helpers(structdef);
    +                   if assigned(helperlist) and (helperlist.count>0) then
                          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;
    +                       i:=helperlist.count-1;
    +                       repeat
    +                         helperdef:=tobjectdef(helperlist[i]);
    +                         if (helperdef.owner.symtabletype in [staticsymtable,globalsymtable]) or
    +                            is_visible_for_object(helperdef.typesym,helperdef) then
    +                              if processhelper(hashedid,helperdef) then
    +                                exit;
    +                         dec(i);
    +                       until (i<0);
                          end;
    -                   if not hasoverload and assigned(srsym) then
    -                     exit;
    -                 end;
    +                 end
    +               else if search_last_objectpascal_helper(structdef,nil,helperdef) and processhelper(hashedid,helperdef) then
    +                  exit;
                  end;
                { now search in the type itself }
                srsym:=tsym(structdef.symtable.FindWithHash(hashedid));
    diff --git a/compiler/pexpr.pas b/compiler/pexpr.pas
    index bc0606ed4b..39bb5e1de5 100644
    --- a/compiler/pexpr.pas
    +++ b/compiler/pexpr.pas
    @@ -76,7 +76,7 @@ implementation
            fmodule,ppu,
            { pass 1 }
            pass_1,
    -       nmat,nadd,nmem,nset,ncnv,ninl,ncon,nld,nflw,nbas,nutils,
    +       nmat,nadd,nmem,nset,ncnv,ninl,ncon,nld,nflw,nbas,nutils,htypechk,
            { parser }
            scanner,
            pbase,pinline,ptype,pgenutil,procinfo,cpuinfo
    @@ -962,7 +962,6 @@ implementation
              end;
           end;
     
    -
         { reads the parameter for a subroutine call }
         procedure do_proc_call(sym:tsym;st:TSymtable;obj:tabstractrecorddef;getaddr:boolean;var again : boolean;var p1:tnode;callflags:tcallnodeflags;spezcontext:tspecializationcontext);
           var
    @@ -1932,6 +1931,7 @@ implementation
                       def:=voidpointertype
                     else
                       def:=node.resultdef;
    +              { allow multiscope searches }
                   result:=search_objectpascal_helper(def,nil,pattern,srsym,srsymtable);
                   if result then
                     begin
    diff --git a/compiler/ppu.pas b/compiler/ppu.pas
    index 10c42e7eb8..31011be3e8 100644
    --- a/compiler/ppu.pas
    +++ b/compiler/ppu.pas
    @@ -43,7 +43,7 @@ type
     {$endif Test_Double_checksum}
     
     const
    -  CurrentPPUVersion = 201;
    +  CurrentPPUVersion = 203;
     
     { unit flags }
       uf_init                = $000001; { unit has initialization section }
    diff --git a/compiler/symtable.pas b/compiler/symtable.pas
    index 796b2d6736..f654b2ee46 100644
    --- a/compiler/symtable.pas
    +++ b/compiler/symtable.pas
    @@ -358,7 +358,7 @@ interface
         function  search_last_objectpascal_helper(pd : tdef;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 : tdef;contextclassh : tabstractrecorddef;const s : string; out srsym: tsym; out srsymtable: tsymtable):boolean;
    +    function  search_objectpascal_helper(pd : tdef;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, }
    @@ -368,6 +368,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;
    @@ -3694,6 +3696,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;
    @@ -3755,10 +3759,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!) }
    -          result:=searchsym_in_class(tobjectdef(classh.extendeddef).childof,contextclassh,s,srsym,srsymtable,flags+[ssf_search_helper]);
    -          { addsymref is already called by searchsym_in_class }
    +          begin
    +            result:=searchsym_in_class(tobjectdef(classh.extendeddef).childof,contextclassh,s,srsym,srsymtable,flags+[ssf_search_helper]);
    +            { 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;
    @@ -3971,15 +3982,59 @@ implementation
               end;
           end;
     
    -    function search_last_objectpascal_helper(pd : tdef;contextclassh : tabstractrecorddef;out odef : tobjectdef):boolean;
    +    function search_objectdef(const s: string;classh : tobjectdef;contextclassh : tabstractrecorddef;out srsym: tsym; out srsymtable: tsymtable): boolean;
           var
    -        s: string;
    -        list: TFPObjectList;
    +        hashedid  : THashedIDString;
    +        pdef: tprocdef;
             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
    @@ -4002,7 +4057,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_objectdef(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;
    @@ -4019,72 +4109,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
    -          exit;
    -
    -        hashedid.id:=s;
    -
    -        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;
    -                        { 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;
    +        if m_multi_helpers in current_settings.modeswitches then
    +          result := search_best_objectpascal_helper(s,pd,contextclassh,srsym,srsymtable)
    +        else
    +          begin
    +            if search_last_objectpascal_helper(pd,contextclassh,classh) and
    +               search_objectdef(s,classh,contextclassh,srsym,srsymtable) then
    +                result:=true;
    +          end;
     
    -        srsym:=nil;
    -        srsymtable:=nil;
    +        if result then
    +          begin
    +            { 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 (srsym.typ = procsym) and
    +               assigned(current_procinfo) and
    +               (srsym.owner.symtabletype=staticsymtable) then
    +              include(current_procinfo.flags,pi_uses_static_symtable);
    +            addsymref(srsym);
    +          end
    +        else
    +          begin
    +            srsym:=nil;
    +            srsymtable:=nil;
    +          end;
           end;
     
         function search_objc_helper(pd : tobjectdef;const s : string; out srsym: tsym; out srsymtable: tsymtable):boolean;
    diff --git a/tests/test/tmshlp1.pp b/tests/test/tmshlp1.pp
    new file mode 100644
    index 0000000000..efab230519
    --- /dev/null
    +++ b/tests/test/tmshlp1.pp
    @@ -0,0 +1,36 @@
    +{$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.
    diff --git a/tests/test/tmshlp10.pp b/tests/test/tmshlp10.pp
    new file mode 100644
    index 0000000000..db02f1e09f
    --- /dev/null
    +++ b/tests/test/tmshlp10.pp
    @@ -0,0 +1,36 @@
    +{$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.
    diff --git a/tests/test/tmshlp11.pp b/tests/test/tmshlp11.pp
    new file mode 100644
    index 0000000000..87b52f625a
    --- /dev/null
    +++ b/tests/test/tmshlp11.pp
    @@ -0,0 +1,38 @@
    +{$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.
    diff --git a/tests/test/tmshlp12.pp b/tests/test/tmshlp12.pp
    new file mode 100644
    index 0000000000..bdb3e6e9c0
    --- /dev/null
    +++ b/tests/test/tmshlp12.pp
    @@ -0,0 +1,37 @@
    +{%FAIL}
    +{$mode delphi}
    +{$modeswitch multihelpers}
    +
    +program tmshlp12;
    +
    +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.
    diff --git a/tests/test/tmshlp13.pp b/tests/test/tmshlp13.pp
    new file mode 100644
    index 0000000000..023b95252d
    --- /dev/null
    +++ b/tests/test/tmshlp13.pp
    @@ -0,0 +1,17 @@
    +{$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.
    diff --git a/tests/test/tmshlp14.pp b/tests/test/tmshlp14.pp
    new file mode 100644
    index 0000000000..26cf23e0d8
    --- /dev/null
    +++ b/tests/test/tmshlp14.pp
    @@ -0,0 +1,19 @@
    +{$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.
    diff --git a/tests/test/tmshlp2.pp b/tests/test/tmshlp2.pp
    new file mode 100644
    index 0000000000..177505f567
    --- /dev/null
    +++ b/tests/test/tmshlp2.pp
    @@ -0,0 +1,36 @@
    +{$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.
    diff --git a/tests/test/tmshlp3.pp b/tests/test/tmshlp3.pp
    new file mode 100644
    index 0000000000..ca030de79c
    --- /dev/null
    +++ b/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.
    \ No newline at end of file
    diff --git a/tests/test/tmshlp4.pp b/tests/test/tmshlp4.pp
    new file mode 100644
    index 0000000000..c90995a09d
    --- /dev/null
    +++ b/tests/test/tmshlp4.pp
    @@ -0,0 +1,48 @@
    +{$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.
    diff --git a/tests/test/tmshlp5.pp b/tests/test/tmshlp5.pp
    new file mode 100644
    index 0000000000..d0dc99b607
    --- /dev/null
    +++ b/tests/test/tmshlp5.pp
    @@ -0,0 +1,35 @@
    +{$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.
    diff --git a/tests/test/tmshlp6.pp b/tests/test/tmshlp6.pp
    new file mode 100644
    index 0000000000..ff10addbfe
    --- /dev/null
    +++ b/tests/test/tmshlp6.pp
    @@ -0,0 +1,35 @@
    +{$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.
    diff --git a/tests/test/tmshlp7.pp b/tests/test/tmshlp7.pp
    new file mode 100644
    index 0000000000..5702b0959a
    --- /dev/null
    +++ b/tests/test/tmshlp7.pp
    @@ -0,0 +1,27 @@
    +{$mode objfpc}
    +{$modeswitch advancedrecords}
    +{$modeswitch typehelpers}
    +
    +unit tmshlp7;
    +interface
    +
    +type
    +	TExtClassHelper = class helper for TObject
    +		procedure DoThisExt;
    +	end;
    +	TExtStringHelper = type helper for String
    +		function LengthExt: integer;
    +	end;
    +
    +implementation
    +	
    +procedure TExtClassHelper.DoThisExt;
    +begin	
    +end;
    +
    +function TExtStringHelper.LengthExt: integer;
    +begin
    +	result := System.Length(self);
    +end;
    +
    +end.
    diff --git a/tests/test/tmshlp8.pp b/tests/test/tmshlp8.pp
    new file mode 100644
    index 0000000000..242a54b968
    --- /dev/null
    +++ b/tests/test/tmshlp8.pp
    @@ -0,0 +1,34 @@
    +{$mode objfpc}
    +{$modeswitch typehelpers}
    +{$modeswitch multihelpers}
    +
    +program tmshlp8;
    +uses
    +	tmshlp7;
    +
    +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);
    +end.
    diff --git a/tests/test/tmshlp9.pp b/tests/test/tmshlp9.pp
    new file mode 100644
    index 0000000000..dbd830e425
    --- /dev/null
    +++ b/tests/test/tmshlp9.pp
    @@ -0,0 +1,36 @@
    +{$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.
    -- 
    2.17.2 (Apple Git-113)
    
    
    patch_3_25.diff (29,042 bytes)
  • patch_4_10.diff (28,064 bytes)
    From 4a98247d2b2ab6a4db7ab3e60ffa6da05d3d6906 Mon Sep 17 00:00:00 2001
    From: Ryan Joseph <genericptr@gmail.com>
    Date: Wed, 21 Nov 2018 14:14:14 +0700
    Subject: [PATCH] multi-helpers
    
    ---
     compiler/globtype.pas  |   6 +-
     compiler/htypechk.pas  |  62 +++++++++----
     compiler/symtable.pas  | 192 ++++++++++++++++++++++++++---------------
     tests/test/tmshlp1.pp  |  36 ++++++++
     tests/test/tmshlp10.pp |  36 ++++++++
     tests/test/tmshlp11.pp |  38 ++++++++
     tests/test/tmshlp12.pp |  43 +++++++++
     tests/test/tmshlp13.pp |  17 ++++
     tests/test/tmshlp14.pp |  19 ++++
     tests/test/tmshlp2.pp  |  36 ++++++++
     tests/test/tmshlp3.pp  |  32 +++++++
     tests/test/tmshlp4.pp  |  48 +++++++++++
     tests/test/tmshlp5.pp  |  35 ++++++++
     tests/test/tmshlp6.pp  |  35 ++++++++
     tests/test/tmshlp7.pp  |  36 ++++++++
     tests/test/tmshlp8.pp  |  34 ++++++++
     tests/test/tmshlp9.pp  |  36 ++++++++
     tests/test/umshlp1.pp  |  35 ++++++++
     18 files changed, 688 insertions(+), 88 deletions(-)
     create mode 100644 tests/test/tmshlp1.pp
     create mode 100644 tests/test/tmshlp10.pp
     create mode 100644 tests/test/tmshlp11.pp
     create mode 100644 tests/test/tmshlp12.pp
     create mode 100644 tests/test/tmshlp13.pp
     create mode 100644 tests/test/tmshlp14.pp
     create mode 100644 tests/test/tmshlp2.pp
     create mode 100644 tests/test/tmshlp3.pp
     create mode 100644 tests/test/tmshlp4.pp
     create mode 100644 tests/test/tmshlp5.pp
     create mode 100644 tests/test/tmshlp6.pp
     create mode 100644 tests/test/tmshlp7.pp
     create mode 100644 tests/test/tmshlp8.pp
     create mode 100644 tests/test/tmshlp9.pp
     create mode 100644 tests/test/umshlp1.pp
    
    diff --git a/compiler/globtype.pas b/compiler/globtype.pas
    index 7d23464d57..c1e530d5b1 100644
    --- a/compiler/globtype.pas
    +++ b/compiler/globtype.pas
    @@ -446,7 +446,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;
     
    @@ -635,7 +636,8 @@ interface
              'ISOIO',
              'ISOPROGRAMPARAS',
              'ISOMOD',
    -         'ARRAYOPERATORS'
    +         'ARRAYOPERATORS',
    +         'MULTIHELPERS'
              );
     
     
    diff --git a/compiler/htypechk.pas b/compiler/htypechk.pas
    index 07c035dc26..06c0ca4b5c 100644
    --- a/compiler/htypechk.pas
    +++ b/compiler/htypechk.pas
    @@ -2234,6 +2234,33 @@ implementation
                     ProcdefOverloadList.Add(pd);
                 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;
    @@ -2242,6 +2269,8 @@ implementation
             foundanything : boolean;
             extendeddef : tabstractrecorddef;
             helperdef  : tobjectdef;
    +        helperlist : TFPObjectList;
    +        i : integer;
           begin
             if FOperator=NOTOKEN then
               hashedid.id:=FProcsym.name
    @@ -2261,27 +2290,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;
    -                   while assigned(helperdef) do
    +                   helperlist:=get_objectpascal_helpers(structdef);
    +                   if assigned(helperlist) and (helperlist.count>0) then
                          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;
    +                       i:=helperlist.count-1;
    +                       repeat
    +                         helperdef:=tobjectdef(helperlist[i]);
    +                         if (helperdef.owner.symtabletype in [staticsymtable,globalsymtable]) or
    +                            is_visible_for_object(helperdef.typesym,helperdef) then
    +                              if processhelper(hashedid,helperdef) then
    +                                exit;
    +                         dec(i);
    +                       until (i<0);
                          end;
    -                   if not hasoverload and assigned(srsym) then
    -                     exit;
    -                 end;
    +                 end
    +               else if search_last_objectpascal_helper(structdef,nil,helperdef) and processhelper(hashedid,helperdef) then
    +                  exit;
                  end;
                { now search in the type itself }
                srsym:=tsym(structdef.symtable.FindWithHash(hashedid));
    diff --git a/compiler/symtable.pas b/compiler/symtable.pas
    index 796b2d6736..53544977e1 100644
    --- a/compiler/symtable.pas
    +++ b/compiler/symtable.pas
    @@ -358,7 +358,7 @@ interface
         function  search_last_objectpascal_helper(pd : tdef;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 : tdef;contextclassh : tabstractrecorddef;const s : string; out srsym: tsym; out srsymtable: tsymtable):boolean;
    +    function  search_objectpascal_helper(pd : tdef;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, }
    @@ -368,6 +368,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;
    @@ -3694,6 +3696,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;
    @@ -3755,10 +3759,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!) }
    -          result:=searchsym_in_class(tobjectdef(classh.extendeddef).childof,contextclassh,s,srsym,srsymtable,flags+[ssf_search_helper]);
    -          { addsymref is already called by searchsym_in_class }
    +          begin
    +            result:=searchsym_in_class(tobjectdef(classh.extendeddef).childof,contextclassh,s,srsym,srsymtable,flags+[ssf_search_helper]);
    +            { 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;
    @@ -3971,15 +3982,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;
    -        list: TFPObjectList;
    +        hashedid  : THashedIDString;
    +        pdef: tprocdef;
             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
    @@ -4002,7 +4057,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;
    @@ -4019,72 +4109,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
    -          exit;
    -
    -        hashedid.id:=s;
    -
    -        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;
    -                        { 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;
    +        if m_multi_helpers in current_settings.modeswitches then
    +          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;
     
    -        srsym:=nil;
    -        srsymtable:=nil;
    +        if result then
    +          begin
    +            { 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 (srsym.typ = procsym) and
    +               assigned(current_procinfo) and
    +               (srsym.owner.symtabletype=staticsymtable) then
    +              include(current_procinfo.flags,pi_uses_static_symtable);
    +            addsymref(srsym);
    +          end
    +        else
    +          begin
    +            srsym:=nil;
    +            srsymtable:=nil;
    +          end;
           end;
     
         function search_objc_helper(pd : tobjectdef;const s : string; out srsym: tsym; out srsymtable: tsymtable):boolean;
    diff --git a/tests/test/tmshlp1.pp b/tests/test/tmshlp1.pp
    new file mode 100644
    index 0000000000..efab230519
    --- /dev/null
    +++ b/tests/test/tmshlp1.pp
    @@ -0,0 +1,36 @@
    +{$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.
    diff --git a/tests/test/tmshlp10.pp b/tests/test/tmshlp10.pp
    new file mode 100644
    index 0000000000..db02f1e09f
    --- /dev/null
    +++ b/tests/test/tmshlp10.pp
    @@ -0,0 +1,36 @@
    +{$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.
    diff --git a/tests/test/tmshlp11.pp b/tests/test/tmshlp11.pp
    new file mode 100644
    index 0000000000..87b52f625a
    --- /dev/null
    +++ b/tests/test/tmshlp11.pp
    @@ -0,0 +1,38 @@
    +{$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.
    diff --git a/tests/test/tmshlp12.pp b/tests/test/tmshlp12.pp
    new file mode 100644
    index 0000000000..6483db996f
    --- /dev/null
    +++ b/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.
    diff --git a/tests/test/tmshlp13.pp b/tests/test/tmshlp13.pp
    new file mode 100644
    index 0000000000..023b95252d
    --- /dev/null
    +++ b/tests/test/tmshlp13.pp
    @@ -0,0 +1,17 @@
    +{$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.
    diff --git a/tests/test/tmshlp14.pp b/tests/test/tmshlp14.pp
    new file mode 100644
    index 0000000000..26cf23e0d8
    --- /dev/null
    +++ b/tests/test/tmshlp14.pp
    @@ -0,0 +1,19 @@
    +{$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.
    diff --git a/tests/test/tmshlp2.pp b/tests/test/tmshlp2.pp
    new file mode 100644
    index 0000000000..177505f567
    --- /dev/null
    +++ b/tests/test/tmshlp2.pp
    @@ -0,0 +1,36 @@
    +{$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.
    diff --git a/tests/test/tmshlp3.pp b/tests/test/tmshlp3.pp
    new file mode 100644
    index 0000000000..ca030de79c
    --- /dev/null
    +++ b/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.
    \ No newline at end of file
    diff --git a/tests/test/tmshlp4.pp b/tests/test/tmshlp4.pp
    new file mode 100644
    index 0000000000..c90995a09d
    --- /dev/null
    +++ b/tests/test/tmshlp4.pp
    @@ -0,0 +1,48 @@
    +{$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.
    diff --git a/tests/test/tmshlp5.pp b/tests/test/tmshlp5.pp
    new file mode 100644
    index 0000000000..d0dc99b607
    --- /dev/null
    +++ b/tests/test/tmshlp5.pp
    @@ -0,0 +1,35 @@
    +{$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.
    diff --git a/tests/test/tmshlp6.pp b/tests/test/tmshlp6.pp
    new file mode 100644
    index 0000000000..ff10addbfe
    --- /dev/null
    +++ b/tests/test/tmshlp6.pp
    @@ -0,0 +1,35 @@
    +{$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.
    diff --git a/tests/test/tmshlp7.pp b/tests/test/tmshlp7.pp
    new file mode 100644
    index 0000000000..d475a503b6
    --- /dev/null
    +++ b/tests/test/tmshlp7.pp
    @@ -0,0 +1,36 @@
    +{$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.
    diff --git a/tests/test/tmshlp8.pp b/tests/test/tmshlp8.pp
    new file mode 100644
    index 0000000000..9473b5e9fb
    --- /dev/null
    +++ b/tests/test/tmshlp8.pp
    @@ -0,0 +1,34 @@
    +{$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.
    diff --git a/tests/test/tmshlp9.pp b/tests/test/tmshlp9.pp
    new file mode 100644
    index 0000000000..dbd830e425
    --- /dev/null
    +++ b/tests/test/tmshlp9.pp
    @@ -0,0 +1,36 @@
    +{$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.
    diff --git a/tests/test/umshlp1.pp b/tests/test/umshlp1.pp
    new file mode 100644
    index 0000000000..29766816bb
    --- /dev/null
    +++ b/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.
    -- 
    2.17.2 (Apple Git-113)
    
    
    patch_4_10.diff (28,064 bytes)

Activities

Ryan Joseph

2019-02-27 15:36

reporter  

patch.diff (88,644 bytes)
From fbf8f8df8af5d1b41f17152213a69fe657b1ae33 Mon Sep 17 00:00:00 2001
From: Ryan Joseph <genericptr@gmail.com>
Date: Wed, 21 Nov 2018 14:14:14 +0700
Subject: [PATCH 01/12] first draft (no overload support)

---
 .gitignore               |   8 ++
 compiler/globtype.pas    |   6 +-
 compiler/ncal.pas        |   2 +
 compiler/pexpr.pas       |   3 +
 compiler/ryan_ppcx64.lpi |  77 +++++++++++++++++
 compiler/symtable.pas    | 179 ++++++++++++++++++++++++++-------------
 6 files changed, 215 insertions(+), 60 deletions(-)
 create mode 100644 .gitignore
 create mode 100644 compiler/ryan_ppcx64.lpi

diff --git a/.gitignore b/.gitignore
new file mode 100644
index 0000000000..5f32ec99e7
--- /dev/null
+++ b/.gitignore
@@ -0,0 +1,8 @@
+# Ignore everything
+*
+
+# But not these files...
+!.gitignore
+!.pas
+!.pp
+!ryan_*.lpi
\ No newline at end of file
diff --git a/compiler/globtype.pas b/compiler/globtype.pas
index 7d23464d57..f154532a5f 100644
--- a/compiler/globtype.pas
+++ b/compiler/globtype.pas
@@ -446,7 +446,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_multiscope_helpers   { ObjFPC mode only - helpers can appear in multiple scopes simultaneously }
        );
        tmodeswitches = set of tmodeswitch;
 
@@ -635,7 +636,8 @@ interface
          'ISOIO',
          'ISOPROGRAMPARAS',
          'ISOMOD',
-         'ARRAYOPERATORS'
+         'ARRAYOPERATORS',
+         'MULTISCOPEHELPERS'
          );
 
 
diff --git a/compiler/ncal.pas b/compiler/ncal.pas
index 0984293d8b..22a1e4d4c5 100644
--- a/compiler/ncal.pas
+++ b/compiler/ncal.pas
@@ -3599,6 +3599,8 @@ implementation
                    ignorevisibility:=(nf_isproperty in flags) or
                                      ((m_delphi in current_settings.modeswitches) and (cnf_anon_inherited in callnodeflags)) or
                                      (cnf_ignore_visibility in callnodeflags);
+                   if symtableprocentry.realname = 'DoThis' then
+                   writeln(symtableprocentry.realname);                  
                    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]=[],cnf_anon_inherited in callnodeflags,spezcontext);
diff --git a/compiler/pexpr.pas b/compiler/pexpr.pas
index bc0606ed4b..e92fed78cb 100644
--- a/compiler/pexpr.pas
+++ b/compiler/pexpr.pas
@@ -1099,6 +1099,9 @@ implementation
                begin
                  if not (st.symtabletype in [ObjectSymtable,recordsymtable]) then
                    internalerror(200310031);
+                 // note: ryan
+                 // does obj have an overload for the params? if not
+                 // search helpers with param and change obj
                  p1:=ccallnode.create(para,tprocsym(sym),obj.symtable,p1,callflags,spezcontext);
                end
              else
diff --git a/compiler/ryan_ppcx64.lpi b/compiler/ryan_ppcx64.lpi
new file mode 100644
index 0000000000..6a6220e7d5
--- /dev/null
+++ b/compiler/ryan_ppcx64.lpi
@@ -0,0 +1,77 @@
+<?xml version="1.0"?>
+<CONFIG>
+  <ProjectOptions>
+    <Version Value="9"/>
+    <PathDelim Value="\"/>
+    <General>
+      <Flags>
+        <MainUnitHasUsesSectionForAllUnits Value="False"/>
+        <MainUnitHasCreateFormStatements Value="False"/>
+        <MainUnitHasTitleStatement Value="False"/>
+        <LRSInOutputDirectory Value="False"/>
+      </Flags>
+      <SessionStorage Value="InProjectDir"/>
+      <MainUnit Value="0"/>
+      <Title Value="ppcx64"/>
+    </General>
+    <BuildModes Count="1">
+      <Item1 Name="default" Default="True"/>
+    </BuildModes>
+    <PublishOptions>
+      <Version Value="2"/>
+      <DestinationDirectory Value="$(TestDir)\publishedproject\"/>
+      <IncludeFileFilter Value="*.(pas|pp|inc|lfm|lpr|lrs|lpi|lpk|sh|xml)"/>
+      <ExcludeFileFilter Value="*.(bak|ppu|ppw|o|so);*~;backup"/>
+    </PublishOptions>
+    <RunParams>
+      <local>
+        <FormatVersion Value="1"/>
+        <LaunchingApplication PathPlusParams="/usr/X11R6/bin/xterm -T 'Lazarus Run Output' -e $(LazarusDir)/tools/runwait.sh $(TargetCmdLine)"/>
+      </local>
+    </RunParams>
+    <Units Count="2">
+      <Unit0>
+        <Filename Value="pp.pas"/>
+        <IsPartOfProject Value="True"/>
+        <UnitName Value="pp"/>
+      </Unit0>
+      <Unit1>
+        <Filename Value="x86\aasmcpu.pas"/>
+        <IsPartOfProject Value="True"/>
+        <UnitName Value="aasmcpu"/>
+      </Unit1>
+    </Units>
+  </ProjectOptions>
+  <CompilerOptions>
+    <Version Value="11"/>
+    <PathDelim Value="\"/>
+    <Target>
+      <Filename Value="x86_64\pp"/>
+    </Target>
+    <SearchPaths>
+      <IncludeFiles Value="x86_64"/>
+      <OtherUnitFiles Value="x86_64;x86;systems"/>
+      <UnitOutputDirectory Value="x86_64\lazbuild"/>
+    </SearchPaths>
+    <Parsing>
+      <SyntaxOptions>
+        <CStyleOperator Value="False"/>
+        <AllowLabel Value="False"/>
+        <CPPInline Value="False"/>
+        <UseAnsiStrings Value="False"/>
+      </SyntaxOptions>
+    </Parsing>
+    <Other>
+      <Verbosity>
+        <ShowWarn Value="False"/>
+        <ShowNotes Value="False"/>
+        <ShowHints Value="False"/>
+      </Verbosity>
+      <ConfigFile>
+        <StopAfterErrCount Value="50"/>
+      </ConfigFile>
+      <CustomOptions Value="-dx86_64 -gw -godwarfcpp"/>
+      <CompilerPath Value="$(CompPath)"/>
+    </Other>
+  </CompilerOptions>
+</CONFIG>
diff --git a/compiler/symtable.pas b/compiler/symtable.pas
index 796b2d6736..452d1a8775 100644
--- a/compiler/symtable.pas
+++ b/compiler/symtable.pas
@@ -3971,6 +3971,100 @@ implementation
           end;
       end;
 
+    // note: ryan
+    function search_objectdef(const s: string;classh : tobjectdef;contextclassh : tabstractrecorddef;out srsym: tsym; out srsymtable: tsymtable): boolean;
+      var
+        hashedid  : THashedIDString;
+        pdef: tprocdef;
+        i: integer;
+      begin
+        hashedid.id:=s;
+        result:=false;
+        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 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;
+        { 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 ((pd.typ in [recorddef,objectdef]) and
+            (
+              not assigned(tabstractrecorddef(pd).objrealname) or
+              (tabstractrecorddef(pd).objrealname^='')
+            )
+           ) or
+           not assigned(pd.typesym) 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:=generate_objectpascal_helper_key(pd);
+        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}i]);
+              result:=(odef.owner.symtabletype in [staticsymtable,globalsymtable]) or
+                      is_visible_for_object(tobjectdef(list[i]).typesym,contextclassh);
+              if result then
+                result := search_objectdef(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;
@@ -4019,72 +4113,41 @@ 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
-          exit;
-
-        hashedid.id:=s;
-
-        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;
-                        { 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;
+        // note: ryan
+        if m_multiscope_helpers in current_settings.modeswitches then
+          begin
+            result := search_best_objectpascal_helper(s,pd,contextclassh,srsym,srsymtable);
+          end
+        else
+          begin
+            if search_last_objectpascal_helper(pd,contextclassh,classh) and
+               search_objectdef(s,classh,contextclassh,srsym,srsymtable) then
+                result:=true;
+          end;
 
-        srsym:=nil;
-        srsymtable:=nil;
+        if result then
+          begin
+            { 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 (srsym.typ = procsym) and
+               assigned(current_procinfo) and
+               (srsym.owner.symtabletype=staticsymtable) then
+              include(current_procinfo.flags,pi_uses_static_symtable);
+            addsymref(srsym);
+          end
+        else
+          begin
+            srsym:=nil;
+            srsymtable:=nil;
+          end;
       end;
 
     function search_objc_helper(pd : tobjectdef;const s : string; out srsym: tsym; out srsymtable: tsymtable):boolean;
-- 
2.17.2 (Apple Git-113)


From 0d705f89ae57912a09c4cb5ea14bb33e14ecbe46 Mon Sep 17 00:00:00 2001
From: Ryan Joseph <genericptr@gmail.com>
Date: Wed, 21 Nov 2018 21:30:52 +0700
Subject: [PATCH 02/12] first draft with proc overloads

---
 compiler/ncal.pas     |   2 -
 compiler/pexpr.pas    | 154 +++++++++++++++++++++++++++++++++++++++++-
 compiler/symtable.pas |   2 +-
 3 files changed, 152 insertions(+), 6 deletions(-)

diff --git a/compiler/ncal.pas b/compiler/ncal.pas
index 22a1e4d4c5..0984293d8b 100644
--- a/compiler/ncal.pas
+++ b/compiler/ncal.pas
@@ -3599,8 +3599,6 @@ implementation
                    ignorevisibility:=(nf_isproperty in flags) or
                                      ((m_delphi in current_settings.modeswitches) and (cnf_anon_inherited in callnodeflags)) or
                                      (cnf_ignore_visibility in callnodeflags);
-                   if symtableprocentry.realname = 'DoThis' then
-                   writeln(symtableprocentry.realname);                  
                    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]=[],cnf_anon_inherited in callnodeflags,spezcontext);
diff --git a/compiler/pexpr.pas b/compiler/pexpr.pas
index e92fed78cb..d073617804 100644
--- a/compiler/pexpr.pas
+++ b/compiler/pexpr.pas
@@ -76,7 +76,7 @@ implementation
        fmodule,ppu,
        { pass 1 }
        pass_1,
-       nmat,nadd,nmem,nset,ncnv,ninl,ncon,nld,nflw,nbas,nutils,
+       nmat,nadd,nmem,nset,ncnv,ninl,ncon,nld,nflw,nbas,nutils,htypechk,
        { parser }
        scanner,
        pbase,pinline,ptype,pgenutil,procinfo,cpuinfo
@@ -962,6 +962,147 @@ implementation
          end;
       end;
 
+    // note: ryan
+    function find_best_helper_candidate_for_proc(para:tnode;var procsym: tprocsym;symtable: tsymtable;callnodeflags: tcallnodeflags;spezcontext: tspecializationcontext; var obj: tabstractrecorddef): boolean;
+      function find_best_candidate(para:tnode;var procsym: tprocsym;structh: tabstractrecorddef;callnodeflags: tcallnodeflags;spezcontext: tspecializationcontext): boolean;
+        var
+          candidates : tcallcandidates;
+          ignorevisibility : boolean;
+          bestpd:tabstractprocdef;
+          srsym:tsym;
+          srsymtable:TSymtable;
+        begin
+          result := false;
+          // todo: in defaultprops I think we messed up by not using search_struct_member_no_helper
+          // so overloads are probably broken in classes
+
+          { procsym is not from the correct def so we need to search again for it }
+          if (structh.typ = objectdef) and not searchsym_in_helper(tobjectdef(structh),tobjectdef(structh),upper(procsym.realname),srsym,srsymtable,[ssf_no_addsymref]) {and (srsym.typ = procsym) }then
+            exit;
+
+          { ignore possible private for properties or in delphi mode for anon. inherited (FK) }
+          ignorevisibility:=((m_delphi in current_settings.modeswitches) and (cnf_anon_inherited in callnodeflags)) or
+                            (cnf_ignore_visibility in callnodeflags);
+          candidates:=tcallcandidates.create({procsym,structh.symtable}tprocsym(srsym),srsymtable,para,ignorevisibility,
+            {allowdefaultparas}true,cnf_objc_id_call in callnodeflags,cnf_unit_specified in callnodeflags,
+            {callnodeflags*[cnf_anon_inherited,cnf_inherited]=[]}false,cnf_anon_inherited in callnodeflags,spezcontext);
+          if candidates.count > 0 then
+            begin
+              candidates.get_information;
+              result := candidates.choose_best(bestpd, false) > 0;
+              if result then
+                procsym := tprocsym(srsym);
+            end;
+          candidates.free;
+        end;
+      var
+        propsym: tpropertysym;
+        i: integer;
+        structh: tabstractrecorddef;
+        pd:tdef;
+        st:tsymtable;
+        list: TFPObjectList;
+        s:string;
+        odef:tobjectdef;
+      begin
+        result:=false;
+        // note: TEMPORARY
+        pd := obj;
+        { 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 ((pd.typ in [recorddef,objectdef]) and
+            (
+              not assigned(tabstractrecorddef(pd).objrealname) or
+              (tabstractrecorddef(pd).objrealname^='')
+            )
+           ) or
+           not assigned(pd.typesym) 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:=generate_objectpascal_helper_key(pd);
+        list:=TFPObjectList(current_module.extendeddefs.Find(s));
+        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}obj); // note: what is context here?
+              if result then
+                begin
+                  result := find_best_candidate(para,procsym,odef,callnodeflags,spezcontext);
+                  if result then
+                    obj := odef;
+                end;
+              dec(i);
+            until result or (i<0);
+          end;
+      end;
+
+(*
+    function find_best_candidate_for_operator(p1, p2: tnode; optoken: ttoken; access: tpropaccesslisttypes; var obj: tabstractrecorddef; out propsym: tpropertysym): boolean;
+      function find_operator(fromdef: tabstractrecorddef; optoken: ttoken; right:tnode): boolean;
+        var
+          candidates : tcallcandidates;
+          ppn : tcallparanode;
+          bestpd: tabstractprocdef;
+        begin
+          result := false;
+          // todo: _ASSIGNMENT, _OP_EXPLICIT aren't searchable!
+          ppn:=ccallparanode.create(right.getcopy,ccallparanode.create(ttypenode.create(fromdef),nil));
+          ppn.get_paratype;
+          candidates:=tcallcandidates.create_operator(optoken,ppn);
+          if candidates.count > 0 then
+            begin
+              candidates.get_information;
+              result := candidates.choose_best(bestpd,false) > 0;
+            end;
+          ppn.free;
+          candidates.free;
+        end;
+      var
+        i: integer;
+        structh: tabstractrecorddef;
+      begin
+        result := false;
+        { search base first and if there's a matching operator then stop }
+        if find_operator(obj, optoken, p2) then
+          exit;
+        { search default properties }
+        for i := high(obj.default_props) downto 0 do
+          begin
+            propsym := tpropertysym(obj.default_props[i]);
+            { property is not default }
+            if not (ppo_defaultproperty in propsym.propoptions) then
+              continue;
+            { property doesn't have required access }
+            if propsym.propaccesslist[access].firstsym = nil then
+              continue;
+            structh := tabstractrecorddef(propsym.propdef);
+            if (structh.typ in [recorddef, objectdef]) and find_operator(structh, optoken, p2) then
+              begin
+                obj := structh;
+                exit(true);
+              end;
+            { compare property def with right node result def }
+            if (compare_defs(structh,p2.resultdef,p1.nodetype)>=te_convert_l6) then
+              begin
+                obj := structh;
+                exit(true);
+              end;
+          end;
+      end;
+*)
 
     { reads the parameter for a subroutine call }
     procedure do_proc_call(sym:tsym;st:TSymtable;obj:tabstractrecorddef;getaddr:boolean;var again : boolean;var p1:tnode;callflags:tcallnodeflags;spezcontext:tspecializationcontext);
@@ -1100,8 +1241,15 @@ implementation
                  if not (st.symtabletype in [ObjectSymtable,recordsymtable]) then
                    internalerror(200310031);
                  // note: ryan
-                 // does obj have an overload for the params? if not
-                 // search helpers with param and change obj
+                 { there may be an overloaded method which matches the 
+                   params which are available now. }
+                 if (m_multiscope_helpers in current_settings.modeswitches) then
+                   begin
+                     if assigned(para) and not assigned(para.resultdef) then
+                       tcallparanode(para).get_paratype;
+                     if find_best_helper_candidate_for_proc(para,tprocsym(sym),obj.symtable,callflags,spezcontext,obj) then
+                       ;//writeln('find_best_helper_candidate_for_proc:',obj.typesym.realname);
+                   end;
                  p1:=ccallnode.create(para,tprocsym(sym),obj.symtable,p1,callflags,spezcontext);
                end
              else
diff --git a/compiler/symtable.pas b/compiler/symtable.pas
index 452d1a8775..10f6f18ae7 100644
--- a/compiler/symtable.pas
+++ b/compiler/symtable.pas
@@ -4055,7 +4055,7 @@ implementation
           begin
             i:=list.count-1;
             repeat
-              odef:=tobjectdef(list[{list.count-1}i]);
+              odef:=tobjectdef(list[i]);
               result:=(odef.owner.symtabletype in [staticsymtable,globalsymtable]) or
                       is_visible_for_object(tobjectdef(list[i]).typesym,contextclassh);
               if result then
-- 
2.17.2 (Apple Git-113)


From 3d116b72454eaff3b828bb6f3e75d92834c31512 Mon Sep 17 00:00:00 2001
From: Ryan Joseph <genericptr@gmail.com>
Date: Thu, 22 Nov 2018 11:02:45 +0700
Subject: [PATCH 03/12] fixed bad design

---
 compiler/htypechk.pas | 215 ++++++++++++++++++++++++++----------------
 compiler/pexpr.pas    | 155 +-----------------------------
 compiler/symtable.pas |  66 ++++++-------
 3 files changed, 161 insertions(+), 275 deletions(-)

diff --git a/compiler/htypechk.pas b/compiler/htypechk.pas
index 07c035dc26..5a5b2f6819 100644
--- a/compiler/htypechk.pas
+++ b/compiler/htypechk.pas
@@ -152,22 +152,22 @@ interface
     function token2managementoperator(optoken:ttoken):tmanagementoperator;
 
     { check operator args and result type }
-
-    type
-      toverload_check_flag = (
-        ocf_check_non_overloadable, { also check operators that are (currently) considered as
-                                      not overloadable (e.g. the "+" operator for dynamic arrays
-                                      if modeswitch arrayoperators is active) }
-        ocf_check_only              { only check whether the operator is overloaded, but don't
-                                      modify the passed in node (return true if the operator is
-                                      overloaded, false otherwise) }
-      );
-      toverload_check_flags = set of toverload_check_flag;
-
+
+    type
+      toverload_check_flag = (
+        ocf_check_non_overloadable, { also check operators that are (currently) considered as
+                                      not overloadable (e.g. the "+" operator for dynamic arrays
+                                      if modeswitch arrayoperators is active) }
+        ocf_check_only              { only check whether the operator is overloaded, but don't
+                                      modify the passed in node (return true if the operator is
+                                      overloaded, false otherwise) }
+      );
+      toverload_check_flags = set of toverload_check_flag;
+
     function isbinaryoperatoroverloadable(treetyp:tnodetype;ld:tdef;lt:tnodetype;rd:tdef;rt:tnodetype) : boolean;
     function isoperatoracceptable(pf : tprocdef; optoken : ttoken) : boolean;
-    function isunaryoverloaded(var t : tnode;ocf:toverload_check_flags) : boolean;
-    function isbinaryoverloaded(var t : tnode;ocf:toverload_check_flags) : boolean;
+    function isunaryoverloaded(var t : tnode;ocf:toverload_check_flags) : boolean;
+    function isbinaryoverloaded(var t : tnode;ocf:toverload_check_flags) : boolean;
 
     { Register Allocation }
     procedure make_not_regable(p : tnode; how: tregableinfoflags);
@@ -515,9 +515,9 @@ implementation
                     end;
 
                  { <dyn. array> + <dyn. array> is handled by the compiler }
-                 if (m_array_operators in current_settings.modeswitches) and
-                     (treetyp=addn) and
-                     (is_dynamic_array(ld) or is_dynamic_array(rd)) then
+                 if (m_array_operators in current_settings.modeswitches) and
+                     (treetyp=addn) and
+                     (is_dynamic_array(ld) or is_dynamic_array(rd)) then
                     begin
                       allowed:=false;
                       exit;
@@ -720,7 +720,7 @@ implementation
       end;
 
 
-    function isunaryoverloaded(var t : tnode;ocf:toverload_check_flags) : boolean;
+    function isunaryoverloaded(var t : tnode;ocf:toverload_check_flags) : boolean;
       var
         ld      : tdef;
         optoken : ttoken;
@@ -742,11 +742,11 @@ implementation
         else
           inlinenumber:=in_none;
 
-        if not (ocf_check_non_overloadable in ocf) and not isunaryoperatoroverloadable(t.nodetype,inlinenumber,ld) then
+        if not (ocf_check_non_overloadable in ocf) and not isunaryoperatoroverloadable(t.nodetype,inlinenumber,ld) then
           exit;
 
         { operator overload is possible }
-        result:=not (ocf_check_only in ocf);
+        result:=not (ocf_check_only in ocf);
 
         optoken:=NOTOKEN;
         case t.nodetype of
@@ -766,11 +766,11 @@ implementation
         end;
         if (optoken=NOTOKEN) then
           begin
-            if not (ocf_check_only in ocf) then
-              begin
-                CGMessage(parser_e_operator_not_overloaded);
-                t:=cnothingnode.create;
-              end;
+            if not (ocf_check_only in ocf) then
+              begin
+                CGMessage(parser_e_operator_not_overloaded);
+                t:=cnothingnode.create;
+              end;
             exit;
           end;
 
@@ -790,11 +790,11 @@ implementation
           begin
             candidates.free;
             ppn.free;
-            if not (ocf_check_only in ocf) then
-              begin
-                CGMessage2(parser_e_operator_not_overloaded_2,ld.typename,arraytokeninfo[optoken].str);
-                t:=cnothingnode.create;
-              end;
+            if not (ocf_check_only in ocf) then
+              begin
+                CGMessage2(parser_e_operator_not_overloaded_2,ld.typename,arraytokeninfo[optoken].str);
+                t:=cnothingnode.create;
+              end;
             exit;
           end;
 
@@ -811,16 +811,16 @@ implementation
           begin
             candidates.free;
             ppn.free;
-            if not (ocf_check_only in ocf) then
-              begin
-                CGMessage2(parser_e_operator_not_overloaded_2,ld.typename,arraytokeninfo[optoken].str);
-                t:=cnothingnode.create;
-              end;
+            if not (ocf_check_only in ocf) then
+              begin
+                CGMessage2(parser_e_operator_not_overloaded_2,ld.typename,arraytokeninfo[optoken].str);
+                t:=cnothingnode.create;
+              end;
             exit;
           end;
 
         { Multiple candidates left? }
-        if (cand_cnt>1) and not (ocf_check_only in ocf) then
+        if (cand_cnt>1) and not (ocf_check_only in ocf) then
           begin
             CGMessage(type_e_cant_choose_overload_function);
 {$ifdef EXTDEBUG}
@@ -833,13 +833,13 @@ implementation
           end;
         candidates.free;
 
-        if ocf_check_only in ocf then
-          begin
-            ppn.free;
-            result:=true;
-            exit;
-          end;
-
+        if ocf_check_only in ocf then
+          begin
+            ppn.free;
+            result:=true;
+            exit;
+          end;
+
         addsymref(operpd.procsym);
 
         { the nil as symtable signs firstcalln that this is
@@ -852,7 +852,7 @@ implementation
       end;
 
 
-    function isbinaryoverloaded(var t : tnode;ocf:toverload_check_flags) : boolean;
+    function isbinaryoverloaded(var t : tnode;ocf:toverload_check_flags) : boolean;
       var
         rd,ld   : tdef;
         optoken : ttoken;
@@ -945,14 +945,14 @@ implementation
         { load easier access variables }
         ld:=tbinarynode(t).left.resultdef;
         rd:=tbinarynode(t).right.resultdef;
-        if not (ocf_check_non_overloadable in ocf) and
-            not isbinaryoperatoroverloadable(t.nodetype,ld,tbinarynode(t).left.nodetype,rd,tbinarynode(t).right.nodetype) then
+        if not (ocf_check_non_overloadable in ocf) and
+            not isbinaryoperatoroverloadable(t.nodetype,ld,tbinarynode(t).left.nodetype,rd,tbinarynode(t).right.nodetype) then
           exit;
 
         { operator overload is possible }
-        { if we only check for the existance of the overload, then we assume that
-          it is not overloaded }
-        result:=not (ocf_check_only in ocf);
+        { if we only check for the existance of the overload, then we assume that
+          it is not overloaded }
+        result:=not (ocf_check_only in ocf);
 
         case t.nodetype of
            equaln:
@@ -997,19 +997,19 @@ implementation
              optoken:=_OP_IN;
            else
              begin
-               if not (ocf_check_only in ocf) then
-                 begin
-                   CGMessage(parser_e_operator_not_overloaded);
-                   t:=cnothingnode.create;
-                 end;
+               if not (ocf_check_only in ocf) then
+                 begin
+                   CGMessage(parser_e_operator_not_overloaded);
+                   t:=cnothingnode.create;
+                 end;
                exit;
              end;
         end;
 
-        cand_cnt:=search_operator(optoken,(optoken<>_NE) and not (ocf_check_only in ocf));
+        cand_cnt:=search_operator(optoken,(optoken<>_NE) and not (ocf_check_only in ocf));
 
         { no operator found for "<>" then search for "=" operator }
-        if (cand_cnt=0) and (optoken=_NE) and not (ocf_check_only in ocf) then
+        if (cand_cnt=0) and (optoken=_NE) and not (ocf_check_only in ocf) then
           begin
             ppn.free;
             ppn:=nil;
@@ -1021,15 +1021,15 @@ implementation
         if (cand_cnt=0) then
           begin
             ppn.free;
-            if not (ocf_check_only in ocf) then
-              t:=cnothingnode.create;
-            exit;
-          end;
-
-        if ocf_check_only in ocf then
-          begin
-            ppn.free;
-            result:=true;
+            if not (ocf_check_only in ocf) then
+              t:=cnothingnode.create;
+            exit;
+          end;
+
+        if ocf_check_only in ocf then
+          begin
+            ppn.free;
+            result:=true;
             exit;
           end;
 
@@ -2234,6 +2234,33 @@ implementation
                 ProcdefOverloadList.Add(pd);
             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;
@@ -2242,6 +2269,8 @@ implementation
         foundanything : boolean;
         extendeddef : tabstractrecorddef;
         helperdef  : tobjectdef;
+        helperlist : TFPObjectList;
+        i : integer;
       begin
         if FOperator=NOTOKEN then
           hashedid.id:=FProcsym.name
@@ -2261,27 +2290,47 @@ implementation
                )
                and searchhelpers then
              begin
-               if search_last_objectpascal_helper(structdef,nil,helperdef) then
+               // note: ryan
+               if (m_multiscope_helpers in current_settings.modeswitches) then
                  begin
-                   srsym:=nil;
-                   while assigned(helperdef) do
+                   helperlist:=get_objectpascal_helpers(structdef);
+                   if assigned(helperlist) and (helperlist.count>0) then
                      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;
+                       i:=helperlist.count-1;
+                       repeat
+                         helperdef:=tobjectdef(helperlist[i]);
+                         if (helperdef.owner.symtabletype in [staticsymtable,globalsymtable]) or
+                            is_visible_for_object(helperdef.typesym,{structdef}helperdef) then
+                              if processhelper(hashedid,helperdef) then
+                                exit;
+                         dec(i);
+                       until (i<0);
                      end;
-                   if not hasoverload and assigned(srsym) then
-                     exit;
-                 end;
+                 end
+               else if search_last_objectpascal_helper(structdef,nil,helperdef) and processhelper(hashedid,helperdef) then
+                  exit;
+
+               //if processhelper 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),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;
+               //  end;
              end;
            { now search in the type itself }
            srsym:=tsym(structdef.symtable.FindWithHash(hashedid));
diff --git a/compiler/pexpr.pas b/compiler/pexpr.pas
index d073617804..f14dbe8a3f 100644
--- a/compiler/pexpr.pas
+++ b/compiler/pexpr.pas
@@ -962,148 +962,6 @@ implementation
          end;
       end;
 
-    // note: ryan
-    function find_best_helper_candidate_for_proc(para:tnode;var procsym: tprocsym;symtable: tsymtable;callnodeflags: tcallnodeflags;spezcontext: tspecializationcontext; var obj: tabstractrecorddef): boolean;
-      function find_best_candidate(para:tnode;var procsym: tprocsym;structh: tabstractrecorddef;callnodeflags: tcallnodeflags;spezcontext: tspecializationcontext): boolean;
-        var
-          candidates : tcallcandidates;
-          ignorevisibility : boolean;
-          bestpd:tabstractprocdef;
-          srsym:tsym;
-          srsymtable:TSymtable;
-        begin
-          result := false;
-          // todo: in defaultprops I think we messed up by not using search_struct_member_no_helper
-          // so overloads are probably broken in classes
-
-          { procsym is not from the correct def so we need to search again for it }
-          if (structh.typ = objectdef) and not searchsym_in_helper(tobjectdef(structh),tobjectdef(structh),upper(procsym.realname),srsym,srsymtable,[ssf_no_addsymref]) {and (srsym.typ = procsym) }then
-            exit;
-
-          { ignore possible private for properties or in delphi mode for anon. inherited (FK) }
-          ignorevisibility:=((m_delphi in current_settings.modeswitches) and (cnf_anon_inherited in callnodeflags)) or
-                            (cnf_ignore_visibility in callnodeflags);
-          candidates:=tcallcandidates.create({procsym,structh.symtable}tprocsym(srsym),srsymtable,para,ignorevisibility,
-            {allowdefaultparas}true,cnf_objc_id_call in callnodeflags,cnf_unit_specified in callnodeflags,
-            {callnodeflags*[cnf_anon_inherited,cnf_inherited]=[]}false,cnf_anon_inherited in callnodeflags,spezcontext);
-          if candidates.count > 0 then
-            begin
-              candidates.get_information;
-              result := candidates.choose_best(bestpd, false) > 0;
-              if result then
-                procsym := tprocsym(srsym);
-            end;
-          candidates.free;
-        end;
-      var
-        propsym: tpropertysym;
-        i: integer;
-        structh: tabstractrecorddef;
-        pd:tdef;
-        st:tsymtable;
-        list: TFPObjectList;
-        s:string;
-        odef:tobjectdef;
-      begin
-        result:=false;
-        // note: TEMPORARY
-        pd := obj;
-        { 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 ((pd.typ in [recorddef,objectdef]) and
-            (
-              not assigned(tabstractrecorddef(pd).objrealname) or
-              (tabstractrecorddef(pd).objrealname^='')
-            )
-           ) or
-           not assigned(pd.typesym) 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:=generate_objectpascal_helper_key(pd);
-        list:=TFPObjectList(current_module.extendeddefs.Find(s));
-        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}obj); // note: what is context here?
-              if result then
-                begin
-                  result := find_best_candidate(para,procsym,odef,callnodeflags,spezcontext);
-                  if result then
-                    obj := odef;
-                end;
-              dec(i);
-            until result or (i<0);
-          end;
-      end;
-
-(*
-    function find_best_candidate_for_operator(p1, p2: tnode; optoken: ttoken; access: tpropaccesslisttypes; var obj: tabstractrecorddef; out propsym: tpropertysym): boolean;
-      function find_operator(fromdef: tabstractrecorddef; optoken: ttoken; right:tnode): boolean;
-        var
-          candidates : tcallcandidates;
-          ppn : tcallparanode;
-          bestpd: tabstractprocdef;
-        begin
-          result := false;
-          // todo: _ASSIGNMENT, _OP_EXPLICIT aren't searchable!
-          ppn:=ccallparanode.create(right.getcopy,ccallparanode.create(ttypenode.create(fromdef),nil));
-          ppn.get_paratype;
-          candidates:=tcallcandidates.create_operator(optoken,ppn);
-          if candidates.count > 0 then
-            begin
-              candidates.get_information;
-              result := candidates.choose_best(bestpd,false) > 0;
-            end;
-          ppn.free;
-          candidates.free;
-        end;
-      var
-        i: integer;
-        structh: tabstractrecorddef;
-      begin
-        result := false;
-        { search base first and if there's a matching operator then stop }
-        if find_operator(obj, optoken, p2) then
-          exit;
-        { search default properties }
-        for i := high(obj.default_props) downto 0 do
-          begin
-            propsym := tpropertysym(obj.default_props[i]);
-            { property is not default }
-            if not (ppo_defaultproperty in propsym.propoptions) then
-              continue;
-            { property doesn't have required access }
-            if propsym.propaccesslist[access].firstsym = nil then
-              continue;
-            structh := tabstractrecorddef(propsym.propdef);
-            if (structh.typ in [recorddef, objectdef]) and find_operator(structh, optoken, p2) then
-              begin
-                obj := structh;
-                exit(true);
-              end;
-            { compare property def with right node result def }
-            if (compare_defs(structh,p2.resultdef,p1.nodetype)>=te_convert_l6) then
-              begin
-                obj := structh;
-                exit(true);
-              end;
-          end;
-      end;
-*)
-
     { reads the parameter for a subroutine call }
     procedure do_proc_call(sym:tsym;st:TSymtable;obj:tabstractrecorddef;getaddr:boolean;var again : boolean;var p1:tnode;callflags:tcallnodeflags;spezcontext:tspecializationcontext);
       var
@@ -1240,16 +1098,6 @@ implementation
                begin
                  if not (st.symtabletype in [ObjectSymtable,recordsymtable]) then
                    internalerror(200310031);
-                 // note: ryan
-                 { there may be an overloaded method which matches the 
-                   params which are available now. }
-                 if (m_multiscope_helpers in current_settings.modeswitches) then
-                   begin
-                     if assigned(para) and not assigned(para.resultdef) then
-                       tcallparanode(para).get_paratype;
-                     if find_best_helper_candidate_for_proc(para,tprocsym(sym),obj.symtable,callflags,spezcontext,obj) then
-                       ;//writeln('find_best_helper_candidate_for_proc:',obj.typesym.realname);
-                   end;
                  p1:=ccallnode.create(para,tprocsym(sym),obj.symtable,p1,callflags,spezcontext);
                end
              else
@@ -2083,7 +1931,8 @@ implementation
                   def:=voidpointertype
                 else
                   def:=node.resultdef;
-              result:=search_objectpascal_helper(def,nil,pattern,srsym,srsymtable);
+              { allow multiscope searches }
+              result:=search_objectpascal_helper(def,nil,false,pattern,srsym,srsymtable);
               if result then
                 begin
                   if not (srsymtable.symtabletype=objectsymtable) or
diff --git a/compiler/symtable.pas b/compiler/symtable.pas
index 10f6f18ae7..f557b11376 100644
--- a/compiler/symtable.pas
+++ b/compiler/symtable.pas
@@ -358,7 +358,7 @@ interface
     function  search_last_objectpascal_helper(pd : tdef;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 : tdef;contextclassh : tabstractrecorddef;const s : string; out srsym: tsym; out srsymtable: tsymtable):boolean;
+    function  search_objectpascal_helper(pd : tdef;contextclassh : tabstractrecorddef;lastonly : boolean;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, }
@@ -368,6 +368,9 @@ interface
     { actually defined (could be disable using "undef")                     }
     function  defined_macro(const s : string):boolean;
     { Look for a system procedure (no overloads supported) }
+    // note: ryan
+    { 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;
@@ -3569,7 +3572,7 @@ implementation
                 if (classh.objecttype in objecttypes_with_helpers) and
                     (ssf_search_helper in flags) then
                   begin
-                    result:=search_objectpascal_helper(classh,contextclassh,s,srsym,srsymtable);
+                    result:=search_objectpascal_helper(classh,contextclassh,true,s,srsym,srsymtable);
                     { an eventual overload inside the extended type's hierarchy
                       will be found by tcallcandidates }
                     if result then
@@ -3604,7 +3607,7 @@ implementation
         result:=false;
         hashedid.id:=s;
         { search for a record helper method first }
-        result:=search_objectpascal_helper(recordh,recordh,s,srsym,srsymtable);
+        result:=search_objectpascal_helper(recordh,recordh,false,s,srsym,srsymtable);
         if result then
           { an eventual overload inside the extended type's hierarchy
             will be found by tcallcandidates }
@@ -4019,15 +4022,13 @@ implementation
         until classh=nil;
       end;
 
-    function search_best_objectpascal_helper(const name: string;pd : tdef;contextclassh : tabstractrecorddef;out srsym: tsym; out srsymtable: tsymtable):boolean;
+    // note: ryan
+    function get_objectpascal_helpers(pd : tdef):TFPObjectList;
       var
         s: string;
-        list: TFPObjectList;
-        i: integer;
         st: tsymtable;
-        odef : tobjectdef;
       begin
-        result:=false;
+        result:=nil;
         { when there are no helpers active currently then we don't need to do
           anything }
         if current_module.extendeddefs.count=0 then
@@ -4050,7 +4051,19 @@ 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;
@@ -4070,33 +4083,10 @@ implementation
         s: string;
         list: TFPObjectList;
         i: integer;
-        st: tsymtable;
       begin
         result:=false;
         odef:=nil;
-        { 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 ((pd.typ in [recorddef,objectdef]) and
-            (
-              not assigned(tabstractrecorddef(pd).objrealname) or
-              (tabstractrecorddef(pd).objrealname^='')
-            )
-           ) or
-           not assigned(pd.typesym) 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:=generate_objectpascal_helper_key(pd);
-        list:=TFPObjectList(current_module.extendeddefs.Find(s));
+        list:=get_objectpascal_helpers(pd);
         if assigned(list) and (list.count>0) then
           begin
             i:=list.count-1;
@@ -4112,7 +4102,7 @@ implementation
           end;
       end;
 
-    function search_objectpascal_helper(pd : tdef;contextclassh : tabstractrecorddef;const s: string; out srsym: tsym; out srsymtable: tsymtable):boolean;
+    function search_objectpascal_helper(pd : tdef;contextclassh : tabstractrecorddef;lastonly : boolean;const s: string; out srsym: tsym; out srsymtable: tsymtable):boolean;
       var
         classh : tobjectdef;
       begin
@@ -4121,10 +4111,8 @@ implementation
         { if there is no class helper for the class then there is no need to
           search further }
         // note: ryan
-        if m_multiscope_helpers in current_settings.modeswitches then
-          begin
-            result := search_best_objectpascal_helper(s,pd,contextclassh,srsym,srsymtable);
-          end
+        if not lastonly and (m_multiscope_helpers in current_settings.modeswitches) then
+          result := search_best_objectpascal_helper(s,pd,contextclassh,srsym,srsymtable)
         else
           begin
             if search_last_objectpascal_helper(pd,contextclassh,classh) and
@@ -4274,7 +4262,7 @@ implementation
         if (oo_is_formal in pd.objectoptions) then
           pd:=find_real_class_definition(tobjectdef(pd),true);
 
-        if search_objectpascal_helper(pd, pd, s, result, srsymtable) then
+        if search_objectpascal_helper(pd, pd, true, s, result, srsymtable) then
           exit;
 
         result:=search_struct_member_no_helper(pd,s);
-- 
2.17.2 (Apple Git-113)


From 4a96a18e6a5e1b9bd5827b58da8e97d14adf1f6b Mon Sep 17 00:00:00 2001
From: Ryan Joseph <genericptr@gmail.com>
Date: Sat, 24 Nov 2018 09:56:43 +0700
Subject: [PATCH 04/12] some cleanup

---
 compiler/htypechk.pas | 25 +------------------------
 compiler/symtable.pas |  4 ----
 2 files changed, 1 insertion(+), 28 deletions(-)

diff --git a/compiler/htypechk.pas b/compiler/htypechk.pas
index 5a5b2f6819..bd5dd30f71 100644
--- a/compiler/htypechk.pas
+++ b/compiler/htypechk.pas
@@ -2290,7 +2290,6 @@ implementation
                )
                and searchhelpers then
              begin
-               // note: ryan
                if (m_multiscope_helpers in current_settings.modeswitches) then
                  begin
                    helperlist:=get_objectpascal_helpers(structdef);
@@ -2300,7 +2299,7 @@ implementation
                        repeat
                          helperdef:=tobjectdef(helperlist[i]);
                          if (helperdef.owner.symtabletype in [staticsymtable,globalsymtable]) or
-                            is_visible_for_object(helperdef.typesym,{structdef}helperdef) then
+                            is_visible_for_object(helperdef.typesym,helperdef) then
                               if processhelper(hashedid,helperdef) then
                                 exit;
                          dec(i);
@@ -2309,28 +2308,6 @@ implementation
                  end
                else if search_last_objectpascal_helper(structdef,nil,helperdef) and processhelper(hashedid,helperdef) then
                   exit;
-
-               //if processhelper 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),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;
-               //  end;
              end;
            { now search in the type itself }
            srsym:=tsym(structdef.symtable.FindWithHash(hashedid));
diff --git a/compiler/symtable.pas b/compiler/symtable.pas
index f557b11376..798ee696de 100644
--- a/compiler/symtable.pas
+++ b/compiler/symtable.pas
@@ -368,7 +368,6 @@ interface
     { actually defined (could be disable using "undef")                     }
     function  defined_macro(const s : string):boolean;
     { Look for a system procedure (no overloads supported) }
-    // note: ryan
     { returns a list of helpers in the current module for the def }
     function get_objectpascal_helpers(pd : tdef):TFPObjectList;
 
@@ -3974,7 +3973,6 @@ implementation
           end;
       end;
 
-    // note: ryan
     function search_objectdef(const s: string;classh : tobjectdef;contextclassh : tabstractrecorddef;out srsym: tsym; out srsymtable: tsymtable): boolean;
       var
         hashedid  : THashedIDString;
@@ -4022,7 +4020,6 @@ implementation
         until classh=nil;
       end;
 
-    // note: ryan
     function get_objectpascal_helpers(pd : tdef):TFPObjectList;
       var
         s: string;
@@ -4110,7 +4107,6 @@ implementation
 
         { if there is no class helper for the class then there is no need to
           search further }
-        // note: ryan
         if not lastonly and (m_multiscope_helpers in current_settings.modeswitches) then
           result := search_best_objectpascal_helper(s,pd,contextclassh,srsym,srsymtable)
         else
-- 
2.17.2 (Apple Git-113)


From 594d73547384e5d382e1095fc626099519c28fe3 Mon Sep 17 00:00:00 2001
From: Ryan Joseph <genericptr@gmail.com>
Date: Mon, 26 Nov 2018 09:16:47 +0700
Subject: [PATCH 05/12] removed "lastonly" param from
 search_objectpascal_helper

---
 compiler/pexpr.pas    |  2 +-
 compiler/symtable.pas | 12 ++++++------
 2 files changed, 7 insertions(+), 7 deletions(-)

diff --git a/compiler/pexpr.pas b/compiler/pexpr.pas
index f14dbe8a3f..39bb5e1de5 100644
--- a/compiler/pexpr.pas
+++ b/compiler/pexpr.pas
@@ -1932,7 +1932,7 @@ implementation
                 else
                   def:=node.resultdef;
               { allow multiscope searches }
-              result:=search_objectpascal_helper(def,nil,false,pattern,srsym,srsymtable);
+              result:=search_objectpascal_helper(def,nil,pattern,srsym,srsymtable);
               if result then
                 begin
                   if not (srsymtable.symtabletype=objectsymtable) or
diff --git a/compiler/symtable.pas b/compiler/symtable.pas
index 798ee696de..1a3f917885 100644
--- a/compiler/symtable.pas
+++ b/compiler/symtable.pas
@@ -358,7 +358,7 @@ interface
     function  search_last_objectpascal_helper(pd : tdef;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 : tdef;contextclassh : tabstractrecorddef;lastonly : boolean;const s : string;out srsym: tsym; out srsymtable: tsymtable):boolean;
+    function  search_objectpascal_helper(pd : tdef;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, }
@@ -3571,7 +3571,7 @@ implementation
                 if (classh.objecttype in objecttypes_with_helpers) and
                     (ssf_search_helper in flags) then
                   begin
-                    result:=search_objectpascal_helper(classh,contextclassh,true,s,srsym,srsymtable);
+                    result:=search_objectpascal_helper(classh,contextclassh,s,srsym,srsymtable);
                     { an eventual overload inside the extended type's hierarchy
                       will be found by tcallcandidates }
                     if result then
@@ -3606,7 +3606,7 @@ implementation
         result:=false;
         hashedid.id:=s;
         { search for a record helper method first }
-        result:=search_objectpascal_helper(recordh,recordh,false,s,srsym,srsymtable);
+        result:=search_objectpascal_helper(recordh,recordh,s,srsym,srsymtable);
         if result then
           { an eventual overload inside the extended type's hierarchy
             will be found by tcallcandidates }
@@ -4099,7 +4099,7 @@ implementation
           end;
       end;
 
-    function search_objectpascal_helper(pd : tdef;contextclassh : tabstractrecorddef;lastonly : boolean;const s: string; out srsym: tsym; out srsymtable: tsymtable):boolean;
+    function search_objectpascal_helper(pd : tdef;contextclassh : tabstractrecorddef;const s: string; out srsym: tsym; out srsymtable: tsymtable):boolean;
       var
         classh : tobjectdef;
       begin
@@ -4107,7 +4107,7 @@ implementation
 
         { if there is no class helper for the class then there is no need to
           search further }
-        if not lastonly and (m_multiscope_helpers in current_settings.modeswitches) then
+        if m_multiscope_helpers in current_settings.modeswitches then
           result := search_best_objectpascal_helper(s,pd,contextclassh,srsym,srsymtable)
         else
           begin
@@ -4258,7 +4258,7 @@ implementation
         if (oo_is_formal in pd.objectoptions) then
           pd:=find_real_class_definition(tobjectdef(pd),true);
 
-        if search_objectpascal_helper(pd, pd, true, s, result, srsymtable) then
+        if search_objectpascal_helper(pd, pd, s, result, srsymtable) then
           exit;
 
         result:=search_struct_member_no_helper(pd,s);
-- 
2.17.2 (Apple Git-113)


From 7c961f10bba62739bc524989eceff4d9f532242f Mon Sep 17 00:00:00 2001
From: Ryan Joseph <genericptr@gmail.com>
Date: Sun, 24 Feb 2019 12:49:11 -0500
Subject: [PATCH 06/12] changed mode switch to "multi helpers" and fixed bug in
 searchsym_in_helper

---
 compiler/globtype.pas |  4 ++--
 compiler/htypechk.pas |  2 +-
 compiler/ppu.pas      |  2 +-
 compiler/symtable.pas | 17 +++++++++++++----
 4 files changed, 17 insertions(+), 8 deletions(-)

diff --git a/compiler/globtype.pas b/compiler/globtype.pas
index f154532a5f..06011517d2 100644
--- a/compiler/globtype.pas
+++ b/compiler/globtype.pas
@@ -447,7 +447,7 @@ interface
          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_multiscope_helpers   { ObjFPC mode only - helpers can appear in multiple scopes simultaneously }
+         m_multi_helpers        { ObjFPC mode only - helpers can appear in multiple scopes simultaneously }
        );
        tmodeswitches = set of tmodeswitch;
 
@@ -637,7 +637,7 @@ interface
          'ISOPROGRAMPARAS',
          'ISOMOD',
          'ARRAYOPERATORS',
-         'MULTISCOPEHELPERS'
+         'MULTIHELPERS'
          );
 
 
diff --git a/compiler/htypechk.pas b/compiler/htypechk.pas
index bd5dd30f71..63b12c31fe 100644
--- a/compiler/htypechk.pas
+++ b/compiler/htypechk.pas
@@ -2290,7 +2290,7 @@ implementation
                )
                and searchhelpers then
              begin
-               if (m_multiscope_helpers in current_settings.modeswitches) then
+               if (m_multi_helpers in current_settings.modeswitches) then
                  begin
                    helperlist:=get_objectpascal_helpers(structdef);
                    if assigned(helperlist) and (helperlist.count>0) then
diff --git a/compiler/ppu.pas b/compiler/ppu.pas
index 10c42e7eb8..31011be3e8 100644
--- a/compiler/ppu.pas
+++ b/compiler/ppu.pas
@@ -43,7 +43,7 @@ type
 {$endif Test_Double_checksum}
 
 const
-  CurrentPPUVersion = 201;
+  CurrentPPUVersion = 203;
 
 { unit flags }
   uf_init                = $000001; { unit has initialization section }
diff --git a/compiler/symtable.pas b/compiler/symtable.pas
index 1a3f917885..f654b2ee46 100644
--- a/compiler/symtable.pas
+++ b/compiler/symtable.pas
@@ -3696,6 +3696,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;
@@ -3757,10 +3759,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!) }
-          result:=searchsym_in_class(tobjectdef(classh.extendeddef).childof,contextclassh,s,srsym,srsymtable,flags+[ssf_search_helper]);
-          { addsymref is already called by searchsym_in_class }
+          begin
+            result:=searchsym_in_class(tobjectdef(classh.extendeddef).childof,contextclassh,s,srsym,srsymtable,flags+[ssf_search_helper]);
+            { 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;
@@ -4107,7 +4116,7 @@ implementation
 
         { if there is no class helper for the class then there is no need to
           search further }
-        if m_multiscope_helpers in current_settings.modeswitches then
+        if m_multi_helpers in current_settings.modeswitches then
           result := search_best_objectpascal_helper(s,pd,contextclassh,srsym,srsymtable)
         else
           begin
-- 
2.17.2 (Apple Git-113)


From a6c08d0ce5b1ef4ed07f59844efaef46153b69b1 Mon Sep 17 00:00:00 2001
From: Ryan Joseph <genericptr@gmail.com>
Date: Sun, 24 Feb 2019 15:53:20 -0500
Subject: [PATCH 07/12] added tests (tmshlp*.pp)

---
 .gitignore              | 29 +++++++++++++++++++------
 tests/test/tmshlp1.pas  | 36 +++++++++++++++++++++++++++++++
 tests/test/tmshlp10.pas | 36 +++++++++++++++++++++++++++++++
 tests/test/tmshlp11.pas | 38 ++++++++++++++++++++++++++++++++
 tests/test/tmshlp2.pas  | 36 +++++++++++++++++++++++++++++++
 tests/test/tmshlp3.pas  | 32 +++++++++++++++++++++++++++
 tests/test/tmshlp4.pas  | 48 +++++++++++++++++++++++++++++++++++++++++
 tests/test/tmshlp5.pas  | 35 ++++++++++++++++++++++++++++++
 tests/test/tmshlp6.pas  | 26 ++++++++++++++++++++++
 tests/test/tmshlp7.pas  | 27 +++++++++++++++++++++++
 tests/test/tmshlp8.pas  | 34 +++++++++++++++++++++++++++++
 tests/test/tmshlp9.pas  | 36 +++++++++++++++++++++++++++++++
 12 files changed, 406 insertions(+), 7 deletions(-)
 create mode 100644 tests/test/tmshlp1.pas
 create mode 100644 tests/test/tmshlp10.pas
 create mode 100644 tests/test/tmshlp11.pas
 create mode 100644 tests/test/tmshlp2.pas
 create mode 100644 tests/test/tmshlp3.pas
 create mode 100644 tests/test/tmshlp4.pas
 create mode 100644 tests/test/tmshlp5.pas
 create mode 100644 tests/test/tmshlp6.pas
 create mode 100644 tests/test/tmshlp7.pas
 create mode 100644 tests/test/tmshlp8.pas
 create mode 100644 tests/test/tmshlp9.pas

diff --git a/.gitignore b/.gitignore
index 5f32ec99e7..64fdb156d0 100644
--- a/.gitignore
+++ b/.gitignore
@@ -1,8 +1,23 @@
-# Ignore everything
-*
+# files
+pp
+fpmake
+rtl/darwin/fpcmade.x86_64-darwin
+fpmake_proc1 copy.inc
+tests/*.x86_64-darwin
+rtl/Package.fpc
+tests/createlst
+tests/gparmake
 
-# But not these files...
-!.gitignore
-!.pas
-!.pp
-!ryan_*.lpi
\ No newline at end of file
+# directories
+lazbuild/
+x86_64-darwin/
+tests/tstunits/
+tests/utils
+
+# patterns
+*.app
+*.o
+*.ppu
+*.fpm
+*.rsj
+*.lst
\ No newline at end of file
diff --git a/tests/test/tmshlp1.pas b/tests/test/tmshlp1.pas
new file mode 100644
index 0000000000..efab230519
--- /dev/null
+++ b/tests/test/tmshlp1.pas
@@ -0,0 +1,36 @@
+{$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.
diff --git a/tests/test/tmshlp10.pas b/tests/test/tmshlp10.pas
new file mode 100644
index 0000000000..db02f1e09f
--- /dev/null
+++ b/tests/test/tmshlp10.pas
@@ -0,0 +1,36 @@
+{$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.
diff --git a/tests/test/tmshlp11.pas b/tests/test/tmshlp11.pas
new file mode 100644
index 0000000000..87b52f625a
--- /dev/null
+++ b/tests/test/tmshlp11.pas
@@ -0,0 +1,38 @@
+{$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.
diff --git a/tests/test/tmshlp2.pas b/tests/test/tmshlp2.pas
new file mode 100644
index 0000000000..177505f567
--- /dev/null
+++ b/tests/test/tmshlp2.pas
@@ -0,0 +1,36 @@
+{$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.
diff --git a/tests/test/tmshlp3.pas b/tests/test/tmshlp3.pas
new file mode 100644
index 0000000000..ca030de79c
--- /dev/null
+++ b/tests/test/tmshlp3.pas
@@ -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.
\ No newline at end of file
diff --git a/tests/test/tmshlp4.pas b/tests/test/tmshlp4.pas
new file mode 100644
index 0000000000..c90995a09d
--- /dev/null
+++ b/tests/test/tmshlp4.pas
@@ -0,0 +1,48 @@
+{$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.
diff --git a/tests/test/tmshlp5.pas b/tests/test/tmshlp5.pas
new file mode 100644
index 0000000000..d0dc99b607
--- /dev/null
+++ b/tests/test/tmshlp5.pas
@@ -0,0 +1,35 @@
+{$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.
diff --git a/tests/test/tmshlp6.pas b/tests/test/tmshlp6.pas
new file mode 100644
index 0000000000..985bf8f9b8
--- /dev/null
+++ b/tests/test/tmshlp6.pas
@@ -0,0 +1,26 @@
+{%FAIL}
+{$mode objfpc}
+{$modeswitch multihelpers}
+
+program tmshlp6;
+
+type
+	TMyObject = class
+		m_num: integer;
+		property num1: integer read m_num;
+	end;
+	THelper1 = class helper for TMyObject
+		property num2: integer read m_num;
+	end;
+	THelper2 = class helper for TMyObject
+		property num3: integer read m_num;
+	end;
+
+var
+	obj: TMyObject;
+	num: integer;
+begin
+	obj := TMyObject.Create;
+	obj.m_num := 1;
+	num := obj.num1 + obj.num2 + obj.num3;
+end.
diff --git a/tests/test/tmshlp7.pas b/tests/test/tmshlp7.pas
new file mode 100644
index 0000000000..5702b0959a
--- /dev/null
+++ b/tests/test/tmshlp7.pas
@@ -0,0 +1,27 @@
+{$mode objfpc}
+{$modeswitch advancedrecords}
+{$modeswitch typehelpers}
+
+unit tmshlp7;
+interface
+
+type
+	TExtClassHelper = class helper for TObject
+		procedure DoThisExt;
+	end;
+	TExtStringHelper = type helper for String
+		function LengthExt: integer;
+	end;
+
+implementation
+	
+procedure TExtClassHelper.DoThisExt;
+begin	
+end;
+
+function TExtStringHelper.LengthExt: integer;
+begin
+	result := System.Length(self);
+end;
+
+end.
diff --git a/tests/test/tmshlp8.pas b/tests/test/tmshlp8.pas
new file mode 100644
index 0000000000..242a54b968
--- /dev/null
+++ b/tests/test/tmshlp8.pas
@@ -0,0 +1,34 @@
+{$mode objfpc}
+{$modeswitch typehelpers}
+{$modeswitch multihelpers}
+
+program tmshlp8;
+uses
+	tmshlp7;
+
+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);
+end.
diff --git a/tests/test/tmshlp9.pas b/tests/test/tmshlp9.pas
new file mode 100644
index 0000000000..dbd830e425
--- /dev/null
+++ b/tests/test/tmshlp9.pas
@@ -0,0 +1,36 @@
+{$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.
-- 
2.17.2 (Apple Git-113)


From 505fb9b0791beda06ce18fddbc74ddf1ae632a51 Mon Sep 17 00:00:00 2001
From: Ryan Joseph <genericptr@gmail.com>
Date: Sun, 24 Feb 2019 16:07:47 -0500
Subject: [PATCH 08/12] updated gitignore

---
 .gitignore | 1 +
 1 file changed, 1 insertion(+)

diff --git a/.gitignore b/.gitignore
index 64fdb156d0..16d38503e5 100644
--- a/.gitignore
+++ b/.gitignore
@@ -7,6 +7,7 @@ tests/*.x86_64-darwin
 rtl/Package.fpc
 tests/createlst
 tests/gparmake
+compiler/ryan_ppcx64.lpi
 
 # directories
 lazbuild/
-- 
2.17.2 (Apple Git-113)


From 212319f84e08d2b1e5bee274261f9ab7414ee826 Mon Sep 17 00:00:00 2001
From: Ryan Joseph <genericptr@gmail.com>
Date: Mon, 25 Feb 2019 09:46:55 -0500
Subject: [PATCH 09/12] renamed tests with proper suffix

---
 tests/test/{tmshlp1.pas => tmshlp1.pp}   |  0
 tests/test/{tmshlp10.pas => tmshlp10.pp} |  0
 tests/test/{tmshlp11.pas => tmshlp11.pp} |  0
 tests/test/{tmshlp2.pas => tmshlp2.pp}   |  0
 tests/test/{tmshlp3.pas => tmshlp3.pp}   |  0
 tests/test/{tmshlp4.pas => tmshlp4.pp}   |  0
 tests/test/{tmshlp5.pas => tmshlp5.pp}   |  0
 tests/test/tmshlp6.pas                   | 26 ------------------
 tests/test/tmshlp6.pp                    | 35 ++++++++++++++++++++++++
 tests/test/{tmshlp7.pas => tmshlp7.pp}   |  0
 tests/test/{tmshlp8.pas => tmshlp8.pp}   |  0
 tests/test/{tmshlp9.pas => tmshlp9.pp}   |  0
 12 files changed, 35 insertions(+), 26 deletions(-)
 rename tests/test/{tmshlp1.pas => tmshlp1.pp} (100%)
 rename tests/test/{tmshlp10.pas => tmshlp10.pp} (100%)
 rename tests/test/{tmshlp11.pas => tmshlp11.pp} (100%)
 rename tests/test/{tmshlp2.pas => tmshlp2.pp} (100%)
 rename tests/test/{tmshlp3.pas => tmshlp3.pp} (100%)
 rename tests/test/{tmshlp4.pas => tmshlp4.pp} (100%)
 rename tests/test/{tmshlp5.pas => tmshlp5.pp} (100%)
 delete mode 100644 tests/test/tmshlp6.pas
 create mode 100644 tests/test/tmshlp6.pp
 rename tests/test/{tmshlp7.pas => tmshlp7.pp} (100%)
 rename tests/test/{tmshlp8.pas => tmshlp8.pp} (100%)
 rename tests/test/{tmshlp9.pas => tmshlp9.pp} (100%)

diff --git a/tests/test/tmshlp1.pas b/tests/test/tmshlp1.pp
similarity index 100%
rename from tests/test/tmshlp1.pas
rename to tests/test/tmshlp1.pp
diff --git a/tests/test/tmshlp10.pas b/tests/test/tmshlp10.pp
similarity index 100%
rename from tests/test/tmshlp10.pas
rename to tests/test/tmshlp10.pp
diff --git a/tests/test/tmshlp11.pas b/tests/test/tmshlp11.pp
similarity index 100%
rename from tests/test/tmshlp11.pas
rename to tests/test/tmshlp11.pp
diff --git a/tests/test/tmshlp2.pas b/tests/test/tmshlp2.pp
similarity index 100%
rename from tests/test/tmshlp2.pas
rename to tests/test/tmshlp2.pp
diff --git a/tests/test/tmshlp3.pas b/tests/test/tmshlp3.pp
similarity index 100%
rename from tests/test/tmshlp3.pas
rename to tests/test/tmshlp3.pp
diff --git a/tests/test/tmshlp4.pas b/tests/test/tmshlp4.pp
similarity index 100%
rename from tests/test/tmshlp4.pas
rename to tests/test/tmshlp4.pp
diff --git a/tests/test/tmshlp5.pas b/tests/test/tmshlp5.pp
similarity index 100%
rename from tests/test/tmshlp5.pas
rename to tests/test/tmshlp5.pp
diff --git a/tests/test/tmshlp6.pas b/tests/test/tmshlp6.pas
deleted file mode 100644
index 985bf8f9b8..0000000000
--- a/tests/test/tmshlp6.pas
+++ /dev/null
@@ -1,26 +0,0 @@
-{%FAIL}
-{$mode objfpc}
-{$modeswitch multihelpers}
-
-program tmshlp6;
-
-type
-	TMyObject = class
-		m_num: integer;
-		property num1: integer read m_num;
-	end;
-	THelper1 = class helper for TMyObject
-		property num2: integer read m_num;
-	end;
-	THelper2 = class helper for TMyObject
-		property num3: integer read m_num;
-	end;
-
-var
-	obj: TMyObject;
-	num: integer;
-begin
-	obj := TMyObject.Create;
-	obj.m_num := 1;
-	num := obj.num1 + obj.num2 + obj.num3;
-end.
diff --git a/tests/test/tmshlp6.pp b/tests/test/tmshlp6.pp
new file mode 100644
index 0000000000..ff10addbfe
--- /dev/null
+++ b/tests/test/tmshlp6.pp
@@ -0,0 +1,35 @@
+{$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.
diff --git a/tests/test/tmshlp7.pas b/tests/test/tmshlp7.pp
similarity index 100%
rename from tests/test/tmshlp7.pas
rename to tests/test/tmshlp7.pp
diff --git a/tests/test/tmshlp8.pas b/tests/test/tmshlp8.pp
similarity index 100%
rename from tests/test/tmshlp8.pas
rename to tests/test/tmshlp8.pp
diff --git a/tests/test/tmshlp9.pas b/tests/test/tmshlp9.pp
similarity index 100%
rename from tests/test/tmshlp9.pas
rename to tests/test/tmshlp9.pp
-- 
2.17.2 (Apple Git-113)


From 1fadd1915f60ae3ddf120f5cd67f828f0ac092da Mon Sep 17 00:00:00 2001
From: Ryan Joseph <genericptr@gmail.com>
Date: Mon, 25 Feb 2019 10:26:12 -0500
Subject: [PATCH 10/12] disabled m_multi_helpers in $mode delphi

---
 compiler/htypechk.pas  |  2 +-
 compiler/symtable.pas  |  4 ++--
 tests/test/tmshlp12.pp | 37 +++++++++++++++++++++++++++++++++++++
 3 files changed, 40 insertions(+), 3 deletions(-)
 create mode 100644 tests/test/tmshlp12.pp

diff --git a/compiler/htypechk.pas b/compiler/htypechk.pas
index 63b12c31fe..63e94f727e 100644
--- a/compiler/htypechk.pas
+++ b/compiler/htypechk.pas
@@ -2290,7 +2290,7 @@ implementation
                )
                and searchhelpers then
              begin
-               if (m_multi_helpers in current_settings.modeswitches) then
+               if (m_multi_helpers in current_settings.modeswitches) and not (m_delphi in current_settings.modeswitches) then
                  begin
                    helperlist:=get_objectpascal_helpers(structdef);
                    if assigned(helperlist) and (helperlist.count>0) then
diff --git a/compiler/symtable.pas b/compiler/symtable.pas
index f654b2ee46..07ac7f6ab9 100644
--- a/compiler/symtable.pas
+++ b/compiler/symtable.pas
@@ -3768,7 +3768,7 @@ implementation
               exit;
           end;
         { now search all helpers using the extendeddef as the starting point }
-        if m_multi_helpers in current_settings.modeswitches then
+        if (m_multi_helpers in current_settings.modeswitches) and not (m_delphi in current_settings.modeswitches) then
           result:=search_best_objectpascal_helper(s,classh.extendeddef,contextclassh,srsym,srsymtable);
       end;
 
@@ -4116,7 +4116,7 @@ implementation
 
         { if there is no class helper for the class then there is no need to
           search further }
-        if m_multi_helpers in current_settings.modeswitches then
+        if (m_multi_helpers in current_settings.modeswitches) and not (m_delphi in current_settings.modeswitches) then
           result := search_best_objectpascal_helper(s,pd,contextclassh,srsym,srsymtable)
         else
           begin
diff --git a/tests/test/tmshlp12.pp b/tests/test/tmshlp12.pp
new file mode 100644
index 0000000000..bdb3e6e9c0
--- /dev/null
+++ b/tests/test/tmshlp12.pp
@@ -0,0 +1,37 @@
+{%FAIL}
+{$mode delphi}
+{$modeswitch multihelpers}
+
+program tmshlp12;
+
+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.
-- 
2.17.2 (Apple Git-113)


From 649f1022dd61574e9d79411bafff9cd261768bfc Mon Sep 17 00:00:00 2001
From: Ryan Joseph <genericptr@gmail.com>
Date: Mon, 25 Feb 2019 10:47:06 -0500
Subject: [PATCH 11/12] added 2 more tests

---
 tests/test/tmshlp13.pp | 17 +++++++++++++++++
 tests/test/tmshlp14.pp | 19 +++++++++++++++++++
 2 files changed, 36 insertions(+)
 create mode 100644 tests/test/tmshlp13.pp
 create mode 100644 tests/test/tmshlp14.pp

diff --git a/tests/test/tmshlp13.pp b/tests/test/tmshlp13.pp
new file mode 100644
index 0000000000..023b95252d
--- /dev/null
+++ b/tests/test/tmshlp13.pp
@@ -0,0 +1,17 @@
+{$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.
diff --git a/tests/test/tmshlp14.pp b/tests/test/tmshlp14.pp
new file mode 100644
index 0000000000..26cf23e0d8
--- /dev/null
+++ b/tests/test/tmshlp14.pp
@@ -0,0 +1,19 @@
+{$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.
-- 
2.17.2 (Apple Git-113)


From de559132464b8ab68e427550e530f295391c5efc Mon Sep 17 00:00:00 2001
From: Ryan Joseph <genericptr@gmail.com>
Date: Mon, 25 Feb 2019 13:28:55 -0500
Subject: [PATCH 12/12] reverted m_multi_helpers to be allowed in Delphi mode

---
 compiler/globtype.pas | 2 +-
 compiler/htypechk.pas | 2 +-
 compiler/symtable.pas | 4 ++--
 3 files changed, 4 insertions(+), 4 deletions(-)

diff --git a/compiler/globtype.pas b/compiler/globtype.pas
index 06011517d2..c1e530d5b1 100644
--- a/compiler/globtype.pas
+++ b/compiler/globtype.pas
@@ -447,7 +447,7 @@ interface
          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_multi_helpers        { ObjFPC mode only - helpers can appear in multiple scopes simultaneously }
+         m_multi_helpers        { helpers can appear in multiple scopes simultaneously }
        );
        tmodeswitches = set of tmodeswitch;
 
diff --git a/compiler/htypechk.pas b/compiler/htypechk.pas
index 63e94f727e..20b65c5dad 100644
--- a/compiler/htypechk.pas
+++ b/compiler/htypechk.pas
@@ -2290,7 +2290,7 @@ implementation
                )
                and searchhelpers then
              begin
-               if (m_multi_helpers in current_settings.modeswitches) and not (m_delphi in current_settings.modeswitches) then
+               if m_multi_helpers in current_settings.modeswitches then
                  begin
                    helperlist:=get_objectpascal_helpers(structdef);
                    if assigned(helperlist) and (helperlist.count>0) then
diff --git a/compiler/symtable.pas b/compiler/symtable.pas
index 07ac7f6ab9..f654b2ee46 100644
--- a/compiler/symtable.pas
+++ b/compiler/symtable.pas
@@ -3768,7 +3768,7 @@ implementation
               exit;
           end;
         { now search all helpers using the extendeddef as the starting point }
-        if (m_multi_helpers in current_settings.modeswitches) and not (m_delphi in current_settings.modeswitches) then
+        if m_multi_helpers in current_settings.modeswitches then
           result:=search_best_objectpascal_helper(s,classh.extendeddef,contextclassh,srsym,srsymtable);
       end;
 
@@ -4116,7 +4116,7 @@ implementation
 
         { if there is no class helper for the class then there is no need to
           search further }
-        if (m_multi_helpers in current_settings.modeswitches) and not (m_delphi in current_settings.modeswitches) then
+        if m_multi_helpers in current_settings.modeswitches then
           result := search_best_objectpascal_helper(s,pd,contextclassh,srsym,srsymtable)
         else
           begin
-- 
2.17.2 (Apple Git-113)

patch.diff (88,644 bytes)

Sven Barth

2019-03-01 14:54

manager   ~0114538

If you have problems working with Git then use SVN, checkout trunk there, apply your final changes and create a patch from that. The way the patch is right now I'm highly reluctant to commit it and the commit history on Github is also very noisy with debug stuff and such.

Ryan Joseph

2019-03-02 16:31

reporter   ~0114573

I don't understand SVN any better but I'll do some research to see how I can make better patches that don't include history.

Ryan Joseph

2019-03-16 17:14

reporter  

multi-helpers.diff (31,413 bytes)
From cc0dce84472867dc6c35ab48bc0ad0060cacc081 Mon Sep 17 00:00:00 2001
From: Ryan Joseph <genericptr@gmail.com>
Date: Wed, 21 Nov 2018 14:14:14 +0700
Subject: [PATCH] m_multi_helpers for multi-scope helpers

---
 .gitignore               |  24 +++++
 compiler/globtype.pas    |   6 +-
 compiler/htypechk.pas    |  62 +++++++++----
 compiler/pexpr.pas       |   4 +-
 compiler/ryan_ppcx64.lpi |  77 ++++++++++++++++
 compiler/symtable.pas    | 192 +++++++++++++++++++++++++--------------
 tests/test/tmshlp1.pp    |  36 ++++++++
 tests/test/tmshlp10.pp   |  36 ++++++++
 tests/test/tmshlp11.pp   |  38 ++++++++
 tests/test/tmshlp12.pp   |  37 ++++++++
 tests/test/tmshlp13.pp   |  17 ++++
 tests/test/tmshlp14.pp   |  19 ++++
 tests/test/tmshlp2.pp    |  36 ++++++++
 tests/test/tmshlp3.pp    |  32 +++++++
 tests/test/tmshlp4.pp    |  48 ++++++++++
 tests/test/tmshlp5.pp    |  35 +++++++
 tests/test/tmshlp6.pp    |  35 +++++++
 tests/test/tmshlp7.pp    |  27 ++++++
 tests/test/tmshlp8.pp    |  34 +++++++
 tests/test/tmshlp9.pp    |  36 ++++++++
 20 files changed, 741 insertions(+), 90 deletions(-)
 create mode 100644 .gitignore
 create mode 100644 compiler/ryan_ppcx64.lpi
 create mode 100644 tests/test/tmshlp1.pp
 create mode 100644 tests/test/tmshlp10.pp
 create mode 100644 tests/test/tmshlp11.pp
 create mode 100644 tests/test/tmshlp12.pp
 create mode 100644 tests/test/tmshlp13.pp
 create mode 100644 tests/test/tmshlp14.pp
 create mode 100644 tests/test/tmshlp2.pp
 create mode 100644 tests/test/tmshlp3.pp
 create mode 100644 tests/test/tmshlp4.pp
 create mode 100644 tests/test/tmshlp5.pp
 create mode 100644 tests/test/tmshlp6.pp
 create mode 100644 tests/test/tmshlp7.pp
 create mode 100644 tests/test/tmshlp8.pp
 create mode 100644 tests/test/tmshlp9.pp

diff --git a/.gitignore b/.gitignore
new file mode 100644
index 0000000000..16d38503e5
--- /dev/null
+++ b/.gitignore
@@ -0,0 +1,24 @@
+# files
+pp
+fpmake
+rtl/darwin/fpcmade.x86_64-darwin
+fpmake_proc1 copy.inc
+tests/*.x86_64-darwin
+rtl/Package.fpc
+tests/createlst
+tests/gparmake
+compiler/ryan_ppcx64.lpi
+
+# directories
+lazbuild/
+x86_64-darwin/
+tests/tstunits/
+tests/utils
+
+# patterns
+*.app
+*.o
+*.ppu
+*.fpm
+*.rsj
+*.lst
\ No newline at end of file
diff --git a/compiler/globtype.pas b/compiler/globtype.pas
index f883227ca1..5973e8d7d7 100644
--- a/compiler/globtype.pas
+++ b/compiler/globtype.pas
@@ -454,7 +454,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;
 
@@ -643,7 +644,8 @@ interface
          'ISOIO',
          'ISOPROGRAMPARAS',
          'ISOMOD',
-         'ARRAYOPERATORS'
+         'ARRAYOPERATORS',
+         'MULTIHELPERS'
          );
 
 
diff --git a/compiler/htypechk.pas b/compiler/htypechk.pas
index 4e97f903a9..7402930b7f 100644
--- a/compiler/htypechk.pas
+++ b/compiler/htypechk.pas
@@ -2242,6 +2242,33 @@ implementation
                 ProcdefOverloadList.Add(pd);
             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;
@@ -2250,6 +2277,8 @@ implementation
         foundanything : boolean;
         extendeddef : tabstractrecorddef;
         helperdef  : tobjectdef;
+        helperlist : TFPObjectList;
+        i : integer;
       begin
         if FOperator=NOTOKEN then
           hashedid.id:=FProcsym.name
@@ -2269,27 +2298,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;
-                   while assigned(helperdef) do
+                   helperlist:=get_objectpascal_helpers(structdef);
+                   if assigned(helperlist) and (helperlist.count>0) then
                      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;
+                       i:=helperlist.count-1;
+                       repeat
+                         helperdef:=tobjectdef(helperlist[i]);
+                         if (helperdef.owner.symtabletype in [staticsymtable,globalsymtable]) or
+                            is_visible_for_object(helperdef.typesym,helperdef) then
+                              if processhelper(hashedid,helperdef) then
+                                exit;
+                         dec(i);
+                       until (i<0);
                      end;
-                   if not hasoverload and assigned(srsym) then
-                     exit;
-                 end;
+                 end
+               else if search_last_objectpascal_helper(structdef,nil,helperdef) and processhelper(hashedid,helperdef) then
+                  exit;
              end;
            { now search in the type itself }
            srsym:=tsym(structdef.symtable.FindWithHash(hashedid));
diff --git a/compiler/pexpr.pas b/compiler/pexpr.pas
index 251c613ef1..ccb9571cca 100644
--- a/compiler/pexpr.pas
+++ b/compiler/pexpr.pas
@@ -76,7 +76,7 @@ implementation
        fmodule,ppu,
        { pass 1 }
        pass_1,
-       nmat,nadd,nmem,nset,ncnv,ninl,ncon,nld,nflw,nbas,nutils,
+       nmat,nadd,nmem,nset,ncnv,ninl,ncon,nld,nflw,nbas,nutils,htypechk,
        { parser }
        scanner,
        pbase,pinline,ptype,pgenutil,procinfo,cpuinfo
@@ -963,7 +963,6 @@ implementation
          end;
       end;
 
-
     { reads the parameter for a subroutine call }
     procedure do_proc_call(sym:tsym;st:TSymtable;obj:tabstractrecorddef;getaddr:boolean;var again : boolean;var p1:tnode;callflags:tcallnodeflags;spezcontext:tspecializationcontext);
       var
@@ -1967,6 +1966,7 @@ implementation
                   def:=voidpointertype
                 else
                   def:=node.resultdef;
+              { allow multiscope searches }
               result:=search_objectpascal_helper(def,nil,pattern,srsym,srsymtable);
               if result then
                 begin
diff --git a/compiler/ryan_ppcx64.lpi b/compiler/ryan_ppcx64.lpi
new file mode 100644
index 0000000000..6a6220e7d5
--- /dev/null
+++ b/compiler/ryan_ppcx64.lpi
@@ -0,0 +1,77 @@
+<?xml version="1.0"?>
+<CONFIG>
+  <ProjectOptions>
+    <Version Value="9"/>
+    <PathDelim Value="\"/>
+    <General>
+      <Flags>
+        <MainUnitHasUsesSectionForAllUnits Value="False"/>
+        <MainUnitHasCreateFormStatements Value="False"/>
+        <MainUnitHasTitleStatement Value="False"/>
+        <LRSInOutputDirectory Value="False"/>
+      </Flags>
+      <SessionStorage Value="InProjectDir"/>
+      <MainUnit Value="0"/>
+      <Title Value="ppcx64"/>
+    </General>
+    <BuildModes Count="1">
+      <Item1 Name="default" Default="True"/>
+    </BuildModes>
+    <PublishOptions>
+      <Version Value="2"/>
+      <DestinationDirectory Value="$(TestDir)\publishedproject\"/>
+      <IncludeFileFilter Value="*.(pas|pp|inc|lfm|lpr|lrs|lpi|lpk|sh|xml)"/>
+      <ExcludeFileFilter Value="*.(bak|ppu|ppw|o|so);*~;backup"/>
+    </PublishOptions>
+    <RunParams>
+      <local>
+        <FormatVersion Value="1"/>
+        <LaunchingApplication PathPlusParams="/usr/X11R6/bin/xterm -T 'Lazarus Run Output' -e $(LazarusDir)/tools/runwait.sh $(TargetCmdLine)"/>
+      </local>
+    </RunParams>
+    <Units Count="2">
+      <Unit0>
+        <Filename Value="pp.pas"/>
+        <IsPartOfProject Value="True"/>
+        <UnitName Value="pp"/>
+      </Unit0>
+      <Unit1>
+        <Filename Value="x86\aasmcpu.pas"/>
+        <IsPartOfProject Value="True"/>
+        <UnitName Value="aasmcpu"/>
+      </Unit1>
+    </Units>
+  </ProjectOptions>
+  <CompilerOptions>
+    <Version Value="11"/>
+    <PathDelim Value="\"/>
+    <Target>
+      <Filename Value="x86_64\pp"/>
+    </Target>
+    <SearchPaths>
+      <IncludeFiles Value="x86_64"/>
+      <OtherUnitFiles Value="x86_64;x86;systems"/>
+      <UnitOutputDirectory Value="x86_64\lazbuild"/>
+    </SearchPaths>
+    <Parsing>
+      <SyntaxOptions>
+        <CStyleOperator Value="False"/>
+        <AllowLabel Value="False"/>
+        <CPPInline Value="False"/>
+        <UseAnsiStrings Value="False"/>
+      </SyntaxOptions>
+    </Parsing>
+    <Other>
+      <Verbosity>
+        <ShowWarn Value="False"/>
+        <ShowNotes Value="False"/>
+        <ShowHints Value="False"/>
+      </Verbosity>
+      <ConfigFile>
+        <StopAfterErrCount Value="50"/>
+      </ConfigFile>
+      <CustomOptions Value="-dx86_64 -gw -godwarfcpp"/>
+      <CompilerPath Value="$(CompPath)"/>
+    </Other>
+  </CompilerOptions>
+</CONFIG>
diff --git a/compiler/symtable.pas b/compiler/symtable.pas
index c7abd7da58..38f7777a12 100644
--- a/compiler/symtable.pas
+++ b/compiler/symtable.pas
@@ -373,7 +373,7 @@ interface
     function  search_last_objectpascal_helper(pd : tdef;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 : tdef;contextclassh : tabstractrecorddef;const s : string; out srsym: tsym; out srsymtable: tsymtable):boolean;
+    function  search_objectpascal_helper(pd : tdef;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, }
@@ -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!) }
-          result:=searchsym_in_class(tobjectdef(classh.extendeddef).childof,contextclassh,s,srsym,srsymtable,flags+[ssf_search_helper]);
-          { addsymref is already called by searchsym_in_class }
+          begin
+            result:=searchsym_in_class(tobjectdef(classh.extendeddef).childof,contextclassh,s,srsym,srsymtable,flags+[ssf_search_helper]);
+            { 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_objectdef(const s: string;classh : tobjectdef;contextclassh : tabstractrecorddef;out srsym: tsym; out srsymtable: tsymtable): boolean;
       var
-        s: string;
-        list: TFPObjectList;
+        hashedid  : THashedIDString;
+        pdef: tprocdef;
         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_objectdef(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
-          exit;
-
-        hashedid.id:=s;
-
-        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;
-                        { 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;
+        if m_multi_helpers in current_settings.modeswitches then
+          result := search_best_objectpascal_helper(s,pd,contextclassh,srsym,srsymtable)
+        else
+          begin
+            if search_last_objectpascal_helper(pd,contextclassh,classh) and
+               search_objectdef(s,classh,contextclassh,srsym,srsymtable) then
+                result:=true;
+          end;
 
-        srsym:=nil;
-        srsymtable:=nil;
+        if result then
+          begin
+            { 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 (srsym.typ = procsym) and
+               assigned(current_procinfo) and
+               (srsym.owner.symtabletype=staticsymtable) then
+              include(current_procinfo.flags,pi_uses_static_symtable);
+            addsymref(srsym);
+          end
+        else
+          begin
+            srsym:=nil;
+            srsymtable:=nil;
+          end;
       end;
 
     function search_objc_helper(pd : tobjectdef;const s : string; out srsym: tsym; out srsymtable: tsymtable):boolean;
diff --git a/tests/test/tmshlp1.pp b/tests/test/tmshlp1.pp
new file mode 100644
index 0000000000..efab230519
--- /dev/null
+++ b/tests/test/tmshlp1.pp
@@ -0,0 +1,36 @@
+{$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.
diff --git a/tests/test/tmshlp10.pp b/tests/test/tmshlp10.pp
new file mode 100644
index 0000000000..db02f1e09f
--- /dev/null
+++ b/tests/test/tmshlp10.pp
@@ -0,0 +1,36 @@
+{$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.
diff --git a/tests/test/tmshlp11.pp b/tests/test/tmshlp11.pp
new file mode 100644
index 0000000000..87b52f625a
--- /dev/null
+++ b/tests/test/tmshlp11.pp
@@ -0,0 +1,38 @@
+{$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.
diff --git a/tests/test/tmshlp12.pp b/tests/test/tmshlp12.pp
new file mode 100644
index 0000000000..bdb3e6e9c0
--- /dev/null
+++ b/tests/test/tmshlp12.pp
@@ -0,0 +1,37 @@
+{%FAIL}
+{$mode delphi}
+{$modeswitch multihelpers}
+
+program tmshlp12;
+
+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.
diff --git a/tests/test/tmshlp13.pp b/tests/test/tmshlp13.pp
new file mode 100644
index 0000000000..023b95252d
--- /dev/null
+++ b/tests/test/tmshlp13.pp
@@ -0,0 +1,17 @@
+{$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.
diff --git a/tests/test/tmshlp14.pp b/tests/test/tmshlp14.pp
new file mode 100644
index 0000000000..26cf23e0d8
--- /dev/null
+++ b/tests/test/tmshlp14.pp
@@ -0,0 +1,19 @@
+{$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.
diff --git a/tests/test/tmshlp2.pp b/tests/test/tmshlp2.pp
new file mode 100644
index 0000000000..177505f567
--- /dev/null
+++ b/tests/test/tmshlp2.pp
@@ -0,0 +1,36 @@
+{$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.
diff --git a/tests/test/tmshlp3.pp b/tests/test/tmshlp3.pp
new file mode 100644
index 0000000000..ca030de79c
--- /dev/null
+++ b/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.
\ No newline at end of file
diff --git a/tests/test/tmshlp4.pp b/tests/test/tmshlp4.pp
new file mode 100644
index 0000000000..c90995a09d
--- /dev/null
+++ b/tests/test/tmshlp4.pp
@@ -0,0 +1,48 @@
+{$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.
diff --git a/tests/test/tmshlp5.pp b/tests/test/tmshlp5.pp
new file mode 100644
index 0000000000..d0dc99b607
--- /dev/null
+++ b/tests/test/tmshlp5.pp
@@ -0,0 +1,35 @@
+{$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.
diff --git a/tests/test/tmshlp6.pp b/tests/test/tmshlp6.pp
new file mode 100644
index 0000000000..ff10addbfe
--- /dev/null
+++ b/tests/test/tmshlp6.pp
@@ -0,0 +1,35 @@
+{$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.
diff --git a/tests/test/tmshlp7.pp b/tests/test/tmshlp7.pp
new file mode 100644
index 0000000000..5702b0959a
--- /dev/null
+++ b/tests/test/tmshlp7.pp
@@ -0,0 +1,27 @@
+{$mode objfpc}
+{$modeswitch advancedrecords}
+{$modeswitch typehelpers}
+
+unit tmshlp7;
+interface
+
+type
+	TExtClassHelper = class helper for TObject
+		procedure DoThisExt;
+	end;
+	TExtStringHelper = type helper for String
+		function LengthExt: integer;
+	end;
+
+implementation
+	
+procedure TExtClassHelper.DoThisExt;
+begin	
+end;
+
+function TExtStringHelper.LengthExt: integer;
+begin
+	result := System.Length(self);
+end;
+
+end.
diff --git a/tests/test/tmshlp8.pp b/tests/test/tmshlp8.pp
new file mode 100644
index 0000000000..242a54b968
--- /dev/null
+++ b/tests/test/tmshlp8.pp
@@ -0,0 +1,34 @@
+{$mode objfpc}
+{$modeswitch typehelpers}
+{$modeswitch multihelpers}
+
+program tmshlp8;
+uses
+	tmshlp7;
+
+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);
+end.
diff --git a/tests/test/tmshlp9.pp b/tests/test/tmshlp9.pp
new file mode 100644
index 0000000000..dbd830e425
--- /dev/null
+++ b/tests/test/tmshlp9.pp
@@ -0,0 +1,36 @@
+{$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.
-- 
2.17.2 (Apple Git-113)

multi-helpers.diff (31,413 bytes)

Ryan Joseph

2019-03-16 17:16

reporter   ~0114868

I added a new patch which I think resolves these issues (created by applying the old patch to a new repository and squishing commit history). However, I still messed up and included a .gitignore and .lpi file which I hope you can just delete after you apply the patch because remaking the patch will be lots of work.

Ryan Joseph

2019-03-25 16:20

reporter  

patch_3_25.diff (29,042 bytes)
From ffe084bc0381046531b64a005f38a0698f985ba2 Mon Sep 17 00:00:00 2001
From: Ryan Joseph <genericptr@gmail.com>
Date: Wed, 21 Nov 2018 14:14:14 +0700
Subject: [PATCH] multi-helpers

---
 .gitignore             |  24 ++++++
 compiler/globtype.pas  |   6 +-
 compiler/htypechk.pas  |  62 +++++++++----
 compiler/pexpr.pas     |   4 +-
 compiler/ppu.pas       |   2 +-
 compiler/symtable.pas  | 192 ++++++++++++++++++++++++++---------------
 tests/test/tmshlp1.pp  |  36 ++++++++
 tests/test/tmshlp10.pp |  36 ++++++++
 tests/test/tmshlp11.pp |  38 ++++++++
 tests/test/tmshlp12.pp |  37 ++++++++
 tests/test/tmshlp13.pp |  17 ++++
 tests/test/tmshlp14.pp |  19 ++++
 tests/test/tmshlp2.pp  |  36 ++++++++
 tests/test/tmshlp3.pp  |  32 +++++++
 tests/test/tmshlp4.pp  |  48 +++++++++++
 tests/test/tmshlp5.pp  |  35 ++++++++
 tests/test/tmshlp6.pp  |  35 ++++++++
 tests/test/tmshlp7.pp  |  27 ++++++
 tests/test/tmshlp8.pp  |  34 ++++++++
 tests/test/tmshlp9.pp  |  36 ++++++++
 20 files changed, 665 insertions(+), 91 deletions(-)
 create mode 100644 .gitignore
 create mode 100644 tests/test/tmshlp1.pp
 create mode 100644 tests/test/tmshlp10.pp
 create mode 100644 tests/test/tmshlp11.pp
 create mode 100644 tests/test/tmshlp12.pp
 create mode 100644 tests/test/tmshlp13.pp
 create mode 100644 tests/test/tmshlp14.pp
 create mode 100644 tests/test/tmshlp2.pp
 create mode 100644 tests/test/tmshlp3.pp
 create mode 100644 tests/test/tmshlp4.pp
 create mode 100644 tests/test/tmshlp5.pp
 create mode 100644 tests/test/tmshlp6.pp
 create mode 100644 tests/test/tmshlp7.pp
 create mode 100644 tests/test/tmshlp8.pp
 create mode 100644 tests/test/tmshlp9.pp

diff --git a/.gitignore b/.gitignore
new file mode 100644
index 0000000000..16d38503e5
--- /dev/null
+++ b/.gitignore
@@ -0,0 +1,24 @@
+# files
+pp
+fpmake
+rtl/darwin/fpcmade.x86_64-darwin
+fpmake_proc1 copy.inc
+tests/*.x86_64-darwin
+rtl/Package.fpc
+tests/createlst
+tests/gparmake
+compiler/ryan_ppcx64.lpi
+
+# directories
+lazbuild/
+x86_64-darwin/
+tests/tstunits/
+tests/utils
+
+# patterns
+*.app
+*.o
+*.ppu
+*.fpm
+*.rsj
+*.lst
\ No newline at end of file
diff --git a/compiler/globtype.pas b/compiler/globtype.pas
index 7d23464d57..c1e530d5b1 100644
--- a/compiler/globtype.pas
+++ b/compiler/globtype.pas
@@ -446,7 +446,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;
 
@@ -635,7 +636,8 @@ interface
          'ISOIO',
          'ISOPROGRAMPARAS',
          'ISOMOD',
-         'ARRAYOPERATORS'
+         'ARRAYOPERATORS',
+         'MULTIHELPERS'
          );
 
 
diff --git a/compiler/htypechk.pas b/compiler/htypechk.pas
index 07c035dc26..06c0ca4b5c 100644
--- a/compiler/htypechk.pas
+++ b/compiler/htypechk.pas
@@ -2234,6 +2234,33 @@ implementation
                 ProcdefOverloadList.Add(pd);
             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;
@@ -2242,6 +2269,8 @@ implementation
         foundanything : boolean;
         extendeddef : tabstractrecorddef;
         helperdef  : tobjectdef;
+        helperlist : TFPObjectList;
+        i : integer;
       begin
         if FOperator=NOTOKEN then
           hashedid.id:=FProcsym.name
@@ -2261,27 +2290,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;
-                   while assigned(helperdef) do
+                   helperlist:=get_objectpascal_helpers(structdef);
+                   if assigned(helperlist) and (helperlist.count>0) then
                      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;
+                       i:=helperlist.count-1;
+                       repeat
+                         helperdef:=tobjectdef(helperlist[i]);
+                         if (helperdef.owner.symtabletype in [staticsymtable,globalsymtable]) or
+                            is_visible_for_object(helperdef.typesym,helperdef) then
+                              if processhelper(hashedid,helperdef) then
+                                exit;
+                         dec(i);
+                       until (i<0);
                      end;
-                   if not hasoverload and assigned(srsym) then
-                     exit;
-                 end;
+                 end
+               else if search_last_objectpascal_helper(structdef,nil,helperdef) and processhelper(hashedid,helperdef) then
+                  exit;
              end;
            { now search in the type itself }
            srsym:=tsym(structdef.symtable.FindWithHash(hashedid));
diff --git a/compiler/pexpr.pas b/compiler/pexpr.pas
index bc0606ed4b..39bb5e1de5 100644
--- a/compiler/pexpr.pas
+++ b/compiler/pexpr.pas
@@ -76,7 +76,7 @@ implementation
        fmodule,ppu,
        { pass 1 }
        pass_1,
-       nmat,nadd,nmem,nset,ncnv,ninl,ncon,nld,nflw,nbas,nutils,
+       nmat,nadd,nmem,nset,ncnv,ninl,ncon,nld,nflw,nbas,nutils,htypechk,
        { parser }
        scanner,
        pbase,pinline,ptype,pgenutil,procinfo,cpuinfo
@@ -962,7 +962,6 @@ implementation
          end;
       end;
 
-
     { reads the parameter for a subroutine call }
     procedure do_proc_call(sym:tsym;st:TSymtable;obj:tabstractrecorddef;getaddr:boolean;var again : boolean;var p1:tnode;callflags:tcallnodeflags;spezcontext:tspecializationcontext);
       var
@@ -1932,6 +1931,7 @@ implementation
                   def:=voidpointertype
                 else
                   def:=node.resultdef;
+              { allow multiscope searches }
               result:=search_objectpascal_helper(def,nil,pattern,srsym,srsymtable);
               if result then
                 begin
diff --git a/compiler/ppu.pas b/compiler/ppu.pas
index 10c42e7eb8..31011be3e8 100644
--- a/compiler/ppu.pas
+++ b/compiler/ppu.pas
@@ -43,7 +43,7 @@ type
 {$endif Test_Double_checksum}
 
 const
-  CurrentPPUVersion = 201;
+  CurrentPPUVersion = 203;
 
 { unit flags }
   uf_init                = $000001; { unit has initialization section }
diff --git a/compiler/symtable.pas b/compiler/symtable.pas
index 796b2d6736..f654b2ee46 100644
--- a/compiler/symtable.pas
+++ b/compiler/symtable.pas
@@ -358,7 +358,7 @@ interface
     function  search_last_objectpascal_helper(pd : tdef;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 : tdef;contextclassh : tabstractrecorddef;const s : string; out srsym: tsym; out srsymtable: tsymtable):boolean;
+    function  search_objectpascal_helper(pd : tdef;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, }
@@ -368,6 +368,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;
@@ -3694,6 +3696,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;
@@ -3755,10 +3759,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!) }
-          result:=searchsym_in_class(tobjectdef(classh.extendeddef).childof,contextclassh,s,srsym,srsymtable,flags+[ssf_search_helper]);
-          { addsymref is already called by searchsym_in_class }
+          begin
+            result:=searchsym_in_class(tobjectdef(classh.extendeddef).childof,contextclassh,s,srsym,srsymtable,flags+[ssf_search_helper]);
+            { 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;
@@ -3971,15 +3982,59 @@ implementation
           end;
       end;
 
-    function search_last_objectpascal_helper(pd : tdef;contextclassh : tabstractrecorddef;out odef : tobjectdef):boolean;
+    function search_objectdef(const s: string;classh : tobjectdef;contextclassh : tabstractrecorddef;out srsym: tsym; out srsymtable: tsymtable): boolean;
       var
-        s: string;
-        list: TFPObjectList;
+        hashedid  : THashedIDString;
+        pdef: tprocdef;
         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
@@ -4002,7 +4057,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_objectdef(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;
@@ -4019,72 +4109,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
-          exit;
-
-        hashedid.id:=s;
-
-        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;
-                        { 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;
+        if m_multi_helpers in current_settings.modeswitches then
+          result := search_best_objectpascal_helper(s,pd,contextclassh,srsym,srsymtable)
+        else
+          begin
+            if search_last_objectpascal_helper(pd,contextclassh,classh) and
+               search_objectdef(s,classh,contextclassh,srsym,srsymtable) then
+                result:=true;
+          end;
 
-        srsym:=nil;
-        srsymtable:=nil;
+        if result then
+          begin
+            { 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 (srsym.typ = procsym) and
+               assigned(current_procinfo) and
+               (srsym.owner.symtabletype=staticsymtable) then
+              include(current_procinfo.flags,pi_uses_static_symtable);
+            addsymref(srsym);
+          end
+        else
+          begin
+            srsym:=nil;
+            srsymtable:=nil;
+          end;
       end;
 
     function search_objc_helper(pd : tobjectdef;const s : string; out srsym: tsym; out srsymtable: tsymtable):boolean;
diff --git a/tests/test/tmshlp1.pp b/tests/test/tmshlp1.pp
new file mode 100644
index 0000000000..efab230519
--- /dev/null
+++ b/tests/test/tmshlp1.pp
@@ -0,0 +1,36 @@
+{$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.
diff --git a/tests/test/tmshlp10.pp b/tests/test/tmshlp10.pp
new file mode 100644
index 0000000000..db02f1e09f
--- /dev/null
+++ b/tests/test/tmshlp10.pp
@@ -0,0 +1,36 @@
+{$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.
diff --git a/tests/test/tmshlp11.pp b/tests/test/tmshlp11.pp
new file mode 100644
index 0000000000..87b52f625a
--- /dev/null
+++ b/tests/test/tmshlp11.pp
@@ -0,0 +1,38 @@
+{$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.
diff --git a/tests/test/tmshlp12.pp b/tests/test/tmshlp12.pp
new file mode 100644
index 0000000000..bdb3e6e9c0
--- /dev/null
+++ b/tests/test/tmshlp12.pp
@@ -0,0 +1,37 @@
+{%FAIL}
+{$mode delphi}
+{$modeswitch multihelpers}
+
+program tmshlp12;
+
+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.
diff --git a/tests/test/tmshlp13.pp b/tests/test/tmshlp13.pp
new file mode 100644
index 0000000000..023b95252d
--- /dev/null
+++ b/tests/test/tmshlp13.pp
@@ -0,0 +1,17 @@
+{$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.
diff --git a/tests/test/tmshlp14.pp b/tests/test/tmshlp14.pp
new file mode 100644
index 0000000000..26cf23e0d8
--- /dev/null
+++ b/tests/test/tmshlp14.pp
@@ -0,0 +1,19 @@
+{$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.
diff --git a/tests/test/tmshlp2.pp b/tests/test/tmshlp2.pp
new file mode 100644
index 0000000000..177505f567
--- /dev/null
+++ b/tests/test/tmshlp2.pp
@@ -0,0 +1,36 @@
+{$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.
diff --git a/tests/test/tmshlp3.pp b/tests/test/tmshlp3.pp
new file mode 100644
index 0000000000..ca030de79c
--- /dev/null
+++ b/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.
\ No newline at end of file
diff --git a/tests/test/tmshlp4.pp b/tests/test/tmshlp4.pp
new file mode 100644
index 0000000000..c90995a09d
--- /dev/null
+++ b/tests/test/tmshlp4.pp
@@ -0,0 +1,48 @@
+{$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.
diff --git a/tests/test/tmshlp5.pp b/tests/test/tmshlp5.pp
new file mode 100644
index 0000000000..d0dc99b607
--- /dev/null
+++ b/tests/test/tmshlp5.pp
@@ -0,0 +1,35 @@
+{$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.
diff --git a/tests/test/tmshlp6.pp b/tests/test/tmshlp6.pp
new file mode 100644
index 0000000000..ff10addbfe
--- /dev/null
+++ b/tests/test/tmshlp6.pp
@@ -0,0 +1,35 @@
+{$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.
diff --git a/tests/test/tmshlp7.pp b/tests/test/tmshlp7.pp
new file mode 100644
index 0000000000..5702b0959a
--- /dev/null
+++ b/tests/test/tmshlp7.pp
@@ -0,0 +1,27 @@
+{$mode objfpc}
+{$modeswitch advancedrecords}
+{$modeswitch typehelpers}
+
+unit tmshlp7;
+interface
+
+type
+	TExtClassHelper = class helper for TObject
+		procedure DoThisExt;
+	end;
+	TExtStringHelper = type helper for String
+		function LengthExt: integer;
+	end;
+
+implementation
+	
+procedure TExtClassHelper.DoThisExt;
+begin	
+end;
+
+function TExtStringHelper.LengthExt: integer;
+begin
+	result := System.Length(self);
+end;
+
+end.
diff --git a/tests/test/tmshlp8.pp b/tests/test/tmshlp8.pp
new file mode 100644
index 0000000000..242a54b968
--- /dev/null
+++ b/tests/test/tmshlp8.pp
@@ -0,0 +1,34 @@
+{$mode objfpc}
+{$modeswitch typehelpers}
+{$modeswitch multihelpers}
+
+program tmshlp8;
+uses
+	tmshlp7;
+
+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);
+end.
diff --git a/tests/test/tmshlp9.pp b/tests/test/tmshlp9.pp
new file mode 100644
index 0000000000..dbd830e425
--- /dev/null
+++ b/tests/test/tmshlp9.pp
@@ -0,0 +1,36 @@
+{$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.
-- 
2.17.2 (Apple Git-113)

patch_3_25.diff (29,042 bytes)

Ryan Joseph

2019-03-25 16:21

reporter   ~0115043

uploaded new patch which reverted back no-op changes caused by bad line endings in a file.

Btw, I just noticed I misspelled the summary "path" instead of "patch". How can I fix that? It doesn't matter but it's kind of annoying. :)

Sven Barth

2019-04-05 17:50

manager   ~0115247

In general this looks good and nearly ready for commit. I still have a few remarks however:

- don't add .gitignore (maybe we'll add an official .gitignore in the future, but this is not part of this issue)
- are the changes in pexpr.pas really necessary? Both the inclusion of htypechk and the added comment that looks a bit lost there...
- you didn't change the structure of what is written to the PPU, so increasing the PPU version is not necessary
- maybe better rename search_objectdef to search_sym_in_helperdef, as the former sounds a bit more general and for now the function is only used to search inside a helper
- tmshlp7 should be named umshlp8 as it isn't really a test by itself, but is only used by tmshlp8 (the test suite picks up all files that start with "t" and end with ".pp" no matter whether its a program or a unit); of course that means that you need a new tmshlp7 :P
- I'm missing a bit tests that handle "conflicts", like tmshlp10 does: for example tests that check that changing the order of helpers changes the called function if both helpers contain one with the same declaration, or what if you have one helper inherit from another, adding a function with the same signature and then having both in scope
- why is tmshlp12 supposed to FAIL? You aren't checking for mode Delphi as far as I can see or am I missing something?
- you could add "{ %NORUN }" to tests that only check correct compilation, this way they aren't run when they don't need to be run (avoids unnecessary process starts on more tight systems)

Ryan Joseph

2019-04-06 16:12

reporter   ~0115266

Ok I'll fix these things but not sure how to remove .gitignore without deleting it entirely from the project (which means it doesn't ignore all the files it's supposed to). However I found a bug when making a new test that mixes helpers with plain functions so I need to fix that now.

If you have any other tests you want to see please post them. I'm not sure I understand the other conflict cases you wanted to see. I added this test which verifies the correct function was called (the last one) but not sure that's what you wanted to see.

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.

Ryan Joseph

2019-04-06 16:52

reporter   ~0115272

About the bug I thought I found, it's not actually related to my work. Why doesn't this work? I would think you could overload both of the functions. (built with 3.3.1).

{$mode objfpc}
program test;

type
  TMyObject = class
  end;
  THelper = class helper for TMyObject
    procedure DoThis; overload;
  end;

procedure DoThis (param: string); overload;
begin
end;

procedure THelper.DoThis;
begin
  DoThis('string'); // ERROR: Wrong number of parameters specified for call to "DoThis"
end;

begin
end.

Ryan Joseph

2019-04-10 16:08

reporter  

patch_4_10.diff (28,064 bytes)
From 4a98247d2b2ab6a4db7ab3e60ffa6da05d3d6906 Mon Sep 17 00:00:00 2001
From: Ryan Joseph <genericptr@gmail.com>
Date: Wed, 21 Nov 2018 14:14:14 +0700
Subject: [PATCH] multi-helpers

---
 compiler/globtype.pas  |   6 +-
 compiler/htypechk.pas  |  62 +++++++++----
 compiler/symtable.pas  | 192 ++++++++++++++++++++++++++---------------
 tests/test/tmshlp1.pp  |  36 ++++++++
 tests/test/tmshlp10.pp |  36 ++++++++
 tests/test/tmshlp11.pp |  38 ++++++++
 tests/test/tmshlp12.pp |  43 +++++++++
 tests/test/tmshlp13.pp |  17 ++++
 tests/test/tmshlp14.pp |  19 ++++
 tests/test/tmshlp2.pp  |  36 ++++++++
 tests/test/tmshlp3.pp  |  32 +++++++
 tests/test/tmshlp4.pp  |  48 +++++++++++
 tests/test/tmshlp5.pp  |  35 ++++++++
 tests/test/tmshlp6.pp  |  35 ++++++++
 tests/test/tmshlp7.pp  |  36 ++++++++
 tests/test/tmshlp8.pp  |  34 ++++++++
 tests/test/tmshlp9.pp  |  36 ++++++++
 tests/test/umshlp1.pp  |  35 ++++++++
 18 files changed, 688 insertions(+), 88 deletions(-)
 create mode 100644 tests/test/tmshlp1.pp
 create mode 100644 tests/test/tmshlp10.pp
 create mode 100644 tests/test/tmshlp11.pp
 create mode 100644 tests/test/tmshlp12.pp
 create mode 100644 tests/test/tmshlp13.pp
 create mode 100644 tests/test/tmshlp14.pp
 create mode 100644 tests/test/tmshlp2.pp
 create mode 100644 tests/test/tmshlp3.pp
 create mode 100644 tests/test/tmshlp4.pp
 create mode 100644 tests/test/tmshlp5.pp
 create mode 100644 tests/test/tmshlp6.pp
 create mode 100644 tests/test/tmshlp7.pp
 create mode 100644 tests/test/tmshlp8.pp
 create mode 100644 tests/test/tmshlp9.pp
 create mode 100644 tests/test/umshlp1.pp

diff --git a/compiler/globtype.pas b/compiler/globtype.pas
index 7d23464d57..c1e530d5b1 100644
--- a/compiler/globtype.pas
+++ b/compiler/globtype.pas
@@ -446,7 +446,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;
 
@@ -635,7 +636,8 @@ interface
          'ISOIO',
          'ISOPROGRAMPARAS',
          'ISOMOD',
-         'ARRAYOPERATORS'
+         'ARRAYOPERATORS',
+         'MULTIHELPERS'
          );
 
 
diff --git a/compiler/htypechk.pas b/compiler/htypechk.pas
index 07c035dc26..06c0ca4b5c 100644
--- a/compiler/htypechk.pas
+++ b/compiler/htypechk.pas
@@ -2234,6 +2234,33 @@ implementation
                 ProcdefOverloadList.Add(pd);
             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;
@@ -2242,6 +2269,8 @@ implementation
         foundanything : boolean;
         extendeddef : tabstractrecorddef;
         helperdef  : tobjectdef;
+        helperlist : TFPObjectList;
+        i : integer;
       begin
         if FOperator=NOTOKEN then
           hashedid.id:=FProcsym.name
@@ -2261,27 +2290,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;
-                   while assigned(helperdef) do
+                   helperlist:=get_objectpascal_helpers(structdef);
+                   if assigned(helperlist) and (helperlist.count>0) then
                      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;
+                       i:=helperlist.count-1;
+                       repeat
+                         helperdef:=tobjectdef(helperlist[i]);
+                         if (helperdef.owner.symtabletype in [staticsymtable,globalsymtable]) or
+                            is_visible_for_object(helperdef.typesym,helperdef) then
+                              if processhelper(hashedid,helperdef) then
+                                exit;
+                         dec(i);
+                       until (i<0);
                      end;
-                   if not hasoverload and assigned(srsym) then
-                     exit;
-                 end;
+                 end
+               else if search_last_objectpascal_helper(structdef,nil,helperdef) and processhelper(hashedid,helperdef) then
+                  exit;
              end;
            { now search in the type itself }
            srsym:=tsym(structdef.symtable.FindWithHash(hashedid));
diff --git a/compiler/symtable.pas b/compiler/symtable.pas
index 796b2d6736..53544977e1 100644
--- a/compiler/symtable.pas
+++ b/compiler/symtable.pas
@@ -358,7 +358,7 @@ interface
     function  search_last_objectpascal_helper(pd : tdef;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 : tdef;contextclassh : tabstractrecorddef;const s : string; out srsym: tsym; out srsymtable: tsymtable):boolean;
+    function  search_objectpascal_helper(pd : tdef;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, }
@@ -368,6 +368,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;
@@ -3694,6 +3696,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;
@@ -3755,10 +3759,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!) }
-          result:=searchsym_in_class(tobjectdef(classh.extendeddef).childof,contextclassh,s,srsym,srsymtable,flags+[ssf_search_helper]);
-          { addsymref is already called by searchsym_in_class }
+          begin
+            result:=searchsym_in_class(tobjectdef(classh.extendeddef).childof,contextclassh,s,srsym,srsymtable,flags+[ssf_search_helper]);
+            { 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;
@@ -3971,15 +3982,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;
-        list: TFPObjectList;
+        hashedid  : THashedIDString;
+        pdef: tprocdef;
         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
@@ -4002,7 +4057,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;
@@ -4019,72 +4109,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
-          exit;
-
-        hashedid.id:=s;
-
-        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;
-                        { 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;
+        if m_multi_helpers in current_settings.modeswitches then
+          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;
 
-        srsym:=nil;
-        srsymtable:=nil;
+        if result then
+          begin
+            { 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 (srsym.typ = procsym) and
+               assigned(current_procinfo) and
+               (srsym.owner.symtabletype=staticsymtable) then
+              include(current_procinfo.flags,pi_uses_static_symtable);
+            addsymref(srsym);
+          end
+        else
+          begin
+            srsym:=nil;
+            srsymtable:=nil;
+          end;
       end;
 
     function search_objc_helper(pd : tobjectdef;const s : string; out srsym: tsym; out srsymtable: tsymtable):boolean;
diff --git a/tests/test/tmshlp1.pp b/tests/test/tmshlp1.pp
new file mode 100644
index 0000000000..efab230519
--- /dev/null
+++ b/tests/test/tmshlp1.pp
@@ -0,0 +1,36 @@
+{$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.
diff --git a/tests/test/tmshlp10.pp b/tests/test/tmshlp10.pp
new file mode 100644
index 0000000000..db02f1e09f
--- /dev/null
+++ b/tests/test/tmshlp10.pp
@@ -0,0 +1,36 @@
+{$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.
diff --git a/tests/test/tmshlp11.pp b/tests/test/tmshlp11.pp
new file mode 100644
index 0000000000..87b52f625a
--- /dev/null
+++ b/tests/test/tmshlp11.pp
@@ -0,0 +1,38 @@
+{$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.
diff --git a/tests/test/tmshlp12.pp b/tests/test/tmshlp12.pp
new file mode 100644
index 0000000000..6483db996f
--- /dev/null
+++ b/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.
diff --git a/tests/test/tmshlp13.pp b/tests/test/tmshlp13.pp
new file mode 100644
index 0000000000..023b95252d
--- /dev/null
+++ b/tests/test/tmshlp13.pp
@@ -0,0 +1,17 @@
+{$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.
diff --git a/tests/test/tmshlp14.pp b/tests/test/tmshlp14.pp
new file mode 100644
index 0000000000..26cf23e0d8
--- /dev/null
+++ b/tests/test/tmshlp14.pp
@@ -0,0 +1,19 @@
+{$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.
diff --git a/tests/test/tmshlp2.pp b/tests/test/tmshlp2.pp
new file mode 100644
index 0000000000..177505f567
--- /dev/null
+++ b/tests/test/tmshlp2.pp
@@ -0,0 +1,36 @@
+{$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.
diff --git a/tests/test/tmshlp3.pp b/tests/test/tmshlp3.pp
new file mode 100644
index 0000000000..ca030de79c
--- /dev/null
+++ b/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.
\ No newline at end of file
diff --git a/tests/test/tmshlp4.pp b/tests/test/tmshlp4.pp
new file mode 100644
index 0000000000..c90995a09d
--- /dev/null
+++ b/tests/test/tmshlp4.pp
@@ -0,0 +1,48 @@
+{$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.
diff --git a/tests/test/tmshlp5.pp b/tests/test/tmshlp5.pp
new file mode 100644
index 0000000000..d0dc99b607
--- /dev/null
+++ b/tests/test/tmshlp5.pp
@@ -0,0 +1,35 @@
+{$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.
diff --git a/tests/test/tmshlp6.pp b/tests/test/tmshlp6.pp
new file mode 100644
index 0000000000..ff10addbfe
--- /dev/null
+++ b/tests/test/tmshlp6.pp
@@ -0,0 +1,35 @@
+{$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.
diff --git a/tests/test/tmshlp7.pp b/tests/test/tmshlp7.pp
new file mode 100644
index 0000000000..d475a503b6
--- /dev/null
+++ b/tests/test/tmshlp7.pp
@@ -0,0 +1,36 @@
+{$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.
diff --git a/tests/test/tmshlp8.pp b/tests/test/tmshlp8.pp
new file mode 100644
index 0000000000..9473b5e9fb
--- /dev/null
+++ b/tests/test/tmshlp8.pp
@@ -0,0 +1,34 @@
+{$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.
diff --git a/tests/test/tmshlp9.pp b/tests/test/tmshlp9.pp
new file mode 100644
index 0000000000..dbd830e425
--- /dev/null
+++ b/tests/test/tmshlp9.pp
@@ -0,0 +1,36 @@
+{$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.
diff --git a/tests/test/umshlp1.pp b/tests/test/umshlp1.pp
new file mode 100644
index 0000000000..29766816bb
--- /dev/null
+++ b/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.
-- 
2.17.2 (Apple Git-113)

patch_4_10.diff (28,064 bytes)

Ryan Joseph

2019-04-10 16:20

reporter   ~0115392

I didn't hear back yet so I uploaded another patch with the requested changes. I couldn't think of any more ways to test for conflicts like requested. The only one I have like that is tmshlp12 which verifies the correct method was called.

If we think of more tests later can we add them without me making a full patch like this? I'm getting better using git but it's still pretty tedious.

Sven Barth

2019-04-14 21:11

manager   ~0115505

Last edited: 2019-04-14 21:12

View 2 revisions

What I'm thinking about is this:

=== code begin ===

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.

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.

program tmshlp15;

uses
  umshlp15a, umshlp15b;

var
  o: TObject;
begin
  if o.Test <> 2 then
    Halt(1);
end.

program tmshlp16;

uses
  umshlp15b, umshlp15a;

var
  o: TObject;
begin
  if o.Test <> 1 then
    Halt(1);
end.

=== code end ===

You see what I mean?

Ryan Joseph

2019-04-15 02:44

reporter   ~0115512

Got it. These tests do indeed pass. Can you add the tests yourself after the main patch is applied? That would be nice. ;)

Ryan Joseph

2019-05-04 23:03

reporter   ~0116013

Any news on this Sven? The last test you posted passed so I was hoping you could just copy and paste it from here when you merge. If not I'll make another patch.

Sven Barth

2019-05-10 16:06

manager   ~0116120

Sorry, had been busy since then.

Thank you for the patch and the feature. Please test and close if okay.

Ryan Joseph

2019-05-12 23:47

reporter   ~0116151

Thanks Sven, tested and working so closing the issue now.

Issue History

Date Modified Username Field Change
2019-02-27 15:36 Ryan Joseph New Issue
2019-02-27 15:36 Ryan Joseph File Added: patch.diff
2019-03-01 14:54 Sven Barth Note Added: 0114538
2019-03-02 16:31 Ryan Joseph Note Added: 0114573
2019-03-16 17:14 Ryan Joseph File Added: multi-helpers.diff
2019-03-16 17:16 Ryan Joseph Note Added: 0114868
2019-03-25 16:20 Ryan Joseph File Added: patch_3_25.diff
2019-03-25 16:21 Ryan Joseph Note Added: 0115043
2019-03-26 07:14 LacaK Summary Path for multi-helpers => Patch for multi-helpers
2019-04-05 17:50 Sven Barth Note Added: 0115247
2019-04-06 16:12 Ryan Joseph Note Added: 0115266
2019-04-06 16:52 Ryan Joseph Note Added: 0115272
2019-04-10 16:08 Ryan Joseph File Added: patch_4_10.diff
2019-04-10 16:20 Ryan Joseph Note Added: 0115392
2019-04-14 21:11 Sven Barth Note Added: 0115505
2019-04-14 21:12 Sven Barth Note Edited: 0115505 View Revisions
2019-04-15 02:44 Ryan Joseph Note Added: 0115512
2019-05-04 23:03 Ryan Joseph Note Added: 0116013
2019-05-10 16:06 Sven Barth Assigned To => Sven Barth
2019-05-10 16:06 Sven Barth Status new => resolved
2019-05-10 16:06 Sven Barth Resolution open => fixed
2019-05-10 16:06 Sven Barth Fixed in Version => 3.3.1
2019-05-10 16:06 Sven Barth Fixed in Revision => 42026
2019-05-10 16:06 Sven Barth FPCTarget => -
2019-05-10 16:06 Sven Barth Note Added: 0116120
2019-05-12 23:47 Ryan Joseph Status resolved => closed
2019-05-12 23:47 Ryan Joseph Note Added: 0116151