Selaa lähdekoodia

* fix #39740: consider a conversion of a procedure or procedure variable to a function reference as a bit more expensive than otherwise
+ added test

Sven/Sarah Barth 3 vuotta sitten
vanhempi
commit
2372a06926
3 muutettua tiedostoa jossa 43 lisäystä ja 1 poistoa
  1. 8 0
      compiler/defcmp.pas
  2. 1 1
      compiler/htypechk.pas
  3. 34 0
      tests/webtbs/tw39740.pp

+ 8 - 0
compiler/defcmp.pas

@@ -2683,6 +2683,14 @@ implementation
                         else
                           eq:=te_incompatible;
                       end;
+                  end
+                else if assigned(def2.owner) and
+                    assigned(def2.owner.defowner) and
+                    is_funcref(tdef(def2.owner.defowner)) then
+                  begin
+                    { consider assignment to a funcref a bit more expensive
+                      then assigning it to a normal proc or method variable }
+                    eq:=te_convert_l2;
                   end;
               end;
             proc_to_procvar_equal_internal:=eq;

+ 1 - 1
compiler/htypechk.pas

@@ -2142,7 +2142,7 @@ implementation
                   (m_mac_procvar in current_settings.modeswitches)) and
                  (p.left.nodetype=calln) and
                  is_invokable(def_to) then
-                tmpeq:=proc_to_funcref_equal(tprocdef(tcallnode(p.left).procdefinition),tobjectdef(def_to));
+                tmpeq:=proc_to_funcref_conv(tprocdef(tcallnode(p.left).procdefinition),tobjectdef(def_to));
               if tmpeq<>te_incompatible then
                 eq:=tmpeq;
             end;

+ 34 - 0
tests/webtbs/tw39740.pp

@@ -0,0 +1,34 @@
+{ %NORUN }
+
+program tw39740;
+
+{$mode delphi} 
+{$modeswitch FUNCTIONREFERENCES}
+uses classes;
+
+
+{$if not declared(TThreadProcedure)}
+type 
+   TThreadProcedure = reference to procedure;
+{$endif}
+
+procedure bla(t : tthreadmethod); overload;
+begin
+end;
+
+procedure bla(t : tthreadprocedure); overload;
+begin
+end; 
+
+type ta = class
+            procedure bla;
+            end;
+ 
+procedure ta.bla;
+begin
+end;
+var a : Ta;
+begin
+  bla(a.bla);
+  // bla(tthreadmethod(a.bla)); // works
+end.