This is an ICE on the use of the pre-defined unit Ordered_Map in conjunction 
with the No_Streams restriction.  In this case, gigi builds a NULL_EXPR 
wrapping a call to the raise Program_Error routine, but it fails to gimplify 
it properly in gnat_gimplify_expr.

Tested on x86_64-suse-linux, applied on the mainline.


2014-11-22  Eric Botcazou  <ebotca...@adacore.com>

        * gcc-interface/trans.c (gnat_gimplify_expr): Add 'type' variable.
        <case NULL_EXPR>: Deal with unconstrained array types and use 'type'.
        <case ADDR_EXPR>: Use 'type'.
        <case DECL_EXPR>: Likewise.


2014-11-22  Eric Botcazou  <ebotca...@adacore.com>

        * gnat.dg/specs/no_streams.ads: New test.


-- 
Eric Botcazou
Index: gcc-interface/trans.c
===================================================================
--- gcc-interface/trans.c	(revision 217961)
+++ gcc-interface/trans.c	(working copy)
@@ -7657,6 +7657,7 @@ gnat_gimplify_expr (tree *expr_p, gimple
 		    gimple_seq *post_p ATTRIBUTE_UNUSED)
 {
   tree expr = *expr_p;
+  tree type = TREE_TYPE (expr);
   tree op;
 
   if (IS_ADA_STMT (expr))
@@ -7665,16 +7666,17 @@ gnat_gimplify_expr (tree *expr_p, gimple
   switch (TREE_CODE (expr))
     {
     case NULL_EXPR:
-      /* If this is for a scalar, just make a VAR_DECL for it.  If for
-	 an aggregate, get a null pointer of the appropriate type and
-	 dereference it.  */
-      if (AGGREGATE_TYPE_P (TREE_TYPE (expr)))
-	*expr_p = build1 (INDIRECT_REF, TREE_TYPE (expr),
-			  convert (build_pointer_type (TREE_TYPE (expr)),
-				   integer_zero_node));
+      /* If this is an aggregate type, build a null pointer of the appropriate
+	 type and dereference it.  */
+      if (AGGREGATE_TYPE_P (type)
+	  || TREE_CODE (type) == UNCONSTRAINED_ARRAY_TYPE)
+	*expr_p = build_unary_op (INDIRECT_REF, NULL_TREE,
+				  convert (build_pointer_type (type),
+					   integer_zero_node));
+      /* Otherwise, just make a VAR_DECL.  */
       else
 	{
-	  *expr_p = create_tmp_var (TREE_TYPE (expr), NULL);
+	  *expr_p = create_tmp_var (type, NULL);
 	  TREE_NO_WARNING (*expr_p) = 1;
 	}
 
@@ -7697,7 +7699,7 @@ gnat_gimplify_expr (tree *expr_p, gimple
       if (TREE_CODE (op) == CONSTRUCTOR && TREE_CONSTANT (op))
 	{
 	  tree addr = build_fold_addr_expr (tree_output_constant_def (op));
-	  *expr_p = fold_convert (TREE_TYPE (expr), addr);
+	  *expr_p = fold_convert (type, addr);
 	  return GS_ALL_DONE;
 	}
 
@@ -7711,7 +7713,7 @@ gnat_gimplify_expr (tree *expr_p, gimple
 	 required if the type is passed by reference.  */
       if ((TREE_CODE (op) == CONSTRUCTOR || TREE_CODE (op) == CALL_EXPR)
 	  && AGGREGATE_TYPE_P (TREE_TYPE (op))
-	  && !AGGREGATE_TYPE_P (TREE_TYPE (expr)))
+	  && !AGGREGATE_TYPE_P (type))
 	{
 	  tree mod, new_var = create_tmp_var_raw (TREE_TYPE (op), "C");
 	  gimple_add_tmp_var (new_var);
-- { dg-do compile }

pragma Restrictions (No_Streams);

with Ada.Containers.Ordered_Maps;

package No_Streams is

  type Arr is new String (1..8);

  package My_Ordered_Map is new Ada.Containers.Ordered_Maps
                                  (Key_Type => Natural, Element_Type => Arr);

end No_Streams;

Reply via email to