Browse Source

* fix #39745: the conversion from ordinals to pointer types in mode Delphi is not allowed for a void type (happens when using a typecast to convert a method without parameters to a function reference)
+ added test

Sven/Sarah Barth 3 years ago
parent
commit
5a680f0148
2 changed files with 43 additions and 1 deletions
  1. 4 1
      compiler/defcmp.pas
  2. 39 0
      tests/webtbs/tw39745.pp

+ 4 - 1
compiler/defcmp.pas

@@ -1988,7 +1988,10 @@ implementation
                    }
                    }
                    else if (not(target_info.system in systems_jvm) and
                    else if (not(target_info.system in systems_jvm) and
                        ((def_from.typ=enumdef) or
                        ((def_from.typ=enumdef) or
-                        (def_from.typ=orddef))) and
+                        (
+                          (def_from.typ=orddef) and
+                          not is_void(def_from)
+                        ))) and
                       (m_delphi in current_settings.modeswitches) and
                       (m_delphi in current_settings.modeswitches) and
                       (cdo_explicit in cdoptions) then
                       (cdo_explicit in cdoptions) then
                      begin
                      begin

+ 39 - 0
tests/webtbs/tw39745.pp

@@ -0,0 +1,39 @@
+{ %NORUN }
+
+program tw39745;
+
+{$mode delphi} // objfpc is ok
+{$modeswitch functionreferences}
+//uses classes;
+type
+    TThreadMethod = procedure of object;
+    TThreadProcedure = reference to procedure;
+
+    TThread = class
+      procedure Queue(aMethod: TThreadMethod);overload;
+      procedure Queue(aFuncRef: TThreadProcedure);overload;
+    end;
+
+    TTestThread = class(tthread)
+
+                  procedure something; // matches tthreadmethod
+                  procedure xx;
+               end;
+
+procedure tthread.Queue(aMethod: TThreadMethod);
+begin
+end;
+procedure tthread.Queue(aFuncRef: TThreadProcedure);
+begin
+end;
+procedure ttestthread.something;
+begin
+end;
+procedure ttestthread.xx;
+begin
+      Queue(tthreadprocedure(Something)); // add @ for mode objfpc
+end;
+
+begin
+end.
+