@@ -2474,17 +2474,17 @@ package Einfo is
-- and subtypes, string types and subtypes, and all numeric types).
-- Set if the type or subtype is constrained.
+-- Is_Constr_Array_Subt_With_Bounds
+-- Defined in all types and subtypes. Set only for an array subtype
+-- which is constrained but nevertheless requires objects of this
+-- subtype to be allocated with their bounds. This flag is used by
+-- the back end to determine whether the bounds must be constructed.
+
-- Is_Constr_Subt_For_U_Nominal
-- Defined in all types and subtypes. Set only for the constructed
-- subtype of an object whose nominal subtype is unconstrained. Note
-- that the constructed subtype itself will be constrained.
-
-- Is_Constructor
-- Defined in function and procedure entities. Set if a pragma
-- CPP_Constructor applies to the subprogram.
@@ -5058,8 +5058,8 @@ package Einfo is
-- Is_Abstract_Type
-- Is_Asynchronous
-- Is_Atomic
+ -- Is_Constr_Array_Subt_With_Bounds
-- Is_Constr_Subt_For_U_Nominal
- -- Is_Constr_Subt_For_UN_Aliased
-- Is_Controlled_Active (base type only)
-- Is_Eliminated
-- Is_Frozen
@@ -8107,8 +8107,7 @@ package body Exp_Ch3 is
-- initialization expression has an unconstrained subtype too,
-- because the bounds must be present within X.
- and then not (Is_Array_Type (Typ)
- and then Is_Constr_Subt_For_UN_Aliased (Typ)
+ and then not (Is_Constr_Array_Subt_With_Bounds (Typ)
and then Is_Constrained (Etype (Expr_Q)))
-- We may use a renaming if the initialization expression is a
@@ -889,7 +889,7 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, bool definition)
|| (TYPE_SIZE (gnu_type)
&& integer_zerop (TYPE_SIZE (gnu_type))
&& !TREE_OVERFLOW (TYPE_SIZE (gnu_type))))
- && !Is_Constr_Subt_For_UN_Aliased (gnat_type)
+ && !Is_Constr_Array_Subt_With_Bounds (gnat_type)
&& No (gnat_renamed_obj)
&& No (Address_Clause (gnat_entity)))
gnu_size = bitsize_unit_node;
@@ -907,7 +907,7 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, bool definition)
&& kind != E_Exception
&& kind != E_Out_Parameter
&& Is_Composite_Type (gnat_type)
- && !Is_Constr_Subt_For_UN_Aliased (gnat_type)
+ && !Is_Constr_Array_Subt_With_Bounds (gnat_type)
&& !Is_Exported (gnat_entity)
&& !imported_p
&& No (gnat_renamed_obj)
@@ -932,11 +932,10 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, bool definition)
check_ok_for_atomic_type (gnu_inner, gnat_entity, true);
}
- /* If this is an aliased object with an unconstrained array nominal
- subtype, make a type that includes the template. We will either
- allocate or create a variable of that type, see below. */
- if (Is_Constr_Subt_For_UN_Aliased (gnat_type)
- && Is_Array_Type (gnat_und_type)
+ /* If this is an array allocated with its bounds, make a type that
+ includes the template. We will either allocate it or create a
+ variable of that type, see below. */
+ if (Is_Constr_Array_Subt_With_Bounds (gnat_type)
&& !type_annotate_only)
{
tree gnu_array = gnat_to_gnu_type (Base_Type (gnat_type));
@@ -986,7 +985,7 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, bool definition)
size might be zero at run time, we force at least the unit size. */
if (Is_Aliased (gnat_entity)
&& Is_Constrained (gnat_type)
- && !Is_Constr_Subt_For_UN_Aliased (gnat_type)
+ && !Is_Constr_Array_Subt_With_Bounds (gnat_type)
&& Is_Array_Type (gnat_und_type)
&& !TREE_CONSTANT (gnu_object_size))
gnu_size = size_binop (MAX_EXPR, gnu_object_size, bitsize_unit_node);
@@ -1145,12 +1144,11 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, bool definition)
the entity as indirect reference to the renamed object. */
if (Materialize_Entity (gnat_entity))
{
- /* If this is an aliased object with an unconstrained array
- nominal subtype, we make its type a thin reference, i.e.
- the reference counterpart of a thin pointer, exactly as
- we would have done in the non-renaming case below. */
- if (Is_Constr_Subt_For_UN_Aliased (gnat_type)
- && Is_Array_Type (gnat_und_type)
+ /* If this is an array allocated with its bounds, we make
+ its type a thin reference, the reference counterpart of
+ a thin pointer, exactly as we would have done in the
+ non-renaming case below. */
+ if (Is_Constr_Array_Subt_With_Bounds (gnat_type)
&& !type_annotate_only)
{
tree gnu_array
@@ -1253,8 +1251,7 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, bool definition)
/* If this is an aliased object with an unconstrained array nominal
subtype, then it can overlay only another aliased object with an
unconstrained array nominal subtype and compatible template. */
- if (Is_Constr_Subt_For_UN_Aliased (gnat_type)
- && Is_Array_Type (gnat_und_type)
+ if (Is_Constr_Array_Subt_With_Bounds (gnat_type)
&& !type_annotate_only)
{
tree rec_type = TREE_TYPE (gnu_type);
@@ -1488,14 +1485,13 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, bool definition)
(TREE_TYPE (TYPE_FIELDS (gnu_type))))))
static_flag = true;
- /* If this is an aliased object with an unconstrained array nominal
- subtype, we make its type a thin reference, i.e. the reference
- counterpart of a thin pointer, so it points to the array part.
- This is aimed to make it easier for the debugger to decode the
- object. Note that we have to do it this late because of the
- couple of allocation adjustments that might be made above. */
- if (Is_Constr_Subt_For_UN_Aliased (gnat_type)
- && Is_Array_Type (gnat_und_type)
+ /* If this is an array allocated with its bounds, we make its type a
+ thin reference, i.e. the reference counterpart of a thin pointer,
+ so that it points to the array part. This is aimed at making it
+ easier for the debugger to decode the object. Note that we have
+ to do it this late because of the couple of allocation adjustments
+ that might be made above. */
+ if (Is_Constr_Array_Subt_With_Bounds (gnat_type)
&& !type_annotate_only)
{
/* In case the object with the template has already been allocated
@@ -1322,7 +1322,7 @@ Identifier_to_gnu (Node_Id gnat_node, tree *gnu_result_type_p)
avoid problematic conversions to the nominal subtype. But remove any
padding from the resulting type. */
if (FUNC_OR_METHOD_TYPE_P (TREE_TYPE (gnu_result))
- || Is_Constr_Subt_For_UN_Aliased (gnat_result_type)
+ || Is_Constr_Array_Subt_With_Bounds (gnat_result_type)
|| (Ekind (gnat_entity) == E_Constant
&& Present (Full_View (gnat_entity))
&& Has_Discriminants (gnat_result_type)
@@ -5039,16 +5039,14 @@ Call_to_gnu (Node_Id gnat_node, tree *gnu_result_type_p, tree gnu_target,
gnu_actual = convert (get_unpadded_type (Etype (gnat_actual)),
gnu_actual);
- /* If we have the constructed subtype of an aliased object
- with an unconstrained nominal subtype, the type of the
- actual includes the template, although it is formally
- constrained. So we need to convert it back to the real
- constructed subtype to retrieve the constrained part
- and takes its address. */
+ /* If it is the constructed subtype of an array allocated with
+ its bounds, the type of the actual includes the template,
+ although it is formally constrained. So we need to convert
+ it back to the real constructed subtype to retrieve the
+ constrained part and takes its address. */
if (TREE_CODE (TREE_TYPE (gnu_actual)) == RECORD_TYPE
&& TYPE_CONTAINS_TEMPLATE_P (TREE_TYPE (gnu_actual))
- && Is_Constr_Subt_For_UN_Aliased (Etype (gnat_actual))
- && Is_Array_Type (Underlying_Type (Etype (gnat_actual))))
+ && Is_Constr_Array_Subt_With_Bounds (Etype (gnat_actual)))
gnu_actual = convert (gnu_actual_type, gnu_actual);
}
@@ -686,8 +686,8 @@ package Gen_IL.Fields is
Is_Compilation_Unit,
Is_Completely_Hidden,
Is_Concurrent_Record_Type,
+ Is_Constr_Array_Subt_With_Bounds,
Is_Constr_Subt_For_U_Nominal,
- Is_Constr_Subt_For_UN_Aliased,
Is_Constrained,
Is_Constructor,
Is_Controlled_Active,
@@ -129,8 +129,8 @@ begin -- Gen_IL.Gen.Gen_Entities
Sm (Is_Class_Wide_Equivalent_Type, Flag),
Sm (Is_Compilation_Unit, Flag),
Sm (Is_Concurrent_Record_Type, Flag),
+ Sm (Is_Constr_Array_Subt_With_Bounds, Flag),
Sm (Is_Constr_Subt_For_U_Nominal, Flag),
- Sm (Is_Constr_Subt_For_UN_Aliased, Flag),
Sm (Is_Constrained, Flag),
Sm (Is_Constructor, Flag),
Sm (Is_Controlled_Active, Flag, Base_Type_Only),
@@ -289,8 +289,6 @@ package body Gen_IL.Internals is
return "Has_SP_Choice";
when Ignore_SPARK_Mode_Pragmas =>
return "Ignore_SPARK_Mode_Pragmas";
- when Is_Constr_Subt_For_UN_Aliased =>
- return "Is_Constr_Subt_For_UN_Aliased";
when Is_CPP_Class =>
return "Is_CPP_Class";
when Is_CUDA_Kernel =>
@@ -4957,23 +4957,32 @@ package body Sem_Ch3 is
if Act_T /= T then
declare
- Full_View_Present : constant Boolean :=
- Is_Private_Type (Act_T)
- and then Present (Full_View (Act_T));
+ Full_Act_T : constant Entity_Id :=
+ (if Is_Private_Type (Act_T)
+ then Full_View (Act_T)
+ else Empty);
-- Propagate attributes to full view when needed
begin
Set_Is_Constr_Subt_For_U_Nominal (Act_T);
- if Full_View_Present then
- Set_Is_Constr_Subt_For_U_Nominal (Full_View (Act_T));
+ if Present (Full_Act_T) then
+ Set_Is_Constr_Subt_For_U_Nominal (Full_Act_T);
end if;
- if Aliased_Present (N) then
- Set_Is_Constr_Subt_For_UN_Aliased (Act_T);
+ -- If the object is aliased, then it may be pointed to by an
+ -- access-to-unconstrained-array value, which means that it
+ -- must be allocated with its bounds.
- if Full_View_Present then
- Set_Is_Constr_Subt_For_UN_Aliased (Full_View (Act_T));
+ if Aliased_Present (N)
+ and then (Is_Array_Type (Act_T)
+ or else (Present (Full_Act_T)
+ and then Is_Array_Type (Full_Act_T)))
+ then
+ Set_Is_Constr_Array_Subt_With_Bounds (Act_T);
+
+ if Present (Full_Act_T) then
+ Set_Is_Constr_Array_Subt_With_Bounds (Full_Act_T);
end if;
end if;
@@ -328,8 +328,6 @@ package body Treepr is
return "Has_RACW";
when F_Ignore_SPARK_Mode_Pragmas =>
return "Ignore_SPARK_Mode_Pragmas";
- when F_Is_Constr_Subt_For_UN_Aliased =>
- return "Is_Constr_Subt_For_UN_Aliased";
when F_Is_CPP_Class =>
return "Is_CPP_Class";
when F_Is_CUDA_Kernel =>