aboutsummaryrefslogtreecommitdiff
path: root/gcc/ada/gcc-interface/decl.c
diff options
context:
space:
mode:
Diffstat (limited to 'gcc/ada/gcc-interface/decl.c')
-rw-r--r--gcc/ada/gcc-interface/decl.c70
1 files changed, 46 insertions, 24 deletions
diff --git a/gcc/ada/gcc-interface/decl.c b/gcc/ada/gcc-interface/decl.c
index 224e4918db0..3e8552a2d5c 100644
--- a/gcc/ada/gcc-interface/decl.c
+++ b/gcc/ada/gcc-interface/decl.c
@@ -295,7 +295,10 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, bool definition)
tree gnu_size = NULL_TREE;
/* Contains the GCC name to be used for the GCC node. */
tree gnu_entity_name;
- /* True if we have already saved gnu_decl as a GNAT association. */
+ /* True if we have already saved gnu_decl as a GNAT association. This can
+ also be used to purposely avoid making such an association but this use
+ case ought not to be applied to types because it can break the deferral
+ mechanism implemented for access types. */
bool saved = false;
/* True if we incremented defer_incomplete_level. */
bool this_deferred = false;
@@ -312,14 +315,11 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, bool definition)
/* Since a use of an Itype is a definition, process it as such if it is in
the main unit, except for E_Access_Subtype because it's actually a use
- of its base type, and for E_Record_Subtype with cloned subtype because
- it's actually a use of the cloned subtype, see below. */
+ of its base type, see below. */
if (!definition
&& is_type
&& Is_Itype (gnat_entity)
- && !(kind == E_Access_Subtype
- || (kind == E_Record_Subtype
- && Present (Cloned_Subtype (gnat_entity))))
+ && Ekind (gnat_entity) != E_Access_Subtype
&& !present_gnu_tree (gnat_entity)
&& In_Extended_Main_Code_Unit (gnat_entity))
{
@@ -362,7 +362,7 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, bool definition)
}
/* This abort means the Itype has an incorrect scope, i.e. that its
- scope does not correspond to the subprogram it is declared in. */
+ scope does not correspond to the subprogram it is first used in. */
gcc_unreachable ();
}
@@ -371,7 +371,9 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, bool definition)
In that case, we will abort below when we try to save a new GCC tree
for this object. We also need to handle the case of getting a dummy
type when a Full_View exists but be careful so as not to trigger its
- premature elaboration. */
+ premature elaboration. Likewise for a cloned subtype without its own
+ freeze node, which typically happens when a generic gets instantiated
+ on an incomplete or private type. */
if ((!definition || (is_type && imported_p))
&& present_gnu_tree (gnat_entity))
{
@@ -385,7 +387,23 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, bool definition)
|| No (Freeze_Node (Full_View (gnat_entity)))))
{
gnu_decl
- = gnat_to_gnu_entity (Full_View (gnat_entity), NULL_TREE, false);
+ = gnat_to_gnu_entity (Full_View (gnat_entity), NULL_TREE,
+ false);
+ save_gnu_tree (gnat_entity, NULL_TREE, false);
+ save_gnu_tree (gnat_entity, gnu_decl, false);
+ }
+
+ if (TREE_CODE (gnu_decl) == TYPE_DECL
+ && TYPE_IS_DUMMY_P (TREE_TYPE (gnu_decl))
+ && Ekind (gnat_entity) == E_Record_Subtype
+ && No (Freeze_Node (gnat_entity))
+ && Present (Cloned_Subtype (gnat_entity))
+ && (present_gnu_tree (Cloned_Subtype (gnat_entity))
+ || No (Freeze_Node (Cloned_Subtype (gnat_entity)))))
+ {
+ gnu_decl
+ = gnat_to_gnu_entity (Cloned_Subtype (gnat_entity), NULL_TREE,
+ false);
save_gnu_tree (gnat_entity, NULL_TREE, false);
save_gnu_tree (gnat_entity, gnu_decl, false);
}
@@ -3367,13 +3385,13 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, bool definition)
case E_Record_Subtype:
/* If Cloned_Subtype is Present it means this record subtype has
identical layout to that type or subtype and we should use
- that GCC type for this one. The front end guarantees that
+ that GCC type for this one. The front-end guarantees that
the component list is shared. */
if (Present (Cloned_Subtype (gnat_entity)))
{
gnu_decl = gnat_to_gnu_entity (Cloned_Subtype (gnat_entity),
NULL_TREE, false);
- saved = true;
+ maybe_present = true;
break;
}
@@ -3787,8 +3805,8 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, bool definition)
case E_Access_Subtype:
/* We treat this as identical to its base type; any constraint is
meaningful only to the front-end. */
- gnu_decl = gnat_to_gnu_entity (Etype (gnat_entity), NULL_TREE, false);
- saved = true;
+ gnu_decl = gnat_to_gnu_entity (gnat_equiv_type, NULL_TREE, false);
+ maybe_present = true;
/* The designated subtype must be elaborated as well, if it does
not have its own freeze node. But designated subtypes created
@@ -4974,6 +4992,10 @@ Gigi_Equivalent_Type (Entity_Id gnat_entity)
gnat_equiv = Equivalent_Type (gnat_entity);
break;
+ case E_Access_Subtype:
+ gnat_equiv = Etype (gnat_entity);
+ break;
+
case E_Class_Wide_Type:
gnat_equiv = Root_Type (gnat_entity);
break;
@@ -6065,7 +6087,8 @@ static void
set_nonaliased_component_on_array_type (tree type)
{
TYPE_NONALIASED_COMPONENT (type) = 1;
- TYPE_NONALIASED_COMPONENT (TYPE_CANONICAL (type)) = 1;
+ if (TYPE_CANONICAL (type))
+ TYPE_NONALIASED_COMPONENT (TYPE_CANONICAL (type)) = 1;
}
/* Set TYPE_REVERSE_STORAGE_ORDER on an array type built by means of
@@ -6075,7 +6098,8 @@ static void
set_reverse_storage_order_on_array_type (tree type)
{
TYPE_REVERSE_STORAGE_ORDER (type) = 1;
- TYPE_REVERSE_STORAGE_ORDER (TYPE_CANONICAL (type)) = 1;
+ if (TYPE_CANONICAL (type))
+ TYPE_REVERSE_STORAGE_ORDER (TYPE_CANONICAL (type)) = 1;
}
/* Return true if DISCR1 and DISCR2 represent the same discriminant. */
@@ -8083,9 +8107,8 @@ annotate_value (tree gnu_size)
{
case INTEGER_CST:
/* For negative values, build NEGATE_EXPR of the opposite. Such values
- can appear for discriminants in expressions for variants. Note that,
- sizetype being unsigned, we don't directly use tree_int_cst_sgn. */
- if (tree_int_cst_sign_bit (gnu_size))
+ can appear for discriminants in expressions for variants. */
+ if (tree_int_cst_sgn (gnu_size) < 0)
{
tree t = wide_int_to_tree (sizetype, -wi::to_wide (gnu_size));
tcode = Negate_Expr;
@@ -8163,9 +8186,8 @@ annotate_value (tree gnu_size)
&& tree_int_cst_sign_bit (TREE_OPERAND (gnu_size, 1)))
{
tcode = Minus_Expr;
- ops[0] = annotate_value (TREE_OPERAND (gnu_size, 0));
- wide_int op1 = -wi::to_wide (TREE_OPERAND (gnu_size, 1));
- ops[1] = annotate_value (wide_int_to_tree (sizetype, op1));
+ wide_int wop1 = -wi::to_wide (TREE_OPERAND (gnu_size, 1));
+ ops[1] = annotate_value (wide_int_to_tree (sizetype, wop1));
break;
}
@@ -8206,9 +8228,9 @@ annotate_value (tree gnu_size)
Such values can appear in expressions with aligning patterns. */
if (TREE_CODE (TREE_OPERAND (gnu_size, 1)) == INTEGER_CST)
{
- wide_int op1 = wi::sext (wi::to_wide (TREE_OPERAND (gnu_size, 1)),
- TYPE_PRECISION (sizetype));
- ops[1] = annotate_value (wide_int_to_tree (sizetype, op1));
+ wide_int wop1 = -wi::to_wide (TREE_OPERAND (gnu_size, 1));
+ tree op1 = wide_int_to_tree (sizetype, wop1);
+ ops[1] = annotate_value (build1 (NEGATE_EXPR, sizetype, op1));
}
break;
generated by cgit v1.2.3 (git 2.25.1) at 2024-05-17 08:19:54 +0000