* fix #40142 and #40324: don't alias the function name to the $result variable for anonymous functions unless an explicit result name is provided

+ added tests

compiler/pparautl.pas

@@ -357,8 +357,13 @@ implementation
 
            { insert the name of the procedure as alias for the function result,
              we can't use realname because that will not work for compilerprocs
-             as the name is lowercase and unreachable from the code }
-           if (pd.proctypeoption<>potype_operator) or assigned(pd.resultname) then
+             as the name is lowercase and unreachable from the code;
+             don't insert this alias for an anonymous function unless an
+             explicit name is provided }
+           if (
+                 (pd.proctypeoption<>potype_operator) and
+                 not (po_anonymous in pd.procoptions)
+               ) or assigned(pd.resultname) then
              begin
                if assigned(pd.resultname) then
                  hs:=pd.resultname^

tests/webtbs/tw40142.pp

@@ -0,0 +1,30 @@
+{ %NORUN }
+
+program tw40142;
+
+{$Mode objfpc}{$H+}
+{$ModeSwitch anonymousfunctions}
+{$ModeSwitch functionreferences}
+{$ModeSwitch nestedprocvars}
+
+type
+  TVoidFunc = reference to procedure;
+  TFuncMaker = reference to function(const thing: string): TVoidFunc;
+
+procedure main;
+  var
+    cool_bingo: TVoidFunc;
+    coolifier: TFuncMaker;
+  begin
+    coolifier := function (const thing: string) : TVoidFunc
+    begin
+      result := procedure begin writeln('cool ', thing) end;
+    end;
+    cool_bingo := coolifier('bingo');
+    cool_bingo();
+  end;
+
+begin
+  main;
+end.
+

tests/webtbs/tw40324.pp

@@ -0,0 +1,69 @@
+program tw40324;
+// This program compiles and runs in Delphi and in FPC. (at least should run in FPC)
+// It is intentionally designed this way.
+{$ifdef FPC}
+{$mode objfpc}{$H+}
+{$modeswitch functionreferences}
+{$modeswitch anonymousfunctions}
+  // {$warn 5036 off}// "Warning: (5036) Local variable "$Capturer" does not seem to be initialized"
+{$endif}
+// uses
+{$IFDEF UNIX}
+cthreads,
+{$ENDIF}
+  // Classes, Sysutils { you can add units after this };
+
+type
+  T_X = String; // Type of Test-variable X
+  TfuncS = reference to function: T_X;
+  TfuncF = reference to function(s: T_X): TfuncS;
+
+var f_inner: TfuncS;
+  f_outer: TfuncF;
+//------------------------------------------------------------------------------
+procedure caller;
+begin
+  f_inner();
+end;
+//------------------------------------------------------------------------------
+procedure main;
+
+var X: T_X;
+   // str:String;
+    f_outer: TfuncF;
+
+begin
+
+  X := '1234';
+
+  f_outer := function(s: T_X): TfuncS // This captures local and persistent copy of "X"
+  begin
+      Result := function: T_X
+      begin
+          Writeln(s);
+          Result := s;
+      end;
+      Writeln('Outer function was called');
+  end;
+  f_inner := f_outer(X); // This instantiates the outer function and f_inner and captures their local context.
+
+  X := '0'; // Erase the T_X content
+
+  Writeln('now calling f_inner');
+  caller(); // This line prints the T_X s=1234, which was captured by the outer function.
+               // f_inner will be called from an external context, this is just for test and demonstration
+end;
+//------------------------------------------------------------------------------
+begin
+  main;
+  Writeln('Now the context of "main()" is lost. Can we still print the variable "X"?');
+  if f_inner() = '1234' then
+    Writeln('Yes! :-)')
+  else begin
+    Writeln('No! :-(');
+    Halt(1);
+  end;
+
+  //readln;
+
+end.