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

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,13 +4839,12 @@ 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)
@@ -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))));
 
       if (Do_Overflow_Check (gnat_node)
 	  && !TYPE_UNSIGNED (gnu_result_type)