aboutsummaryrefslogtreecommitdiff
path: root/gcc/ada
diff options
context:
space:
mode:
authorEric Botcazou <ebotcazou@adacore.com>2021-12-23 16:48:11 +0100
committerPierre-Marie de Rodat <derodat@adacore.com>2022-01-10 09:38:47 +0000
commita42dd9febbbeb328af5b3b6adf4431dd7bcca113 (patch)
tree3a40c3b4d9b116fc3999bcc6bfd959d4a5088332 /gcc/ada
parentcc9cd2324922575c1aa1eadf6340c2af47f011c4 (diff)
downloadgcc-a42dd9febbbeb328af5b3b6adf4431dd7bcca113.zip
gcc-a42dd9febbbeb328af5b3b6adf4431dd7bcca113.tar.gz
gcc-a42dd9febbbeb328af5b3b6adf4431dd7bcca113.tar.bz2
[Ada] Fix bogus error on call to subprogram with incomplete profile
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.
Diffstat (limited to 'gcc/ada')
-rw-r--r--gcc/ada/gcc-interface/trans.c31
1 files changed, 29 insertions, 2 deletions
diff --git a/gcc/ada/gcc-interface/trans.c b/gcc/ada/gcc-interface/trans.c
index 47fbbc9..39059cb 100644
--- a/gcc/ada/gcc-interface/trans.c
+++ b/gcc/ada/gcc-interface/trans.c
@@ -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)
{