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

	* 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

diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index 4a93e9a..bf0e299 100644 (file)
--- a/gcc/ada/ChangeLog
+++ b/gcc/ada/ChangeLog
@@ -1,5 +1,14 @@
 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

diff --git a/gcc/ada/gcc-interface/decl.c b/gcc/ada/gcc-interface/decl.c
index dd912f3..5259ad4 100644 (file)
--- a/gcc/ada/gcc-interface/decl.c
+++ b/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;

diff --git a/gcc/ada/gcc-interface/trans.c b/gcc/ada/gcc-interface/trans.c
index 2eae399..d99eda8 100644 (file)
--- a/gcc/ada/gcc-interface/trans.c
+++ b/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 ());
 }
 \f
 /* 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)