* fix #39742: when assigning a function to a function reference it's not the function itself that needs to be checked to be captureable, but instead what it captures (this applies for both the non-generic and the generic case)

+ added tests

compiler/procdefutil.pas

@@ -860,14 +860,6 @@ implementation
 
       result:=funcref_intf_for_proc(tabstractprocdef(n.resultdef),fileinfo_to_suffix(sym.fileinfo));
 
-      if df_generic in owner.procdef.defoptions then
-        begin
-          { only check whether we can capture the symbol }
-          if not can_be_captured(sym) then
-            MessagePos1(n.fileinfo,sym_e_symbol_no_capture,sym.realname);
-          exit;
-        end;
-
       if (sym.typ=procsym) and (sym.owner.symtabletype=localsymtable) then
         begin
           { this is assigning a nested function, so retrieve the correct procdef
@@ -882,17 +874,29 @@ implementation
               if not assigned(pd) then
                 internalerror(2022041802);
             end;
-          pinested:=find_nested_procinfo(pd);
+          { check whether all captured symbols can indeed be captured }
-          if not assigned(pinested) then
+          capturesyms:=pd.capturedsyms;
-            internalerror(2022041803);
+          if assigned(capturesyms) then
-          if pinested.parent<>owner then
+            for i:=0 to capturesyms.count-1 do
+              begin
+                captured:=pcapturedsyminfo(capturesyms[i]);
+                if not can_be_captured(captured^.sym) then
+                  MessagePos1(captured^.fileinfo,sym_e_symbol_no_capture,captured^.sym.realname);
+              end;
+          if not (df_generic in owner.procdef.defoptions) then
             begin
-              { we need to capture this into the owner of the nested function
+              pinested:=find_nested_procinfo(pd);
-                instead }
+              if not assigned(pinested) then
-              owner:=pinested;
+                internalerror(2022041803);
-              capturer:=get_or_create_capturer(pinested.procdef);
+              if pinested.parent<>owner then
-              if not assigned(capturer) then
+                begin
-                internalerror(2022041804);
+                  { we need to capture this into the owner of the nested function
+                    instead }
+                  owner:=pinested;
+                  capturer:=get_or_create_capturer(pinested.procdef);
+                  if not assigned(capturer) then
+                    internalerror(2022041804);
+                end;
             end;
         end
       else if (n.resultdef.typ=procvardef) and
@@ -904,6 +908,9 @@ implementation
       else
         pinested:=nil;
 
+      if df_generic in owner.procdef.defoptions then
+        exit;
+
       if not assigned(capturer) then
         capturer:=get_or_create_capturer(owner.procdef);
 

tests/test/tfuncref37.pp

@@ -0,0 +1,24 @@
+{ %FAIL }
+
+program tfuncref37;
+
+{$mode objfpc}
+{$ModeSwitch functionreferences}
+
+type
+  TFuncRef = reference to function: LongInt;
+
+function Test(var aArg: LongInt): TFuncRef;
+
+  function TestSub: LongInt;
+  begin
+    Result := aArg;
+  end;
+
+begin
+  Result := @TestSub;
+end;
+
+begin
+end.
+

tests/test/tfuncref38.pp

@@ -0,0 +1,24 @@
+{ %FAIL }
+
+program tfuncref38;
+
+{$mode objfpc}
+{$ModeSwitch functionreferences}
+
+type
+  TFuncRef = reference to function: LongInt;
+
+function Test(aArg: array of LongInt): TFuncRef;
+
+  function TestSub: LongInt;
+  begin
+    Result := aArg[2];
+  end;
+
+begin
+  Result := @TestSub;
+end;
+
+begin
+end.
+

tests/test/tfuncref39.pp

@@ -0,0 +1,26 @@
+{ %FAIL }
+
+program tfuncref39;
+
+{$mode objfpc}
+{$ModeSwitch functionreferences}
+
+type
+  TProcRef = reference to procedure;
+
+function Test: LongInt;
+
+  procedure TestSub;
+  begin
+    Writeln(Result);
+  end;
+
+var
+  tmp: TProcRef;
+begin
+  tmp := @TestSub;
+end;
+
+begin
+end.
+

tests/test/tfuncref40.pp

@@ -0,0 +1,24 @@
+{ %FAIL }
+
+program tfuncref40;
+
+{$mode objfpc}
+{$ModeSwitch functionreferences}
+
+type
+  TFuncRef = reference to function: LongInt;
+
+generic function Test<T>(var aArg: LongInt): TFuncRef;
+
+  function TestSub: LongInt;
+  begin
+    Result := aArg;
+  end;
+
+begin
+  Result := @TestSub;
+end;
+
+begin
+end.
+

tests/test/tfuncref41.pp

@@ -0,0 +1,24 @@
+{ %FAIL }
+
+program tfuncref41;
+
+{$mode objfpc}
+{$ModeSwitch functionreferences}
+
+type
+  TFuncRef = reference to function: LongInt;
+
+generic function Test<T>(aArg: array of LongInt): TFuncRef;
+
+  function TestSub: LongInt;
+  begin
+    Result := aArg[2];
+  end;
+
+begin
+  Result := @TestSub;
+end;
+
+begin
+end.
+

tests/test/tfuncref42.pp

@@ -0,0 +1,26 @@
+{ %FAIL }
+
+program tfuncref39;
+
+{$mode objfpc}
+{$ModeSwitch functionreferences}
+
+type
+  TProcRef = reference to procedure;
+
+generic function Test<T>: LongInt;
+
+  procedure TestSub;
+  begin
+    Writeln(Result);
+  end;
+
+var
+  tmp: TProcRef;
+begin
+  tmp := @TestSub;
+end;
+
+begin
+end.
+

tests/webtbs/tw39742.pp

@@ -0,0 +1,34 @@
+{ %NORUN }
+
+program tw39742;
+
+{$mode objfpc}{$H+}
+{$ModeSwitch nestedprocvars}
+{$ModeSwitch functionreferences}
+
+type
+  TIntFunction = reference to function: Integer;
+
+// Works
+function FourtyTwo(const AParam: Integer): TIntFunction;
+function Helper: Integer;
+begin
+  Result := 42;
+end;
+begin
+  Result := @Helper
+end;
+
+// Error
+generic function GenericFourtyTwo<T>: TIntFunction;
+function Helper: Integer;
+begin
+  Result := 42;
+end;
+begin
+  Result := @Helper
+end;
+
+begin
+end.
+