From: Eric Botcazou <ebotca...@adacore.com>
This implements the Is_Constr_Array_Subt_With_Bounds flag for allocators.
gcc/ada/ChangeLog:
* gcc-interface/trans.cc (gnat_to_gnu) <N_Allocator>: Allocate the
bounds alongside the data if the Is_Constr_Array_Subt_With_Bounds
flag is set on the designated type.
<N_Free_Statement>: Take into account the allocated bounds if the
Is_Constr_Array_Subt_With_Bounds flag is set on the designated type.
Tested on x86_64-pc-linux-gnu, committed on master.
---
gcc/ada/gcc-interface/trans.cc | 38 ++++++++++++++++++++++++++++------
1 file changed, 32 insertions(+), 6 deletions(-)
diff --git a/gcc/ada/gcc-interface/trans.cc b/gcc/ada/gcc-interface/trans.cc
index 23fc814f9de..7549b8e37bf 100644
--- a/gcc/ada/gcc-interface/trans.cc
+++ b/gcc/ada/gcc-interface/trans.cc
@@ -7590,6 +7590,10 @@ gnat_to_gnu (Node_Id gnat_node)
case N_Allocator:
{
+ const Entity_Id gnat_desig_type
+ = Designated_Type (Underlying_Type (Etype (gnat_node)));
+ const Entity_Id gnat_pool = Storage_Pool (gnat_node);
+
tree gnu_type, gnu_init;
bool ignore_init_type;
@@ -7608,9 +7612,6 @@ gnat_to_gnu (Node_Id gnat_node)
else if (Nkind (gnat_temp) == N_Qualified_Expression)
{
- const Entity_Id gnat_desig_type
- = Designated_Type (Underlying_Type (Etype (gnat_node)));
-
ignore_init_type = Has_Constrained_Partial_View (gnat_desig_type);
gnu_init = gnat_to_gnu (Expression (gnat_temp));
@@ -7637,11 +7638,24 @@ gnat_to_gnu (Node_Id gnat_node)
else
gcc_unreachable ();
- gnu_result_type = get_unpadded_type (Etype (gnat_node));
+ /* If this is an array allocated with its bounds, use the thin pointer
+ as the result type to trigger the machinery in build_allocator, but
+ make sure not to do it for allocations on the return and secondary
+ stacks (see build_call_alloc_dealloc_proc for more details). */
+ if (Is_Constr_Array_Subt_With_Bounds (gnat_desig_type)
+ && Is_Record_Type (Underlying_Type (Etype (gnat_pool)))
+ && !type_annotate_only)
+ {
+ tree gnu_array = gnat_to_gnu_type (Base_Type (gnat_desig_type));
+ gnu_result_type
+ = build_pointer_type (TYPE_OBJECT_RECORD_TYPE (gnu_array));
+ }
+ else
+ gnu_result_type = get_unpadded_type (Etype (gnat_node));
+
return build_allocator (gnu_type, gnu_init, gnu_result_type,
Procedure_To_Call (gnat_node),
- Storage_Pool (gnat_node), gnat_node,
- ignore_init_type);
+ gnat_pool, gnat_node, ignore_init_type);
}
break;
@@ -8577,6 +8591,18 @@ gnat_to_gnu (Node_Id gnat_node)
(void) gnat_to_gnu_entity (gnat_desig_type, NULL_TREE, false);
gnu_ptr = gnat_to_gnu (gnat_temp);
+
+ /* If this is an array allocated with its bounds, first convert to
+ the thin pointer to trigger the special machinery below. */
+ if (Is_Constr_Array_Subt_With_Bounds (gnat_desig_type))
+ {
+ tree gnu_array = gnat_to_gnu_type (Base_Type (gnat_desig_type));
+ gnu_ptr
+ = convert (build_pointer_type
+ (TYPE_OBJECT_RECORD_TYPE (gnu_array)),
+ gnu_ptr);
+ }
+
gnu_ptr_type = TREE_TYPE (gnu_ptr);
/* If this is a thin pointer, we must first dereference it to create
--
2.43.0
