+ previous commit also fixes #40143, #40144, #40145, #40308 and #40315, so add the tests for them

tests/webtbs/tw40143.pp

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

tests/webtbs/tw40144.pp

@@ -0,0 +1,36 @@
+{ %NORUN }
+
+program tw40144;
+
+{$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
+    cool_bingo := default(TVoidFunc);
+    coolifier := default(TFuncMaker);
+    coolifier := function (const thing: string): TVoidFunc
+    var
+      func: TVoidFunc;
+    begin
+      result := default(TVoidFunc); // <-- This is line 23
+      func := procedure begin writeln('cool ', thing) end;
+      result := func;
+    end;
+    cool_bingo := coolifier('bingo');
+    cool_bingo();
+  end;
+
+begin
+  main;
+end.
+

tests/webtbs/tw40145.pp

@@ -0,0 +1,35 @@
+{ %NORUN }
+
+program tw40145;
+
+{$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
+    cool_bingo := default(TVoidFunc);
+    coolifier := default(TFuncMaker);
+    coolifier := function (const thing: string): TVoidFunc
+    var
+      func: TVoidFunc;
+    begin
+      func := procedure begin writeln('cool ', thing) end;
+      result := func; // <-- This is line 24
+    end;
+    cool_bingo := coolifier('bingo');
+    cool_bingo();
+  end;
+
+begin
+  main;
+end.
+

tests/webtbs/tw40308.pp

@@ -0,0 +1,25 @@
+program tw40308;
+
+{$mode delphi}
+{$modeswitch anonymousfunctions}
+{$modeswitch functionreferences}
+
+//uses
+//  SysUtils;
+
+type
+  TFunc1 = reference to function (P1: Integer): String;
+
+function GetTestFunc1(P2: Integer): TFunc1;
+begin
+  Result := function (P1: Integer): String begin
+      Result := '3'; // <-- Error: Internal error 2011010304
+      //Result := IntToStr(P1 + P2);
+    end;
+end;
+
+begin
+  if GetTestFunc1(1)(2) <> '3' then
+    Halt(1);
+end.
+

tests/webtbs/tw40315.pp

@@ -0,0 +1,65 @@
+program tw40315;
+//This program compiles and runs in Delphi and in FPC. (at least should run in FPC)
+//It is intentionally designed this way.
+//It compiles without errors or warnings in Delphi and delivers the expected result.
+
+{$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  TfuncS = reference to function:String;
+      TfuncF = reference to function(s:String):TfuncS;
+var   f_inner: TfuncS;
+      f_outer: TfuncF;
+
+procedure caller;
+begin
+  f_inner();
+end;
+
+procedure main;
+
+var str: String;
+   // f_outer: TfuncF;  // <---- doesnt compile in FPC when this is uncommented, but compiles and runs ok in Delphi
+
+begin
+
+    str := 'Hello World!';
+
+    f_outer := function(s:String):TfuncS //This captures local and persistent copy of "str"
+    begin
+      Result := function:String // <---- Access violation here, when Line "Result:=s" is commented out and when it is compiled.
+      begin
+        Result := s;  // <---- project1.lpr(37,9) Error: Internal error 2011010304
+                      // if the line is commented out it compiles, but gives access violation at runtime
+
+        Writeln(s);
+      end;
+      Writeln('Outer function was called');
+    end;
+    f_inner := f_outer(str);   //This instantiates the outer function and f_inner and captures their local context.
+
+    SetLength(str,0); //Erase the string content
+
+    Writeln('now calling f_inner');
+    caller();  //This line prints the string s="Hello World!", 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 string "str"?');
+  //if f_inner()='Hello World!' then writeln('Yes! :-)') else writeln ('No! :-(');
+  if f_inner()<>'Hello World!' then
+    Halt(1);
+
+  //readln;
+end.