Skip to content

R
riscv-gcc-1
Commit 8afc118e by Eric Botcazou Committed by Arnaud Charlet
Options

Fix for c330001 - PR ada/19386 

2005-02-09  Eric Botcazou  <ebotcazou@adacore.com>
	    Richard Kenner  <kenner@vlsi1.ultra.nyu.edu>

	Fix for c330001 - PR ada/19386

	* decl.c:
	(gnat_to_gnu_field): Do not necessarily invoke make_packable_type
	on the field if Pragma Component_Alignment (Storage_Unit).
	(gnat_to_gnu_entity, case object): Do not treat a renaming that has
	side-effects as if it were a constant; also make SAVE_EXPR to protect
	side-effects.
	(gnat_to_gnu_entity, case E_Record_Subtype): If have _Parent, make a
	UNION_TYPE.
	(make_dummy_type): Set TYPE_UNCHECKED_UNION_P.
	(components_to_record): Test it.
	Fix improper usage of REFERENCE_CLASS_P.

	* utils2.c (build_binary_op, case MODIFY_EXPRP): Treat UNION_TYPE as
	RECORD_TYPE.

	* utils2.c: Minor reformatting.

	* utils.c (convert, case UNION_TYPE): Check TYPE_UNCHECKED_UNION;
	handle other cases like RECORD_TYPE.

	* utils.c (gnat_pushdecl): Set TREE_NO_WARNING.

From-SVN: r94812
parent cc892b2c
Showing with 66 additions and 22 deletions
gcc/ada/decl.c
......@@ -6,7 +6,7 @@
* *
* C Implementation File *
* *
* Copyright (C) 1992-2004, Free Software Foundation, Inc. *
* Copyright (C) 1992-2005, Free Software Foundation, Inc. *
* *
* GNAT is free software; you can redistribute it and/or modify it under *
* terms of the GNU General Public License as published by the Free Soft- *
......@@ -748,6 +748,7 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition)
}
if (const_flag
&& !TREE_SIDE_EFFECTS (gnu_expr)
&& TREE_CODE (gnu_type) != UNCONSTRAINED_ARRAY_TYPE
&& TYPE_MODE (gnu_type) != BLKmode
&& Ekind (Etype (gnat_entity)) != E_Class_Wide_Type
......@@ -757,8 +758,7 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition)
/* If this is a declaration or reference that we can stabilize,
just use that declaration or reference as this entity unless
the latter has to be materialized. */
else if ((DECL_P (gnu_expr)
|| (REFERENCE_CLASS_P (gnu_expr) == tcc_reference))
else if ((DECL_P (gnu_expr) || REFERENCE_CLASS_P (gnu_expr))
&& !Materialize_Entity (gnat_entity)
&& (!global_bindings_p ()
|| (staticp (gnu_expr)
......@@ -793,7 +793,15 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition)
if (!global_bindings_p ())
{
bool has_side_effects = TREE_SIDE_EFFECTS (gnu_expr);
gnu_expr = gnat_stabilize_reference (gnu_expr, true);
/* If the original expression had side effects, put a
SAVE_EXPR around this whole thing. */
if (has_side_effects)
gnu_expr = save_expr (gnu_expr);
add_stmt (gnu_expr);
}
......@@ -2582,6 +2590,7 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition)
tree gnu_subst_list
= substitution_list (gnat_entity, gnat_base_type, NULL_TREE,
definition);
bool possibly_overlapping_fields = false;
tree gnu_temp;
/* If this is a derived type, we may be seeing fields from any
......@@ -2598,12 +2607,24 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition)
BIGGEST_ALIGNMENT);
if (Present (Parent_Subtype (gnat_root_type)))
{
gnu_subst_list
= substitution_list (Parent_Subtype (gnat_root_type),
Empty, gnu_subst_list, definition);
Empty, gnu_subst_list,
definition);
/* If there's a _Parent field, it may overlap the
fields we have that appear to be in this record but
actually are from the parent. So make note of that
fact and later we'll make a UNION_TYPE instead of
a RECORD_TYPE, since the latter may not have
overlapping fields. */
possibly_overlapping_fields = true;
}
}
gnu_type = make_node (RECORD_TYPE);
gnu_type = make_node (possibly_overlapping_fields
? UNION_TYPE : RECORD_TYPE);
TYPE_NAME (gnu_type) = gnu_entity_id;
TYPE_STUB_DECL (gnu_type)
= create_type_decl (NULL_TREE, gnu_type, NULL, false, false,
......@@ -3163,10 +3184,10 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition)
p->next = defer_incomplete_list;
defer_incomplete_list = p;
}
else if
(IN (Ekind (Base_Type (Directly_Designated_Type (gnat_entity))),
else if (IN (Ekind (Base_Type
(Directly_Designated_Type (gnat_entity))),
Incomplete_Or_Private_Kind))
{ ;}
;
else
gnat_to_gnu_entity (Directly_Designated_Type (gnat_entity),
NULL_TREE, 0);
......@@ -4372,9 +4393,13 @@ make_dummy_type (Entity_Id gnat_type)
/* If this is a record, make this a RECORD_TYPE or UNION_TYPE; else make
it a VOID_TYPE. */
if (Is_Record_Type (gnat_underlying))
gnu_type = make_node (Is_Unchecked_Union (gnat_underlying)
? UNION_TYPE : RECORD_TYPE);
if (Is_Unchecked_Union (gnat_underlying))
{
gnu_type = make_node (UNION_TYPE);
TYPE_UNCHECKED_UNION_P (gnu_type) = 1;
}
else if (Is_Record_Type (gnat_underlying))
gnu_type = make_node (RECORD_TYPE);
else
gnu_type = make_node (ENUMERAL_TYPE);
......@@ -5098,7 +5123,7 @@ gnat_to_gnu_field (Entity_Id gnat_field, tree gnu_record_type, int packed,
&& TYPE_MODE (gnu_field_type) == BLKmode
&& host_integerp (TYPE_SIZE (gnu_field_type), 1)
&& compare_tree_int (TYPE_SIZE (gnu_field_type), BIGGEST_ALIGNMENT) <= 0
&& (packed
&& (packed == 1
|| (gnu_size && tree_int_cst_lt (gnu_size,
TYPE_SIZE (gnu_field_type)))
|| Present (Component_Clause (gnat_field))))
......@@ -5375,7 +5400,9 @@ components_to_record (tree gnu_record_type, Node_Id component_list,
/* If this is an unchecked union, each variant must have exactly one
component, each of which becomes one component of this union. */
if (TREE_CODE (gnu_record_type) == UNION_TYPE && Present (variant_part))
if (TREE_CODE (gnu_record_type) == UNION_TYPE
&& TYPE_UNCHECKED_UNION_P (gnu_record_type)
&& Present (variant_part))
for (variant = First_Non_Pragma (Variants (variant_part));
Present (variant);
variant = Next_Non_Pragma (variant))
......
gcc/ada/utils.c
......@@ -6,7 +6,7 @@
* *
* C Implementation File *
* *
* Copyright (C) 1992-2004, Free Software Foundation, Inc. *
* Copyright (C) 1992-2005, Free Software Foundation, Inc. *
* *
* GNAT is free software; you can redistribute it and/or modify it under *
* terms of the GNU General Public License as published by the Free Soft- *
......@@ -309,7 +309,7 @@ insert_block (tree block)
}
/* Records a ..._DECL node DECL as belonging to the current lexical scope
and uses GNAT_NODE for location information. */
and uses GNAT_NODE for location information and propagating flags. */
void
gnat_pushdecl (tree decl, Node_Id gnat_node)
......@@ -321,6 +321,8 @@ gnat_pushdecl (tree decl, Node_Id gnat_node)
else
DECL_CONTEXT (decl) = current_function_decl;
TREE_NO_WARNING (decl) = (gnat_node == Empty || Warnings_Off (gnat_node));
/* Set the location of DECL and emit a declaration for it. */
if (Present (gnat_node))
Sloc_to_locus (Sloc (gnat_node), &DECL_SOURCE_LOCATION (decl));
......@@ -2905,8 +2907,10 @@ convert (tree type, tree expr)
return unchecked_convert (type, expr, false);
case UNION_TYPE:
/* Just validate that the type is indeed that of a field
of the type. Then make the simple conversion. */
/* For unchecked unions, just validate that the type is indeed that of
a field of the type. Then make the simple conversion. */
if (TYPE_UNCHECKED_UNION_P (type))
{
for (tem = TYPE_FIELDS (type); tem; tem = TREE_CHAIN (tem))
{
if (TREE_TYPE (tem) == etype)
......@@ -2920,6 +2924,12 @@ convert (tree type, tree expr)
}
gcc_unreachable ();
}
else
/* Otherwise, this is a conversion between a tagged type and some
subtype, which we have to mark as a UNION_TYPE because of
overlapping fields. */
return unchecked_convert (type, expr, false);
case UNCONSTRAINED_ARRAY_TYPE:
/* If EXPR is a constrained array, take its address, convert it to a
......@@ -3214,6 +3224,7 @@ unchecked_convert (tree type, tree expr, bool notrunc_p)
/* Search the chain of currently reachable declarations for a builtin
FUNCTION_DECL node corresponding to function NAME (an IDENTIFIER_NODE).
Return the first node found, if any, or NULL_TREE otherwise. */
tree
builtin_decl_for (tree name __attribute__ ((unused)))
{
......
gcc/ada/utils2.c
......@@ -6,7 +6,7 @@
* *
* C Implementation File *
* *
* Copyright (C) 1992-2004, Free Software Foundation, Inc. *
* Copyright (C) 1992-2005, Free Software Foundation, Inc. *
* *
* GNAT is free software; you can redistribute it and/or modify it under *
* terms of the GNU General Public License as published by the Free Soft- *
......@@ -660,13 +660,16 @@ build_binary_op (enum tree_code op_code, tree result_type,
might indicate a conversion between a root type and a class-wide
type, which we must not remove. */
while (TREE_CODE (right_operand) == VIEW_CONVERT_EXPR
&& ((TREE_CODE (right_type) == RECORD_TYPE
&& (((TREE_CODE (right_type) == RECORD_TYPE
|| TREE_CODE (right_type) == UNION_TYPE)
&& !TYPE_JUSTIFIED_MODULAR_P (right_type)
&& !TYPE_ALIGN_OK (right_type)
&& !TYPE_IS_FAT_POINTER_P (right_type))
|| TREE_CODE (right_type) == ARRAY_TYPE)
&& (((TREE_CODE (TREE_TYPE (TREE_OPERAND (right_operand, 0)))
&& ((((TREE_CODE (TREE_TYPE (TREE_OPERAND (right_operand, 0)))
== RECORD_TYPE)
|| (TREE_CODE (TREE_TYPE (TREE_OPERAND (right_operand, 0)))
== UNION_TYPE))
&& !(TYPE_JUSTIFIED_MODULAR_P
(TREE_TYPE (TREE_OPERAND (right_operand, 0))))
&& !(TYPE_ALIGN_OK
......@@ -695,7 +698,9 @@ build_binary_op (enum tree_code op_code, tree result_type,
operation_type = best_type;
/* If a class-wide type may be involved, force use of the RHS type. */
if (TREE_CODE (right_type) == RECORD_TYPE && TYPE_ALIGN_OK (right_type))
if ((TREE_CODE (right_type) == RECORD_TYPE
|| TREE_CODE (right_type) == UNION_TYPE)
&& TYPE_ALIGN_OK (right_type))
operation_type = right_type;
/* Ensure everything on the LHS is valid. If we have a field reference,
......@@ -1087,7 +1092,8 @@ build_unary_op (enum tree_code op_code, tree result_type, tree operand)
int unsignedp, volatilep;
inner = get_inner_reference (operand, &bitsize, &bitpos, &offset,
&mode, &unsignedp, &volatilep, false);
&mode, &unsignedp, &volatilep,
false);
/* If INNER is a padding type whose field has a self-referential
size, convert to that inner type. We know the offset is zero
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment