[Ada] Spurious error on non-default C++ constructor

[Pierre-Marie de Rodat]

The frontend reports spurious errors on C++ non-default constructors
that have formals whose type is an access to subprogram.

Tested on x86_64-pc-linux-gnu, committed on trunk

2019-07-04  Javier Miranda  <mira...@adacore.com>

gcc/ada/

        * exp_tss.adb (Init_Proc): Adding missing support for access to
        subprograms and access to protected subprograms of non-default
        C++ constructors.

gcc/testsuite/

        * gnat.dg/cpp_constructor.adb, gnat.dg/cpp_constructor_fp.ads,
        gnat.dg/cpp_constructor_useit.ads: New testcase.
--- gcc/ada/exp_tss.adb
+++ gcc/ada/exp_tss.adb
@@ -32,6 +32,7 @@ with Lib;      use Lib;
 with Restrict; use Restrict;
 with Rident;   use Rident;
 with Sem_Aux;  use Sem_Aux;
+with Sem_Ch6;  use Sem_Ch6;
 with Sem_Util; use Sem_Util;
 with Sinfo;    use Sinfo;
 
@@ -275,8 +276,8 @@ package body Exp_Tss is
                   then
                      exit;
 
-                  elsif Ekind (Etype (E1)) /= E_Anonymous_Access_Type
-                    and then Ekind (Etype (E2)) /= E_Anonymous_Access_Type
+                  elsif not Is_Anonymous_Access_Type (Etype (E1))
+                    and then not Is_Anonymous_Access_Type (Etype (E2))
                     and then Etype (E1) /= Etype (E2)
                   then
                      exit;
@@ -287,6 +288,17 @@ package body Exp_Tss is
                                /= Directly_Designated_Type (Etype (E2))
                   then
                      exit;
+
+                  elsif Ekind_In (Etype (E1),
+                          E_Anonymous_Access_Subprogram_Type,
+                          E_Anonymous_Access_Protected_Subprogram_Type)
+                    and then Ekind_In (Etype (E2),
+                               E_Anonymous_Access_Subprogram_Type,
+                               E_Anonymous_Access_Protected_Subprogram_Type)
+                    and then not Conforming_Types
+                                   (Etype (E1), Etype (E2), Fully_Conformant)
+                  then
+                     exit;
                   end if;
 
                   E1 := Next_Formal (E1);

--- /dev/null
new file mode 100644
+++ gcc/testsuite/gnat.dg/cpp_constructor.adb
@@ -0,0 +1,12 @@
+--  { dg-do compile }
+
+with Interfaces.C; use Interfaces.C;
+with Cpp_Constructor_FP;
+with Cpp_Constructor_Useit;
+
+procedure Cpp_Constructor is
+   F : Cpp_Constructor_FP.Class :=
+     Cpp_Constructor_FP.Constructor (Cpp_Constructor_Useit.My_Fn'Access);
+begin
+   null;
+end Cpp_Constructor;

--- /dev/null
new file mode 100644
+++ gcc/testsuite/gnat.dg/cpp_constructor_fp.ads
@@ -0,0 +1,10 @@
+with Interfaces.C; use Interfaces.C;
+
+package Cpp_Constructor_FP is
+   type Class is limited record null; end record
+   with Convention => Cpp, Import;
+
+   function Constructor
+     (Fn : access function (Val : int) return int) return Class;
+   pragma Cpp_Constructor (Constructor, External_Name => "foo");
+end Cpp_Constructor_FP;

--- /dev/null
new file mode 100644
+++ gcc/testsuite/gnat.dg/cpp_constructor_useit.ads
@@ -0,0 +1,8 @@
+with Interfaces.C; use Interfaces.C;
+
+package Cpp_Constructor_Useit is
+   function My_Fn (Val : int) return int
+   with Convention => Cpp;
+
+   function My_Fn (Val : int) return int is (Val + 1);
+end Cpp_Constructor_Useit;