[Ada] Type mismatch warning for imported C++ class

2018-07-17  Eric Botcazou  <ebotcazou@adacore.com>

gcc/ada/

	* gcc-interface/ada-tree.h (TYPE_RETURN_BY_DIRECT_REF_P): Define for
	METHOD_TYPE too.
	(TYPE_RETURN_UNCONSTRAINED_P): Likewise.
	(TYPE_CI_CO_LIST): Likewise.
	* gcc-interface/gigi.h (is_cplusplus_method): Delete.
	(fntype_same_flags_p): Adjust comment.
	* gcc-interface/decl.c (Has_Thiscall_Convention): Delete.
	(gnat_to_gnu_entity) <E_Subprogram_Type>: Do not set the "thiscall"
	attribute directly.
	(is_cplusplus_method): Make static and adjust head comment.
	(gnat_to_gnu_param): Return a pointer for the "this" parameter of
	C++ constructors.
	(gnat_to_gnu_subprog_type): Turn imported C++ constructors into their
	callable form.  Generate a METHOD_TYPE node for imported C++ methods.
	Set param_list at the very end of the processing.
	(substitute_in_type) <METHOD_TYPE>: New case.
	* gcc-interface/misc.c (gnat_print_type) <METHOD_TYPE>: Likewise.
	(gnat_type_hash_eq): Accept METHOD_TYPE.
	* gcc-interface/trans.c (Identifier_to_gnu): Deal with METHOD_TYPE.
	(Attribute_to_gnu): Likewise.
	(Call_to_gnu): Likewise.
	(process_freeze_entity): Likewise.
	* gcc-interface/utils.c (create_subprog_decl): Adjust head comment.
	(fntype_same_flags_p): Likewise.

From-SVN: r262792

gcc/ada/ChangeLog

+2018-07-17  Eric Botcazou  <ebotcazou@adacore.com>
+
+	* gcc-interface/ada-tree.h (TYPE_RETURN_BY_DIRECT_REF_P): Define for
+	METHOD_TYPE too.
+	(TYPE_RETURN_UNCONSTRAINED_P): Likewise.
+	(TYPE_CI_CO_LIST): Likewise.
+	* gcc-interface/gigi.h (is_cplusplus_method): Delete.
+	(fntype_same_flags_p): Adjust comment.
+	* gcc-interface/decl.c (Has_Thiscall_Convention): Delete.
+	(gnat_to_gnu_entity) <E_Subprogram_Type>: Do not set the "thiscall"
+	attribute directly.
+	(is_cplusplus_method): Make static and adjust head comment.
+	(gnat_to_gnu_param): Return a pointer for the "this" parameter of
+	C++ constructors.
+	(gnat_to_gnu_subprog_type): Turn imported C++ constructors into their
+	callable form.  Generate a METHOD_TYPE node for imported C++ methods.
+	Set param_list at the very end of the processing.
+	(substitute_in_type) <METHOD_TYPE>: New case.
+	* gcc-interface/misc.c (gnat_print_type) <METHOD_TYPE>: Likewise.
+	(gnat_type_hash_eq): Accept METHOD_TYPE.
+	* gcc-interface/trans.c (Identifier_to_gnu): Deal with METHOD_TYPE.
+	(Attribute_to_gnu): Likewise.
+	(Call_to_gnu): Likewise.
+	(process_freeze_entity): Likewise.
+	* gcc-interface/utils.c (create_subprog_decl): Adjust head comment.
+	(fntype_same_flags_p): Likewise.
+
 2018-07-17  Piotr Trojanek  <trojanek@adacore.com>
 
 	* inline.adb (Expand_Inlined_Call): Remove extra parentheses.

gcc/ada/gcc-interface/ada-tree.h

@@ -83,11 +83,11 @@ do {							 \
   ((TREE_CODE (NODE) == INTEGER_TYPE || TREE_CODE (NODE) == ARRAY_TYPE) \
    && TYPE_PACKED_ARRAY_TYPE_P (NODE))
 
-/* For FUNCTION_TYPEs, nonzero if the function returns by direct reference,
-   i.e. the callee returns a pointer to a memory location it has allocated
-   and the caller only needs to dereference the pointer.  */
+/* For FUNCTION_TYPE and METHOD_TYPE, nonzero if the function returns by
+   direct reference, i.e. the callee returns a pointer to a memory location
+   it has allocated and the caller only needs to dereference the pointer.  */
 #define TYPE_RETURN_BY_DIRECT_REF_P(NODE) \
-  TYPE_LANG_FLAG_0 (FUNCTION_TYPE_CHECK (NODE))
+  TYPE_LANG_FLAG_0 (FUNC_OR_METHOD_CHECK (NODE))
 
 /* For INTEGER_TYPE, nonzero if this is a modular type with a modulus that
    is not equal to two to the power of its mode's size.  */
@@ -97,10 +97,10 @@ do {							 \
    an Ada array other than the first.  */
 #define TYPE_MULTI_ARRAY_P(NODE) TYPE_LANG_FLAG_1 (ARRAY_TYPE_CHECK (NODE))
 
-/* For FUNCTION_TYPE, nonzero if this denotes a function returning an
-   unconstrained array or record.  */
+/* For FUNCTION_TYPE and METHOD_TYPE, nonzero if function returns an
+   unconstrained array or record type.  */
 #define TYPE_RETURN_UNCONSTRAINED_P(NODE) \
-  TYPE_LANG_FLAG_1 (FUNCTION_TYPE_CHECK (NODE))
+  TYPE_LANG_FLAG_1 (FUNC_OR_METHOD_CHECK (NODE))
 
 /* For RECORD_TYPE, UNION_TYPE, and QUAL_UNION_TYPE, nonzero if this denotes
    a justified modular type (will only be true for RECORD_TYPE).  */
@@ -228,12 +228,11 @@ do {							 \
 #define TYPE_GCC_MAX_VALUE(NODE) \
   (TYPE_MAX_VALUE_RAW (NUMERICAL_TYPE_CHECK (NODE)))
 
-/* For a FUNCTION_TYPE, if the subprogram has parameters passed by copy in/
-   copy out, this is the list of nodes used to specify the return values of
-   the out (or in out) parameters that are passed by copy in/copy out.  For
-   a full description of the copy in/copy out parameter passing mechanism
-   refer to the routine gnat_to_gnu_entity.  */
-#define TYPE_CI_CO_LIST(NODE) TYPE_LANG_SLOT_1 (FUNCTION_TYPE_CHECK (NODE))
+/* For a FUNCTION_TYPE and METHOD_TYPE, if the function has parameters passed
+   by copy in/copy out, this is the list of nodes used to specify the return
+   values of these parameters.  For a full description of the copy in/copy out
+   parameter passing mechanism refer to the routine gnat_to_gnu_entity.  */
+#define TYPE_CI_CO_LIST(NODE) TYPE_LANG_SLOT_1 (FUNC_OR_METHOD_CHECK (NODE))
 
 /* For an ARRAY_TYPE with variable size, this is the padding type built for
    the array type when it is itself the component type of another array.  */

gcc/ada/gcc-interface/decl.c

@@ -52,23 +52,19 @@
 #include "ada-tree.h"
 #include "gigi.h"
 
-/* "stdcall" and "thiscall" conventions should be processed in a specific way
-   on 32-bit x86/Windows only.  The macros below are helpers to avoid having
-   to check for a Windows specific attribute throughout this unit.  */
+/* The "stdcall" convention is really supported on 32-bit x86/Windows only.
+   The following macro is a helper to avoid having to check for a Windows
+   specific attribute throughout this unit.  */
 
 #if TARGET_DLLIMPORT_DECL_ATTRIBUTES
 #ifdef TARGET_64BIT
 #define Has_Stdcall_Convention(E) \
   (!TARGET_64BIT && Convention (E) == Convention_Stdcall)
-#define Has_Thiscall_Convention(E) \
-  (!TARGET_64BIT && is_cplusplus_method (E))
 #else
 #define Has_Stdcall_Convention(E) (Convention (E) == Convention_Stdcall)
-#define Has_Thiscall_Convention(E) (is_cplusplus_method (E))
 #endif
 #else
 #define Has_Stdcall_Convention(E) 0
-#define Has_Thiscall_Convention(E) 0
 #endif
 
 #define STDCALL_PREFIX "_imp__"
@@ -3983,11 +3979,6 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, bool definition)
 	    (&attr_list, ATTR_MACHINE_ATTRIBUTE,
 	     get_identifier ("stdcall"), NULL_TREE,
 	     gnat_entity);
-	else if (Has_Thiscall_Convention (gnat_entity))
-	  prepend_one_attribute
-	    (&attr_list, ATTR_MACHINE_ATTRIBUTE,
-	     get_identifier ("thiscall"), NULL_TREE,
-	     gnat_entity);
 
 	/* If we should request stack realignment for a foreign convention
 	   subprogram, do so.  Note that this applies to task entry points
@@ -4841,11 +4832,12 @@ get_unpadded_type (Entity_Id gnat_entity)
 /* Return whether the E_Subprogram_Type/E_Function/E_Procedure GNAT_ENTITY is
    a C++ imported method or equivalent.
 
-   We use the predicate on 32-bit x86/Windows to find out whether we need to
-   use the "thiscall" calling convention for GNAT_ENTITY.  This convention is
-   used for C++ methods (functions with METHOD_TYPE) by the back-end.  */
+   We use the predicate to find out whether we need to use METHOD_TYPE instead
+   of FUNCTION_TYPE for GNAT_ENTITY for the sake compatibility with C++.  This
+   in turn determines whether the "thiscall" calling convention is used by the
+   back-end for GNAT_ENTITY on 32-bit x86/Windows.  */
 
-bool
+static bool
 is_cplusplus_method (Entity_Id gnat_entity)
 {
   /* A constructor is a method on the C++ side.  We deal with it now because
@@ -5258,6 +5250,14 @@ gnat_to_gnu_param (Entity_Id gnat_param, tree gnu_param_type, bool first,
     gnu_param_type
       = make_type_from_size (gnu_param_type, size_int (POINTER_SIZE), 0);
 
+  /* Use a pointer type for the "this" pointer of C++ constructors.  */
+  else if (Chars (gnat_param) == Name_uInit && Is_Constructor (gnat_subprog))
+    {
+      gcc_assert (mech == By_Reference);
+      gnu_param_type = build_pointer_type (gnu_param_type);
+      by_ref = true;
+    }
+
   /* If we were requested or muss pass by reference, do so.
      If we were requested to pass by copy, do so.
      Otherwise, for foreign conventions, pass In Out or Out parameters
@@ -5557,6 +5557,7 @@ gnat_to_gnu_subprog_type (Entity_Id gnat_subprog, bool definition,
 			  bool debug_info_p, tree *param_list)
 {
   const Entity_Kind kind = Ekind (gnat_subprog);
+  const bool method_p = is_cplusplus_method (gnat_subprog);
   Entity_Id gnat_return_type = Etype (gnat_subprog);
   Entity_Id gnat_param;
   tree gnu_type = present_gnu_tree (gnat_subprog)
@@ -5598,7 +5599,7 @@ gnat_to_gnu_subprog_type (Entity_Id gnat_subprog, bool definition,
     gnu_return_type = void_type_node;
 
   else if (gnu_type
-	   && TREE_CODE (gnu_type) == FUNCTION_TYPE
+	   && FUNC_OR_METHOD_TYPE_P (gnu_type)
 	   && !TYPE_IS_DUMMY_P (TREE_TYPE (gnu_type)))
     {
       gnu_return_type = TREE_TYPE (gnu_type);
@@ -5743,7 +5744,7 @@ gnat_to_gnu_subprog_type (Entity_Id gnat_subprog, bool definition,
      Similarly, if the function returns an unconstrained type, then the
      function will allocate the return value on the secondary stack and
      thus calls to it cannot be CSE'ed, lest the stack be reclaimed.  */
-  if (TREE_CODE (gnu_return_type) == VOID_TYPE || return_unconstrained_p)
+  if (VOID_TYPE_P (gnu_return_type) || return_unconstrained_p)
     const_flag = false;
 
   /* Loop over the parameters and get their associated GCC tree.  While doing
@@ -5862,7 +5863,8 @@ gnat_to_gnu_subprog_type (Entity_Id gnat_subprog, bool definition,
 	{
 	  gnu_param_type_list
 	    = tree_cons (NULL_TREE, gnu_param_type, gnu_param_type_list);
-	  gnu_param_list = chainon (gnu_param, gnu_param_list);
+	  DECL_CHAIN (gnu_param) = gnu_param_list;
+	  gnu_param_list = gnu_param;
 	  save_gnu_tree (gnat_param, gnu_param, false);
 
 	  /* A pure function in the Ada sense which takes an access parameter
@@ -5975,18 +5977,37 @@ gnat_to_gnu_subprog_type (Entity_Id gnat_subprog, bool definition,
   /* The lists have been built in reverse.  */
   gnu_param_type_list = nreverse (gnu_param_type_list);
   gnu_param_type_list = chainon (gnu_param_type_list, void_list_node);
-  *param_list = nreverse (gnu_param_list);
+  gnu_param_list = nreverse (gnu_param_list);
   gnu_cico_list = nreverse (gnu_cico_list);
 
+  /* Turn imported C++ constructors into their callable form as done in the
+     front-end, i.e. add the "this" pointer and void the return type.  */
+  if (method_p
+      && Is_Constructor (gnat_subprog)
+      && !VOID_TYPE_P (gnu_return_type))
+    {
+      tree gnu_param_type
+	= build_pointer_type (gnat_to_gnu_profile_type (gnat_return_type));
+      tree gnu_param_name = get_identifier (Get_Name_String (Name_uInit));
+      tree gnu_param
+	= build_decl (input_location, PARM_DECL, gnu_param_name,
+		      gnu_param_type);
+      gnu_param_type_list
+	= tree_cons (NULL_TREE, gnu_param_type, gnu_param_type_list);
+      DECL_CHAIN (gnu_param) = gnu_param_list;
+      gnu_param_list = gnu_param;
+      gnu_return_type = void_type_node;
+    }
+
   /* If the profile is incomplete, we only set the (temporary) return and
      parameter types; otherwise, we build the full type.  In either case,
      we reuse an already existing GCC tree that we built previously here.  */
   if (incomplete_profile_p)
     {
-      if (gnu_type && TREE_CODE (gnu_type) == FUNCTION_TYPE)
+      if (gnu_type && FUNC_OR_METHOD_TYPE_P (gnu_type))
 	;
       else
-	gnu_type = make_node (FUNCTION_TYPE);
+	gnu_type = make_node (method_p ? METHOD_TYPE : FUNCTION_TYPE);
       TREE_TYPE (gnu_type) = gnu_return_type;
       TYPE_ARG_TYPES (gnu_type) = gnu_param_type_list;
       TYPE_RETURN_UNCONSTRAINED_P (gnu_type) = return_unconstrained_p;
@@ -5995,10 +6016,16 @@ gnat_to_gnu_subprog_type (Entity_Id gnat_subprog, bool definition,
     }
   else
     {
-      if (gnu_type && TREE_CODE (gnu_type) == FUNCTION_TYPE)
+      if (gnu_type && FUNC_OR_METHOD_TYPE_P (gnu_type))
 	{
 	  TREE_TYPE (gnu_type) = gnu_return_type;
 	  TYPE_ARG_TYPES (gnu_type) = gnu_param_type_list;
+	  if (method_p)
+	    {
+	      tree gnu_basetype = TREE_TYPE (TREE_VALUE (gnu_param_type_list));
+	      TYPE_METHOD_BASETYPE (gnu_type)
+		= TYPE_MAIN_VARIANT (gnu_basetype);
+	    }
 	  TYPE_CI_CO_LIST (gnu_type) = gnu_cico_list;
 	  TYPE_RETURN_UNCONSTRAINED_P (gnu_type) = return_unconstrained_p;
 	  TYPE_RETURN_BY_DIRECT_REF_P (gnu_type) = return_by_direct_ref_p;
@@ -6008,6 +6035,14 @@ gnat_to_gnu_subprog_type (Entity_Id gnat_subprog, bool definition,
 	}
       else
 	{
+	  if (method_p)
+	    {
+	      tree gnu_basetype = TREE_TYPE (TREE_VALUE (gnu_param_type_list));
+	      gnu_type
+		= build_method_type_directly (gnu_basetype, gnu_return_type,
+					      TREE_CHAIN (gnu_param_type_list));
+	    }
+	  else
 	    gnu_type
 	      = build_function_type (gnu_return_type, gnu_param_type_list);
 
@@ -6070,6 +6105,8 @@ gnat_to_gnu_subprog_type (Entity_Id gnat_subprog, bool definition,
 	}
     }
 
+  *param_list = gnu_param_list;
+
   return gnu_type;
 }
 
@@ -9857,6 +9894,7 @@ substitute_in_type (tree t, tree f, tree r)
       return build_complex_type (nt);
 
     case FUNCTION_TYPE:
+    case METHOD_TYPE:
       /* These should never show up here.  */
       gcc_unreachable ();
 

gcc/ada/gcc-interface/gigi.h

@@ -110,10 +110,6 @@ extern void elaborate_entity (Entity_Id gnat_entity);
 /* Get the unpadded version of a GNAT type.  */
 extern tree get_unpadded_type (Entity_Id gnat_entity);
 
-/* Return whether the E_Subprogram_Type/E_Function/E_Procedure GNAT_ENTITY is
-   a C++ imported method or equivalent.  */
-extern bool is_cplusplus_method (Entity_Id gnat_entity);
-
 /* Create a record type that contains a SIZE bytes long field of TYPE with a
     starting bit position so that it is aligned to ALIGN bits, and leaving at
     least ROOM bytes free before the field.  BASE_ALIGN is the alignment the
@@ -548,7 +544,7 @@ extern int gnat_types_compatible_p (tree t1, tree t2);
 /* Return true if EXPR is a useless type conversion.  */
 extern bool gnat_useless_type_conversion (tree expr);
 
-/* Return true if T, a FUNCTION_TYPE, has the specified list of flags.  */
+/* Return true if T, a {FUNCTION,METHOD}_TYPE, has the specified flags.  */
 extern bool fntype_same_flags_p (const_tree, tree, bool, bool, bool);
 
 /* Create an expression whose value is that of EXPR,

gcc/ada/gcc-interface/misc.c

@@ -473,6 +473,7 @@ gnat_print_type (FILE *file, tree node, int indent)
   switch (TREE_CODE (node))
     {
     case FUNCTION_TYPE:
+    case METHOD_TYPE:
       print_node (file, "ci/co list", TYPE_CI_CO_LIST (node), indent + 4);
       break;
 
@@ -684,12 +685,12 @@ gnat_get_fixed_point_type_info (const_tree type,
 
 /* Return true if types T1 and T2 are identical for type hashing purposes.
    Called only after doing all language independent checks.  At present,
-   this function is only called when both types are FUNCTION_TYPE.  */
+   this is only called when both types are FUNCTION_TYPE or METHOD_TYPE.  */
 
 static bool
 gnat_type_hash_eq (const_tree t1, const_tree t2)
 {
-  gcc_assert (TREE_CODE (t1) == FUNCTION_TYPE);
+  gcc_assert (FUNC_OR_METHOD_TYPE_P (t1) && TREE_CODE (t1) == TREE_CODE (t2));
   return fntype_same_flags_p (t1, TYPE_CI_CO_LIST (t2),
 			      TYPE_RETURN_UNCONSTRAINED_P (t2),
 			      TYPE_RETURN_BY_DIRECT_REF_P (t2),

gcc/ada/gcc-interface/trans.c

@@ -1226,7 +1226,7 @@ Identifier_to_gnu (Node_Id gnat_node, tree *gnu_result_type_p)
      of a discriminated type whose full view can be elaborated statically, to
      avoid problematic conversions to the nominal subtype.  But remove any
      padding from the resulting type.  */
-  if (TREE_CODE (TREE_TYPE (gnu_result)) == FUNCTION_TYPE
+  if (FUNC_OR_METHOD_TYPE_P (TREE_TYPE (gnu_result))
       || Is_Constr_Subt_For_UN_Aliased (gnat_temp_type)
       || (Ekind (gnat_temp) == E_Constant
 	  && Present (Full_View (gnat_temp))
@@ -1730,15 +1730,14 @@ Attribute_to_gnu (Node_Id gnat_node, tree *gnu_result_type_p, int attribute)
 	 since it can use a special calling convention on some platforms,
 	 which cannot be propagated to the access type.  */
       else if (attribute == Attr_Access
-	       && Nkind (gnat_prefix) == N_Identifier
-	       && is_cplusplus_method (Entity (gnat_prefix)))
+	       && TREE_CODE (TREE_TYPE (gnu_prefix)) == METHOD_TYPE)
 	post_error ("access to C++ constructor or member function not allowed",
 		    gnat_node);
 
       /* For other address attributes applied to a nested function,
 	 find an inner ADDR_EXPR and annotate it so that we can issue
 	 a useful warning with -Wtrampolines.  */
-      else if (TREE_CODE (TREE_TYPE (gnu_prefix)) == FUNCTION_TYPE)
+      else if (FUNC_OR_METHOD_TYPE_P (TREE_TYPE (gnu_prefix)))
 	{
 	  gnu_expr = remove_conversions (gnu_result, false);
 
@@ -4283,7 +4282,7 @@ Call_to_gnu (Node_Id gnat_node, tree *gnu_result_type_p, tree gnu_target,
   Node_Id gnat_actual;
   bool sync;
 
-  gcc_assert (TREE_CODE (gnu_subprog_type) == FUNCTION_TYPE);
+  gcc_assert (FUNC_OR_METHOD_TYPE_P (gnu_subprog_type));
 
   /* If we are calling a stubbed function, raise Program_Error, but Elaborate
      all our args first.  */
@@ -8743,7 +8742,7 @@ process_freeze_entity (Node_Id gnat_node)
   if (gnu_old
       && ((TREE_CODE (gnu_old) == FUNCTION_DECL
 	   && (kind == E_Function || kind == E_Procedure))
-	  || (TREE_CODE (TREE_TYPE (gnu_old)) == FUNCTION_TYPE
+	  || (FUNC_OR_METHOD_TYPE_P (TREE_TYPE (gnu_old))
 	      && kind == E_Subprogram_Type)))
     return;
 

gcc/ada/gcc-interface/utils.c

@@ -3191,9 +3191,9 @@ create_label_decl (tree name, Node_Id gnat_node)
 }
 
 /* Return a FUNCTION_DECL node.  NAME is the name of the subprogram, ASM_NAME
-   its assembler name, TYPE its type (a FUNCTION_TYPE node), PARAM_DECL_LIST
-   the list of its parameters (a list of PARM_DECL nodes chained through the
-   DECL_CHAIN field).
+   its assembler name, TYPE its type (a FUNCTION_TYPE or METHOD_TYPE node),
+   PARAM_DECL_LIST the list of its parameters (a list of PARM_DECL nodes
+   chained through the DECL_CHAIN field).
 
    INLINE_STATUS describes the inline flags to be set on the FUNCTION_DECL.
 
@@ -3589,7 +3589,7 @@ gnat_useless_type_conversion (tree expr)
   return false;
 }
 
-/* Return true if T, a FUNCTION_TYPE, has the specified list of flags.  */
+/* Return true if T, a {FUNCTION,METHOD}_TYPE, has the specified flags.  */
 
 bool
 fntype_same_flags_p (const_tree t, tree cico_list, bool return_unconstrained_p,