* (slightly) modified (formatting, warning) patch by Jan Bruns to speed up overloading search, resolves #36666

git-svn-id: trunk@47111 -

compiler/htypechk.pas

@@ -62,7 +62,10 @@ interface
          cl6_count,
          coper_count : integer; { should be signed }
          ordinal_distance : double;
-         invalid     : boolean;
+         invalid : boolean;
+{$ifndef DISABLE_FAST_OVERLOAD_PATCH}
+         saved_validity : boolean;
+{$endif}
          wrongparanr : byte;
       end;
 
@@ -2585,7 +2588,11 @@ implementation
 
             { only when the # of parameter are supported by the procedure and
               it is visible }
+{$ifdef DISABLE_FAST_OVERLOAD_PATCH}
             if (FParalength>=pd.minparacount) and
+{$else}
+            if (pd.seenmarker<>pointer(self)) and (FParalength>=pd.minparacount) and
+{$endif}
                (
                 (
                  allowdefaultparas and
@@ -2625,6 +2632,7 @@ implementation
                   cpoptions:=cpoptions+[cpo_rtlproc];
                 found:=false;
                 hp:=FCandidateProcs;
+{$ifdef DISABLE_FAST_OVERLOAD_PATCH}
                 while assigned(hp) do
                   begin
                     if (compare_paras(hp^.data.paras,pd.paras,cp_value_equal_const,cpoptions)>=te_equal) and
@@ -2636,10 +2644,14 @@ implementation
                       end;
                     hp:=hp^.next;
                   end;
+{$endif}
                 if not found then
                   begin
                     proc_add(st,pd,objcidcall);
                     added:=true;
+{$ifndef DISABLE_FAST_OVERLOAD_PATCH}
+                    pd.seenmarker:=self;
+{$endif}
                   end;
               end;
 
@@ -2653,6 +2665,14 @@ implementation
                 pd.free;
               end;
           end;
+{$ifndef DISABLE_FAST_OVERLOAD_PATCH}
+        {cleanup modified duplicate pd markers}
+        hp := FCandidateProcs;
+        while assigned(hp) do begin
+          hp^.data.seenmarker := nil;
+          hp := hp^.next;
+        end;
+{$endif}
 
         calc_distance(st,objcidcall);
 
@@ -3239,6 +3259,8 @@ implementation
       end;
 
 
+
+
     function is_better_candidate(currpd,bestpd:pcandidate):integer;
       var
         res : integer;
@@ -3489,6 +3511,9 @@ implementation
       end;
 
 
+
+{$ifdef DISABLE_FAST_OVERLOAD_PATCH}
+
     function tcallcandidates.choose_best(var bestpd:tabstractprocdef; singlevariant: boolean):integer;
       var
         pd: tprocdef;
@@ -3576,6 +3601,227 @@ implementation
       end;
 
 
+{$else}
+
+    function compare_by_old_sortout_check(pd,bestpd:pcandidate):integer;
+      var cpoptions : tcompare_paras_options;
+      begin
+        { don't add duplicates, only compare visible parameters for the user }
+        cpoptions:=[cpo_ignorehidden];
+        if (po_compilerproc in bestpd^.data.procoptions) then
+          cpoptions:=cpoptions+[cpo_compilerproc];
+        if (po_rtlproc in bestpd^.data.procoptions) then
+          cpoptions:=cpoptions+[cpo_rtlproc];
+
+        compare_by_old_sortout_check := 0; // can't decide, bestpd probably wasn't sorted out in unpatched
+        if (compare_paras(pd^.data.paras,bestpd^.data.paras,cp_value_equal_const,cpoptions)>=te_equal) and
+          (not(po_objc in bestpd^.data.procoptions) or (bestpd^.data.messageinf.str^=pd^.data.messageinf.str^)) then
+          compare_by_old_sortout_check := 1; // bestpd was sorted out before patch
+     end;
+
+    function decide_restart(pd,bestpd:pcandidate) : boolean;
+      begin
+        decide_restart := false;
+        if assigned(bestpd) then
+          begin
+            { don't restart if bestpd is marked invalid already }
+            if not bestpd^.invalid then
+              decide_restart := compare_by_old_sortout_check(pd,bestpd)<>0;
+        end;
+      end;
+
+
+    procedure save_validity(c : pcandidate);
+      begin
+        while assigned(c) do
+          begin
+            c^.saved_validity := c^.invalid;
+            c := c^.next;
+          end;
+      end;
+
+
+    procedure restore_validity(c : pcandidate);
+      begin
+        while assigned(c) do begin
+          c^.invalid := c^.saved_validity;
+          c := c^.next;
+        end;
+      end;
+
+
+    function tcallcandidates.choose_best(var bestpd:tabstractprocdef; singlevariant: boolean):integer;
+      var
+        pd: tprocdef;
+        besthpstart,
+        hp,hp2        : pcandidate;
+        cntpd,
+        res           : integer;
+        restart : boolean;
+      begin
+        res:=0;
+        {
+          Returns the number of candidates left and the
+          first candidate is returned in pdbest
+        }
+       if not(assigned(FCandidateProcs)) then
+         begin
+           choose_best := 0;
+           exit;
+         end;
+
+        bestpd:=FCandidateProcs^.data;
+        if FCandidateProcs^.invalid then
+          cntpd:=0
+        else
+          cntpd:=1;
+
+        if assigned(FCandidateProcs^.next) then
+         begin
+           save_validity(FCandidateProcs);
+           restart := false;
+           { keep restarting, until there wasn't a sorted-out besthpstart }
+           repeat
+             besthpstart:=FCandidateProcs;
+             bestpd:=FCandidateProcs^.data;
+             if restart then
+               begin
+                 restore_validity(FCandidateProcs);
+                 restart := false;
+               end;
+             { Setup the first procdef as best, only count it as a result
+               when it is valid }
+             if FCandidateProcs^.invalid then
+               cntpd:=0
+             else
+               cntpd:=1;
+             hp:=FCandidateProcs^.next;
+             while assigned(hp) and not(restart) do
+               begin
+                 restart := decide_restart(hp,besthpstart);
+                 if not restart then
+                   begin
+                   if not singlevariant then
+                     res:=is_better_candidate(hp,besthpstart)
+                   else
+                     res:=is_better_candidate_single_variant(hp,besthpstart);
+                 end;
+                 if restart then
+                   begin
+                     { mark the sorted out invalid globally }
+                     besthpstart^.saved_validity := true;
+                   end
+                 else if (res>0) then
+                   begin
+                     { hp is better, flag all procs to be incompatible }
+                     while (besthpstart<>hp) do
+                       begin
+                         besthpstart^.invalid:=true;
+                         besthpstart:=besthpstart^.next;
+                       end;
+                     { besthpstart is already set to hp }
+                     bestpd:=besthpstart^.data;
+                     cntpd:=1;
+                   end
+                 else if (res<0) then
+                   begin
+                    { besthpstart is better, flag current hp to be incompatible }
+                    hp^.invalid:=true;
+                   end
+                 else
+                   begin
+                     { res=0, both are valid }
+                     if not hp^.invalid then
+                       inc(cntpd);
+                   end;
+                 hp:=hp^.next;
+               end;
+           until not(restart);
+         end;
+
+        { check the alternate choices if they would have been sorted out before patch... }
+
+        { note we have procadded the candidates, so order is reversed procadd order here.
+          this was also used above: each sorted-out always has an "outsorter" counterpart
+          deeper down the next chain
+        }
+
+        { for the intial implementation, let's first do some more consistency checking}
+        res := 0;
+        hp := FCandidateProcs;
+        while assigned(hp) do
+          begin
+            if not(hp^.invalid) then
+              inc(res);
+            hp := hp^.next;
+          end;
+        if (res<>cntpd) then
+          internalerror(202002161);
+
+        { check all valid choices for sortout }
+        cntpd := 0;
+        hp := FCandidateProcs;
+        while assigned(hp) do
+          begin
+            if not(hp^.invalid) then
+              begin
+                hp2 := hp^.next;
+                while assigned(hp2) do begin
+                  if compare_by_old_sortout_check(hp2,hp)<>0 then
+                    begin
+                      hp^.invalid := true;
+                      hp2 := nil;
+                    end
+                  else
+                    hp2:=hp2^.next;
+                end;
+                if not(hp^.invalid) then
+                  begin
+                    inc(cntpd);
+                    { check for the impossible event bestpd had become invalid}
+                    if (cntpd=1) and (hp^.data<>bestpd) then
+                      internalerror(202002162);
+                  end;
+              end;
+            hp := hp^.next;
+          end;
+
+
+        { if we've found one, check the procdefs ignored for overload choosing
+          to see whether they contain one from a child class with the same
+          parameters (so the overload choosing was not influenced by their
+          presence, but now that we've decided which overloaded version to call,
+          make sure we call the version closest in terms of visibility }
+        if cntpd=1 then
+          begin
+            for res:=0 to FIgnoredCandidateProcs.count-1 do
+              begin
+                pd:=tprocdef(FIgnoredCandidateProcs[res]);
+                { stop searching when we start comparing methods of parent of
+                  the struct in which the current best method was found }
+                if assigned(pd.struct) and
+                   (pd.struct<>tprocdef(bestpd).struct) and
+                   def_is_related(tprocdef(bestpd).struct,pd.struct) then
+                  break;
+                if (pd.proctypeoption=bestpd.proctypeoption) and
+                   ((pd.procoptions*[po_classmethod,po_methodpointer])=(bestpd.procoptions*[po_classmethod,po_methodpointer])) and
+                   (compare_paras(pd.paras,bestpd.paras,cp_all,[cpo_ignorehidden,cpo_ignoreuniv,cpo_openequalisexact])=te_exact) then
+                  begin
+                    { first one encountered is closest in terms of visibility }
+                    bestpd:=pd;
+                    break;
+                  end;
+              end;
+          end;
+        result:=cntpd;
+      end;
+
+{$endif}
+
+
+
+
+
     procedure tcallcandidates.find_wrong_para;
       var
         currparanr : smallint;

compiler/symdef.pas

@@ -865,6 +865,9 @@ interface
             a routine that has to be internally generated by the compiler }
           synthetickind: tsynthetickind;
           visibility   : tvisibility;
+{$ifndef DISABLE_FAST_OVERLOAD_PATCH}
+          seenmarker : pointer; // used for filtering in tcandidate
+{$endif}
           constructor create(level:byte;doregister:boolean);virtual;
           constructor ppuload(ppufile:tcompilerppufile);
           destructor  destroy;override;
@@ -6103,6 +6106,9 @@ implementation
 {$else symansistr}
          _mangledname:=nil;
 {$endif symansistr}
+{$ifndef DISABLE_FAST_OVERLOAD_PATCH}
+         seenmarker := nil;
+{$endif}
          fileinfo:=current_filepos;
          extnumber:=$ffff;
          aliasnames:=TCmdStrList.create;