From f721210638e919e910d340b4187b2154df8e835c Mon Sep 17 00:00:00 2001
From: Sven/Sarah Barth <pascaldragon@gmail.com>
Date: Fri, 23 Jun 2023 17:05:57 +0200
Subject: [PATCH] * 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   |  9 ++++--
 tests/webtbs/tw40142.pp | 30 ++++++++++++++++++
 tests/webtbs/tw40324.pp | 69 +++++++++++++++++++++++++++++++++++++++++
 3 files changed, 106 insertions(+), 2 deletions(-)
 create mode 100644 tests/webtbs/tw40142.pp
 create mode 100644 tests/webtbs/tw40324.pp

diff --git a/compiler/pparautl.pas b/compiler/pparautl.pas
index d10f69b584..809bddc090 100644
--- a/compiler/pparautl.pas
+++ b/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^
diff --git a/tests/webtbs/tw40142.pp b/tests/webtbs/tw40142.pp
new file mode 100644
index 0000000000..0e9ec55c58
--- /dev/null
+++ b/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.
+
diff --git a/tests/webtbs/tw40324.pp b/tests/webtbs/tw40324.pp
new file mode 100644
index 0000000000..a758fd7ece
--- /dev/null
+++ b/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.