aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorEric Botcazou <ebotcazou@adacore.com>2023-11-28 20:46:00 +0100
committerMarc Poulhiès <poulhies@adacore.com>2023-12-19 15:27:49 +0100
commit80a63cc744e9f16ace1e007f8973e97448742335 (patch)
treeceeea92d3707049a5bccbc69213209b8dcae5253
parent35ef3e08ec5bc03fe2cb80efc3271168bc6d419e (diff)
downloadgcc-80a63cc744e9f16ace1e007f8973e97448742335.zip
gcc-80a63cc744e9f16ace1e007f8973e97448742335.tar.gz
gcc-80a63cc744e9f16ace1e007f8973e97448742335.tar.bz2
ada: Rename Is_Constr_Subt_For_UN_Aliased flag
The flag is set on the constructed subtype of an object with unconstrained nominal subtype that is aliased and is used by the code generator to adjust the layout of the object. But it is actually only used for array subtypes, where it determines whether the object is allocated with its bounds, and this usage could be extended to other cases than the original case. gcc/ada/ * einfo.ads (Is_Constr_Subt_For_UN_Aliased): Rename into... (Is_Constr_Array_Subt_With_Bounds): ...this. * exp_ch3.adb (Expand_N_Object_Declaration): Adjust to above renaming and remove now redundant test. * sem_ch3.adb (Analyze_Object_Declaration): Likewise, but set Is_Constr_Array_Subt_With_Bounds only on arrays. * gen_il-fields.ads (Opt_Field_Enum): Apply same renaming. * gen_il-gen-gen_entities.adb (Entity_Kind): Likewise. * gen_il-internals.adb (Image): Remove specific processing for Is_Constr_Subt_For_UN_Aliased. * treepr.adb (Image): Likewise. * gcc-interface/decl.cc (gnat_to_gnu_entity): Adjust to renaming and remove now redundant tests. * gcc-interface/trans.cc (Identifier_to_gnu): Likewise. (Call_to_gnu): Likewise.
-rw-r--r--gcc/ada/einfo.ads14
-rw-r--r--gcc/ada/exp_ch3.adb3
-rw-r--r--gcc/ada/gcc-interface/decl.cc44
-rw-r--r--gcc/ada/gcc-interface/trans.cc16
-rw-r--r--gcc/ada/gen_il-fields.ads2
-rw-r--r--gcc/ada/gen_il-gen-gen_entities.adb2
-rw-r--r--gcc/ada/gen_il-internals.adb2
-rw-r--r--gcc/ada/sem_ch3.adb27
-rw-r--r--gcc/ada/treepr.adb2
9 files changed, 55 insertions, 57 deletions
diff --git a/gcc/ada/einfo.ads b/gcc/ada/einfo.ads
index 1dd5549..d08f02b 100644
--- a/gcc/ada/einfo.ads
+++ b/gcc/ada/einfo.ads
@@ -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_Constr_Subt_For_UN_Aliased
--- Defined in all types and subtypes. This flag can be set only if
--- Is_Constr_Subt_For_U_Nominal is also set. It indicates that in
--- addition the object concerned is aliased. This flag is used by
--- the backend to determine whether a template must be constructed.
-
-- 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
diff --git a/gcc/ada/exp_ch3.adb b/gcc/ada/exp_ch3.adb
index f88ac7e..d616c5c 100644
--- a/gcc/ada/exp_ch3.adb
+++ b/gcc/ada/exp_ch3.adb
@@ -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
diff --git a/gcc/ada/gcc-interface/decl.cc b/gcc/ada/gcc-interface/decl.cc
index d2456bf..c3d2de2 100644
--- a/gcc/ada/gcc-interface/decl.cc
+++ b/gcc/ada/gcc-interface/decl.cc
@@ -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
diff --git a/gcc/ada/gcc-interface/trans.cc b/gcc/ada/gcc-interface/trans.cc
index 5e9e92d..f5ba916 100644
--- a/gcc/ada/gcc-interface/trans.cc
+++ b/gcc/ada/gcc-interface/trans.cc
@@ -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);
}
diff --git a/gcc/ada/gen_il-fields.ads b/gcc/ada/gen_il-fields.ads
index 8a62eac..5cc4b00 100644
--- a/gcc/ada/gen_il-fields.ads
+++ b/gcc/ada/gen_il-fields.ads
@@ -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,
diff --git a/gcc/ada/gen_il-gen-gen_entities.adb b/gcc/ada/gen_il-gen-gen_entities.adb
index b7e7865..d7d71b4 100644
--- a/gcc/ada/gen_il-gen-gen_entities.adb
+++ b/gcc/ada/gen_il-gen-gen_entities.adb
@@ -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),
diff --git a/gcc/ada/gen_il-internals.adb b/gcc/ada/gen_il-internals.adb
index 9c1ce26..4aef64b 100644
--- a/gcc/ada/gen_il-internals.adb
+++ b/gcc/ada/gen_il-internals.adb
@@ -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 =>
diff --git a/gcc/ada/sem_ch3.adb b/gcc/ada/sem_ch3.adb
index 96fd16d..33d8f11 100644
--- a/gcc/ada/sem_ch3.adb
+++ b/gcc/ada/sem_ch3.adb
@@ -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;
diff --git a/gcc/ada/treepr.adb b/gcc/ada/treepr.adb
index cf938d4..7e13544 100644
--- a/gcc/ada/treepr.adb
+++ b/gcc/ada/treepr.adb
@@ -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 =>