Skip to content

R
riscv-gcc-1
Commit fd6e497e by Eric Botcazou Committed by Eric Botcazou
Options

decl.c (gnat_to_gnu_entity): Robustify tests for aliased objects with an… 

decl.c (gnat_to_gnu_entity): Robustify tests for aliased objects with an unconstrained nominal subtype.

	* gcc-interface/decl.c (gnat_to_gnu_entity) <object>: Robustify tests
	for aliased objects with an unconstrained nominal subtype.
	* gcc-interface/trans.c (Call_to_gnu): Likewise.
	(gnat_to_gnu) <case N_Op_Not>: Robustify test for private type.
	<case N_Op_Minus>: Remove useless code.
	(Exception_Handler_to_gnu_zcx): Minor tweaks.

From-SVN: r206798
parent 608df31f
Showing with 34 additions and 31 deletions
gcc/ada/ChangeLog
2014-01-20 Eric Botcazou <ebotcazou@adacore.com>
* gcc-interface/decl.c (gnat_to_gnu_entity) <object>: Robustify tests
for aliased objects with an unconstrained nominal subtype.
* gcc-interface/trans.c (Call_to_gnu): Likewise.
(gnat_to_gnu) <case N_Op_Not>: Robustify test for private type.
<case N_Op_Minus>: Remove useless code.
(Exception_Handler_to_gnu_zcx): Minor tweaks.
2014-01-20 Eric Botcazou <ebotcazou@adacore.com>
* gcc-interface/decl.c (gnat_to_gnu_entity) <case E_Record_Subtype>:
Tidy up. For a subtype with discriminants and variant part, if a
variant is statically selected and the fields all have a constant
......
gcc/ada/gcc-interface/decl.c
......@@ -771,8 +771,7 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition)
|| (TYPE_SIZE (gnu_type)
&& integer_zerop (TYPE_SIZE (gnu_type))
&& !TREE_OVERFLOW (TYPE_SIZE (gnu_type))))
&& (!Is_Constr_Subt_For_UN_Aliased (Etype (gnat_entity))
|| !Is_Array_Type (Etype (gnat_entity)))
&& !Is_Constr_Subt_For_UN_Aliased (Etype (gnat_entity))
&& No (Renamed_Object (gnat_entity))
&& No (Address_Clause (gnat_entity)))
gnu_size = bitsize_unit_node;
......@@ -864,7 +863,9 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition)
/* If this is an aliased object with an unconstrained nominal subtype,
make a type that includes the template. */
if (Is_Constr_Subt_For_UN_Aliased (Etype (gnat_entity))
&& Is_Array_Type (Etype (gnat_entity))
&& (Is_Array_Type (Etype (gnat_entity))
|| (Is_Private_Type (Etype (gnat_entity))
&& Is_Array_Type (Full_View (Etype (gnat_entity)))))
&& !type_annotate_only)
{
tree gnu_array
......@@ -1390,7 +1391,9 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition)
Note that we have to do that this late because of the couple of
allocation adjustments that might be made just above. */
if (Is_Constr_Subt_For_UN_Aliased (Etype (gnat_entity))
&& Is_Array_Type (Etype (gnat_entity))
&& (Is_Array_Type (Etype (gnat_entity))
|| (Is_Private_Type (Etype (gnat_entity))
&& Is_Array_Type (Full_View (Etype (gnat_entity)))))
&& !type_annotate_only)
{
tree gnu_array
......@@ -4788,10 +4791,8 @@ gnat_to_gnu_entity (Entity_Id gnat_entity, tree gnu_expr, int definition)
from the full view. But always get the type from the full view
for define on use types, since otherwise we won't see them! */
else if (!definition
|| (Is_Itype (full_view)
&& No (Freeze_Node (gnat_entity)))
|| (Is_Itype (gnat_entity)
&& No (Freeze_Node (full_view))))
|| (Is_Itype (full_view) && No (Freeze_Node (gnat_entity)))
|| (Is_Itype (gnat_entity) && No (Freeze_Node (full_view))))
{
gnu_decl = gnat_to_gnu_entity (full_view, NULL_TREE, 0);
maybe_present = true;
......
gcc/ada/gcc-interface/trans.c
......@@ -6,7 +6,7 @@
* *
* C Implementation File *
* *
* Copyright (C) 1992-2013, Free Software Foundation, Inc. *
* Copyright (C) 1992-2014, 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- *
......@@ -4156,7 +4156,9 @@ Call_to_gnu (Node_Id gnat_node, tree *gnu_result_type_p, tree gnu_target,
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 (Etype (gnat_actual)))
&& (Is_Array_Type (Etype (gnat_actual))
|| (Is_Private_Type (Etype (gnat_actual))
&& Is_Array_Type (Full_View (Etype (gnat_actual))))))
gnu_actual = convert (gnat_to_gnu_type (Etype (gnat_actual)),
gnu_actual);
}
......@@ -4826,10 +4828,7 @@ static tree
Exception_Handler_to_gnu_zcx (Node_Id gnat_node)
{
tree gnu_etypes_list = NULL_TREE;
tree gnu_expr;
tree gnu_etype;
tree gnu_current_exc_ptr;
tree prev_gnu_incoming_exc_ptr;
tree gnu_current_exc_ptr, prev_gnu_incoming_exc_ptr;
Node_Id gnat_temp;
/* We build a TREE_LIST of nodes representing what exception types this
......@@ -4840,20 +4839,19 @@ Exception_Handler_to_gnu_zcx (Node_Id gnat_node)
for (gnat_temp = First (Exception_Choices (gnat_node));
gnat_temp; gnat_temp = Next (gnat_temp))
{
tree gnu_expr, gnu_etype;
if (Nkind (gnat_temp) == N_Others_Choice)
{
tree gnu_expr
= All_Others (gnat_temp) ? all_others_decl : others_decl;
gnu_etype
= build_unary_op (ADDR_EXPR, NULL_TREE, gnu_expr);
gnu_expr = All_Others (gnat_temp) ? all_others_decl : others_decl;
gnu_etype = build_unary_op (ADDR_EXPR, NULL_TREE, gnu_expr);
}
else if (Nkind (gnat_temp) == N_Identifier
|| Nkind (gnat_temp) == N_Expanded_Name)
{
Entity_Id gnat_ex_id = Entity (gnat_temp);
/* Exception may be a renaming. Recover original exception which is
/* Exception may be a renaming. Recover original exception which is
the one elaborated and registered. */
if (Present (Renamed_Object (gnat_ex_id)))
gnat_ex_id = Renamed_Object (gnat_ex_id);
......@@ -4914,8 +4912,8 @@ Exception_Handler_to_gnu_zcx (Node_Id gnat_node)
/* Declare and initialize the choice parameter, if present. */
if (Present (Choice_Parameter (gnat_node)))
{
tree gnu_param = gnat_to_gnu_entity
(Choice_Parameter (gnat_node), NULL_TREE, 1);
tree gnu_param
= gnat_to_gnu_entity (Choice_Parameter (gnat_node), NULL_TREE, 1);
add_stmt (build_call_n_expr
(set_exception_parameter_decl, 2,
......@@ -4932,8 +4930,8 @@ Exception_Handler_to_gnu_zcx (Node_Id gnat_node)
gnu_incoming_exc_ptr = prev_gnu_incoming_exc_ptr;
return build2 (CATCH_EXPR, void_type_node, gnu_etypes_list,
end_stmt_group ());
return
build2 (CATCH_EXPR, void_type_node, gnu_etypes_list, end_stmt_group ());
}
/* Subroutine of gnat_to_gnu to generate code for an N_Compilation unit. */
......@@ -6250,7 +6248,7 @@ gnat_to_gnu (Node_Id gnat_node)
Fall through for a boolean operand since GNU_CODES is set
up to handle this. */
if (Is_Modular_Integer_Type (Etype (gnat_node))
|| (Ekind (Etype (gnat_node)) == E_Private_Type
|| (Is_Private_Type (Etype (gnat_node))
&& Is_Modular_Integer_Type (Full_View (Etype (gnat_node)))))
{
gnu_expr = gnat_to_gnu (Right_Opnd (gnat_node));
......@@ -6264,12 +6262,7 @@ gnat_to_gnu (Node_Id gnat_node)
case N_Op_Minus: case N_Op_Abs:
gnu_expr = gnat_to_gnu (Right_Opnd (gnat_node));
if (Ekind (Etype (gnat_node)) != E_Private_Type)
gnu_result_type = get_unpadded_type (Etype (gnat_node));
else
gnu_result_type = get_unpadded_type (Base_Type
(Full_View (Etype (gnat_node))));
gnu_result_type = get_unpadded_type (Etype (gnat_node));
if (Do_Overflow_Check (gnat_node)
&& !TYPE_UNSIGNED (gnu_result_type)
......
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