[Ada] Fix bogus error on call to subprogram with incomplete profile
authorEric Botcazou <ebotcazou@adacore.com>
Thu, 23 Dec 2021 15:48:11 +0000 (16:48 +0100)
committerPierre-Marie de Rodat <derodat@adacore.com>
Mon, 10 Jan 2022 09:38:47 +0000 (09:38 +0000)
gcc/ada/

* gcc-interface/trans.c (Identifier_to_gnu): Use correct subtype.
(elaborate_profile): New function.
(Call_to_gnu): Call it on the formals and the result type before
retrieving the translated result type from the subprogram type.

gcc/ada/gcc-interface/trans.c

index 47fbbc9..39059cb 100644 (file)
@@ -1171,7 +1171,7 @@ Identifier_to_gnu (Node_Id gnat_node, tree *gnu_result_type_p)
      specific circumstances only, so evaluated lazily.  < 0 means
      unknown, > 0 means known true, 0 means known false.  */
   int require_lvalue = -1;
-  Node_Id gnat_result_type;
+  Entity_Id gnat_result_type;
   tree gnu_result, gnu_result_type;
 
   /* If the Etype of this node is not the same as that of the Entity, then
@@ -4457,6 +4457,22 @@ return_slot_opt_for_pure_call_p (tree target, tree call)
   return !bitmap_bit_p (decls, DECL_UID (target));
 }
 
+/* Elaborate types referenced in the profile (FIRST_FORMAL, RESULT_TYPE).  */
+
+static void
+elaborate_profile (Entity_Id first_formal, Entity_Id result_type)
+{
+  Entity_Id formal;
+
+  for (formal = first_formal;
+       Present (formal);
+       formal = Next_Formal_With_Extras (formal))
+    (void) gnat_to_gnu_type (Etype (formal));
+
+  if (Present (result_type) && Ekind (result_type) != E_Void)
+    (void) gnat_to_gnu_type (result_type);
+}
+
 /* Subroutine of gnat_to_gnu to translate gnat_node, either an N_Function_Call
    or an N_Procedure_Call_Statement, to a GCC tree, which is returned.
    GNU_RESULT_TYPE_P is a pointer to where we should place the result type.
@@ -4481,7 +4497,7 @@ Call_to_gnu (Node_Id gnat_node, tree *gnu_result_type_p, tree gnu_target,
   /* The FUNCTION_TYPE node giving the GCC type of the subprogram.  */
   tree gnu_subprog_type = TREE_TYPE (gnu_subprog);
   /* The return type of the FUNCTION_TYPE.  */
-  tree gnu_result_type = TREE_TYPE (gnu_subprog_type);
+  tree gnu_result_type;;
   const bool frontend_builtin
     = (TREE_CODE (gnu_subprog) == FUNCTION_DECL
        && DECL_BUILT_IN_CLASS (gnu_subprog) == BUILT_IN_FRONTEND);
@@ -4496,6 +4512,7 @@ Call_to_gnu (Node_Id gnat_node, tree *gnu_result_type_p, tree gnu_target,
   bool variadic;
   bool by_descriptor;
   Entity_Id gnat_formal;
+  Entity_Id gnat_result_type;
   Node_Id gnat_actual;
   atomic_acces_t aa_type;
   bool aa_sync;
@@ -4510,6 +4527,7 @@ Call_to_gnu (Node_Id gnat_node, tree *gnu_result_type_p, tree gnu_target,
        = Underlying_Type (Etype (Prefix (gnat_subprog)));
 
       gnat_formal = First_Formal_With_Extras (Etype (gnat_subprog));
+      gnat_result_type = Etype (Etype (gnat_subprog));
       variadic = IN (Convention (gnat_prefix_type), Convention_C_Variadic);
 
       /* If the access type doesn't require foreign-compatible representation,
@@ -4523,6 +4541,7 @@ Call_to_gnu (Node_Id gnat_node, tree *gnu_result_type_p, tree gnu_target,
     {
       /* Assume here that this must be 'Elab_Body or 'Elab_Spec.  */
       gnat_formal = Empty;
+      gnat_result_type = Empty;
       variadic = false;
       by_descriptor = false;
     }
@@ -4532,6 +4551,7 @@ Call_to_gnu (Node_Id gnat_node, tree *gnu_result_type_p, tree gnu_target,
       gcc_checking_assert (Is_Entity_Name (gnat_subprog));
 
       gnat_formal = First_Formal_With_Extras (Entity (gnat_subprog));
+      gnat_result_type = Etype (Entity_Id (gnat_subprog));
       variadic = IN (Convention (Entity (gnat_subprog)), Convention_C_Variadic);
       by_descriptor = false;
 
@@ -4549,6 +4569,7 @@ Call_to_gnu (Node_Id gnat_node, tree *gnu_result_type_p, tree gnu_target,
 
          if (returning_value)
            {
+             gnu_result_type = TREE_TYPE (gnu_subprog_type);
              *gnu_result_type_p = gnu_result_type;
              return build1 (NULL_EXPR, gnu_result_type, call_expr);
            }
@@ -4557,7 +4578,13 @@ Call_to_gnu (Node_Id gnat_node, tree *gnu_result_type_p, tree gnu_target,
        }
     }
 
+  /* We must elaborate the entire profile now because, if it references types
+     that were initially incomplete,, their elaboration changes the contents
+     of GNU_SUBPROG_TYPE and, in particular, may change the result type.  */
+  elaborate_profile (gnat_formal, gnat_result_type);
+
   gcc_assert (FUNC_OR_METHOD_TYPE_P (gnu_subprog_type));
+  gnu_result_type = TREE_TYPE (gnu_subprog_type);
 
   if (TREE_CODE (gnu_subprog) == FUNCTION_DECL)
     {