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;