[Ada] Fix ICE on string concatenation with -gnatd.h

[Eric Botcazou <ebotcazou at adacore dot com>]

This fixes an ICE on a string concatenation with the -gnatd.h switch, which 
causes TREE_PUBLIC to be set on a local temporary 

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


2014-10-27  Eric Botcazou  <ebotcazou@adacore.com>

	* gcc-interface/utils.c (create_var_decl_1): For a variable declared
	in the unit, set TREE_PUBLIC only if it has static storage duration.


2014-10-27  Eric Botcazou  <ebotcazou@adacore.com>

	* gnat.dg/specs/concat1.ads: New test.
	* gnat.dg/specs/concat1_pkg.ads: New helper.


-- 
Eric Botcazou

Index: gcc-interface/utils.c
===================================================================
--- gcc-interface/utils.c	(revision 216612)
+++ gcc-interface/utils.c	(working copy)
@@ -2309,25 +2309,30 @@ create_var_decl_1 (tree var_name, tree a
 		   bool static_flag, bool const_decl_allowed_p,
 		   struct attrib *attr_list, Node_Id gnat_node)
 {
-  /* Whether the initializer is a constant initializer.  At the global level
-     or for an external object or an object to be allocated in static memory,
-     we check that it is a valid constant expression for use in initializing
-     a static variable; otherwise, we only check that it is constant.  */
-  bool init_const
-    = (var_init != 0
+  /* Whether the object has static storage duration, either explicitly or by
+     virtue of being declared at the global level.  */
+  const bool static_storage = static_flag || global_bindings_p ();
+
+  /* Whether the initializer is constant: for an external object or an object
+     with static storage duration, we check that the initializer is a valid
+     constant expression for initializing a static variable; otherwise, we
+     only check that it is constant.  */
+  const bool init_const
+    = (var_init
        && gnat_types_compatible_p (type, TREE_TYPE (var_init))
-       && (global_bindings_p () || extern_flag || static_flag
-	   ? initializer_constant_valid_p (var_init, TREE_TYPE (var_init)) != 0
+       && (extern_flag || static_storage
+	   ? initializer_constant_valid_p (var_init, TREE_TYPE (var_init))
+	     != NULL_TREE
 	   : TREE_CONSTANT (var_init)));
 
   /* Whether we will make TREE_CONSTANT the DECL we produce here, in which
-     case the initializer may be used in-lieu of the DECL node (as done in
+     case the initializer may be used in lieu of the DECL node (as done in
      Identifier_to_gnu).  This is useful to prevent the need of elaboration
-     code when an identifier for which such a decl is made is in turn used as
-     an initializer.  We used to rely on CONST vs VAR_DECL for this purpose,
-     but extra constraints apply to this choice (see below) and are not
-     relevant to the distinction we wish to make. */
-  bool constant_p = const_flag && init_const;
+     code when an identifier for which such a DECL is made is in turn used
+     as an initializer.  We used to rely on CONST_DECL vs VAR_DECL for this,
+     but extra constraints apply to this choice (see below) and they are not
+     relevant to the distinction we wish to make.  */
+  const bool constant_p = const_flag && init_const;
 
   /* The actual DECL node.  CONST_DECL was initially intended for enumerals
      and may be used for scalars in general but not for aggregates.  */
@@ -2347,19 +2352,24 @@ create_var_decl_1 (tree var_name, tree a
       || (type_annotate_only && var_init && !TREE_CONSTANT (var_init)))
     var_init = NULL_TREE;
 
-  /* At the global level, an initializer requiring code to be generated
-     produces elaboration statements.  Check that such statements are allowed,
-     that is, not violating a No_Elaboration_Code restriction.  */
-  if (global_bindings_p () && var_init != 0 && !init_const)
+  /* At the global level, a non-constant initializer generates elaboration
+     statements.  Check that such statements are allowed, that is to say,
+     not violating a No_Elaboration_Code restriction.  */
+  if (var_init && !init_const && global_bindings_p ())
     Check_Elaboration_Code_Allowed (gnat_node);
 
   DECL_INITIAL  (var_decl) = var_init;
   TREE_READONLY (var_decl) = const_flag;
   DECL_EXTERNAL (var_decl) = extern_flag;
-  TREE_PUBLIC   (var_decl) = public_flag || extern_flag;
   TREE_CONSTANT (var_decl) = constant_p;
-  TREE_THIS_VOLATILE (var_decl) = TREE_SIDE_EFFECTS (var_decl)
-    = TYPE_VOLATILE (type);
+
+  /* We need to allocate static storage for an object with static storage
+     duration if it isn't external.  */
+  TREE_STATIC (var_decl) = !extern_flag && static_storage;
+
+  /* The object is public if it is external or if it is declared public
+     and has static storage duration.  */
+  TREE_PUBLIC (var_decl) = extern_flag || (public_flag && static_storage);
 
   /* Ada doesn't feature Fortran-like COMMON variables so we shouldn't
      try to fiddle with DECL_COMMON.  However, on platforms that don't
@@ -2371,12 +2381,6 @@ create_var_decl_1 (tree var_name, tree a
       && !have_global_bss_p ())
     DECL_COMMON (var_decl) = 1;
 
-  /* At the global binding level, we need to allocate static storage for the
-     variable if it isn't external.  Otherwise, we allocate automatic storage
-     unless requested not to.  */
-  TREE_STATIC (var_decl)
-    = !extern_flag && (static_flag || global_bindings_p ());
-
   /* For an external constant whose initializer is not absolute, do not emit
      debug info.  In DWARF this would mean a global relocation in a read-only
      section which runs afoul of the PE-COFF run-time relocation mechanism.  */
@@ -2384,9 +2388,12 @@ create_var_decl_1 (tree var_name, tree a
       && constant_p
       && var_init
       && initializer_constant_valid_p (var_init, TREE_TYPE (var_init))
-	   != null_pointer_node)
+	 != null_pointer_node)
     DECL_IGNORED_P (var_decl) = 1;
 
+  if (TYPE_VOLATILE (type))
+    TREE_SIDE_EFFECTS (var_decl) = TREE_THIS_VOLATILE (var_decl) = 1;
+
   if (TREE_SIDE_EFFECTS (var_decl))
     TREE_ADDRESSABLE (var_decl) = 1;
 

-- { dg-do compile }
-- { dg-options "-gnatd.h" }

with Concat1_Pkg; use Concat1_Pkg;

package Concat1 is

   C : constant Natural := Id_For ("_" & Image_Of);

end Concat1;

-- { dg-excess-errors "cannot generate code" }

package Concat1_Pkg is

   function Id_For (Name : String) return Natural;

   function Image_Of return String;

end Concat1_Pkg;