From 0b7a771ca945dc531060e0597c8f1e69774a6451 Mon Sep 17 00:00:00 2001
From: Sven/Sarah Barth <pascaldragon@gmail.com>
Date: Fri, 16 Jun 2023 17:28:50 +0200
Subject: [PATCH] * fix #40221: don't allow a conversion from an anonymous
 function to a procvar type if compare_defs_ext already rejected them + added
 tests

---
 compiler/ncnv.pas        | 18 ++++++++++++++++--
 tests/webtbf/tw40221a.pp | 15 +++++++++++++++
 tests/webtbf/tw40221b.pp | 17 +++++++++++++++++
 3 files changed, 48 insertions(+), 2 deletions(-)
 create mode 100644 tests/webtbf/tw40221a.pp
 create mode 100644 tests/webtbf/tw40221b.pp

diff --git a/compiler/ncnv.pas b/compiler/ncnv.pas
index 4d435ad2b3..33add69987 100644
--- a/compiler/ncnv.pas
+++ b/compiler/ncnv.pas
@@ -2508,7 +2508,10 @@ implementation
                             not is_self_sym(tsym(pcapturedsyminfo(tprocdef(pd).capturedsyms[0])^.sym))
                           )
                         ) then
-                      internalerror(2021060801);
+                      begin
+                        result:=cerrornode.create;
+                        exit;
+                      end;
 
                     { so that insert_self_and_vmt_para correctly inserts the
                       Self, cause it otherwise skips that for anonymous functions }
@@ -2619,7 +2622,10 @@ implementation
                 else if tprocvardef(totypedef).is_addressonly then
                   begin
                     if assigned(tprocdef(pd).capturedsyms) and (tprocdef(pd).capturedsyms.count>0) then
-                      internalerror(2021060802);
+                      begin
+                        result:=cerrornode.create;
+                        exit;
+                      end;
 
                     { remove framepointer and Self parameters }
                     for i:=tprocdef(pd).parast.symlist.count-1 downto 0 do
@@ -3172,6 +3178,14 @@ implementation
                                  not(is_open_array(left.resultdef)) and
                                  not(is_array_constructor(left.resultdef)) and
                                  not(is_array_of_const(left.resultdef)) and
+                                 { if the from type is an anonymous function then
+                                   don't blindly convert it if the size is the same
+                                   as compare_defs_ext already determined that the
+                                   anonymous function is not compatible }
+                                 not(
+                                   (left.resultdef.typ=procdef) and
+                                   (po_anonymous in tprocdef(left.resultdef).procoptions)
+                                 ) and
                                  (left.resultdef.size=resultdef.size) and
                                  { disallow casts of const nodes }
                                  (not is_constnode(left) or
diff --git a/tests/webtbf/tw40221a.pp b/tests/webtbf/tw40221a.pp
new file mode 100644
index 0000000000..fa5c1f0853
--- /dev/null
+++ b/tests/webtbf/tw40221a.pp
@@ -0,0 +1,15 @@
+{ %FAIL }
+
+{$mode objfpc} {$modeswitch anonymousfunctions}
+procedure Main;
+var
+	c: int32;
+begin
+	c := 12;
+	TProcedure(procedure begin writeln(c); end);
+end;
+
+begin
+	Main;
+end.
+
diff --git a/tests/webtbf/tw40221b.pp b/tests/webtbf/tw40221b.pp
new file mode 100644
index 0000000000..980206318e
--- /dev/null
+++ b/tests/webtbf/tw40221b.pp
@@ -0,0 +1,17 @@
+{ %FAIL }
+
+{$mode objfpc} {$modeswitch anonymousfunctions}
+procedure Main;
+type
+  TProcMethod = procedure of object;
+var
+	c: int32;
+begin
+	c := 12;
+	TProcMethod(procedure begin writeln(c); end);
+end;
+
+begin
+	Main;
+end.
+