utils.c (convert_to_fat_pointer): Un-obfuscate the conversion from a thin…

utils.c (convert_to_fat_pointer): Un-obfuscate the conversion from a thin pointer with a shifted value.

	* gcc-interface/utils.c (convert_to_fat_pointer): Un-obfuscate the
	conversion from a thin pointer with a shifted value.
	* gcc-interface/utils2.c (gnat_build_constructor): Propagate the
	read-only flag from the values onto the result.
	(gnat_invariant_expr): Accept read-only CONSTRUCTORs.

From-SVN: r207073

gcc/ada/ChangeLog

+2014-01-25  Eric Botcazou  <ebotcazou@adacore.com>
+
+	* gcc-interface/utils.c (convert_to_fat_pointer): Un-obfuscate the
+	conversion from a thin pointer with a shifted value.
+	* gcc-interface/utils2.c (gnat_build_constructor): Propagate the
+	read-only flag from the values onto the result.
+	(gnat_invariant_expr): Accept read-only CONSTRUCTORs.
+
 2014-01-25  Tristan Gingold  <gingold@adacore.com>
 
 	* gcc-interface/decl.c (gnat_to_gnu_entity): Always build a variable

gcc/ada/gcc-interface/utils.c

@@ -4352,7 +4352,7 @@ convert_to_fat_pointer (tree type, tree expr)
   tree template_type = TREE_TYPE (TREE_TYPE (DECL_CHAIN (TYPE_FIELDS (type))));
   tree p_array_type = TREE_TYPE (TYPE_FIELDS (type));
   tree etype = TREE_TYPE (expr);
-  tree template_tree;
+  tree template_addr;
   vec<constructor_elt, va_gc> *v;
   vec_alloc (v, 2);
 
@@ -4395,31 +4395,43 @@ convert_to_fat_pointer (tree type, tree expr)
       tree field = TYPE_FIELDS (TREE_TYPE (etype));
 
       expr = gnat_protect_expr (expr);
-      if (TREE_CODE (expr) == ADDR_EXPR)
-	expr = TREE_OPERAND (expr, 0);
-      else
+
+      /* If we have a TYPE_UNCONSTRAINED_ARRAY attached to the RECORD_TYPE,
+	 the thin pointer value has been shifted so we shift it back to get
+	 the template address.  */
+      if (TYPE_UNCONSTRAINED_ARRAY (TREE_TYPE (etype)))
 	{
-	  /* If we have a TYPE_UNCONSTRAINED_ARRAY attached to the RECORD_TYPE,
-	     the thin pointer value has been shifted so we first need to shift
-	     it back to get the template address.  */
-	  if (TYPE_UNCONSTRAINED_ARRAY (TREE_TYPE (etype)))
-	    expr
-	      = build_binary_op (POINTER_PLUS_EXPR, etype, expr,
-				 fold_build1 (NEGATE_EXPR, sizetype,
-					      byte_position
-					      (DECL_CHAIN (field))));
-	  expr = build1 (INDIRECT_REF, TREE_TYPE (etype), expr);
+	  template_addr
+	    = build_binary_op (POINTER_PLUS_EXPR, etype, expr,
+			       fold_build1 (NEGATE_EXPR, sizetype,
+					    byte_position
+					    (DECL_CHAIN (field))));
+	  template_addr
+	    = fold_convert (TREE_TYPE (DECL_CHAIN (TYPE_FIELDS (type))),
+			    template_addr);
 	}
 
-      template_tree = build_component_ref (expr, NULL_TREE, field, false);
-      expr = build_unary_op (ADDR_EXPR, NULL_TREE,
-			     build_component_ref (expr, NULL_TREE,
-						  DECL_CHAIN (field), false));
+      /* Otherwise we explicitly take the address of the fields.  */
+      else
+	{
+	  expr = build_unary_op (INDIRECT_REF, NULL_TREE, expr);
+	  template_addr
+	    = build_unary_op (ADDR_EXPR, NULL_TREE,
+			      build_component_ref (expr, NULL_TREE, field,
+						   false));
+	  expr = build_unary_op (ADDR_EXPR, NULL_TREE,
+				 build_component_ref (expr, NULL_TREE,
+						      DECL_CHAIN (field),
+						      false));
+	}
     }
 
   /* Otherwise, build the constructor for the template.  */
   else
-    template_tree = build_template (template_type, TREE_TYPE (etype), expr);
+    template_addr
+      = build_unary_op (ADDR_EXPR, NULL_TREE,
+			build_template (template_type, TREE_TYPE (etype),
+					expr));
 
   /* The final result is a constructor for the fat pointer.
 
@@ -4433,11 +4445,8 @@ convert_to_fat_pointer (tree type, tree expr)
 
      Note that the call to "build_template" above is still fine because it
      will only refer to the provided TEMPLATE_TYPE in this case.  */
-  CONSTRUCTOR_APPEND_ELT (v, TYPE_FIELDS (type),
-			  convert (p_array_type, expr));
-  CONSTRUCTOR_APPEND_ELT (v, DECL_CHAIN (TYPE_FIELDS (type)),
-			  build_unary_op (ADDR_EXPR, NULL_TREE,
-					  template_tree));
+  CONSTRUCTOR_APPEND_ELT (v, TYPE_FIELDS (type), convert (p_array_type, expr));
+  CONSTRUCTOR_APPEND_ELT (v, DECL_CHAIN (TYPE_FIELDS (type)), template_addr);
   return gnat_build_constructor (type, v);
 }
 

gcc/ada/gcc-interface/utils2.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- *
@@ -1850,6 +1850,7 @@ tree
 gnat_build_constructor (tree type, vec<constructor_elt, va_gc> *v)
 {
   bool allconstant = (TREE_CODE (TYPE_SIZE (type)) == INTEGER_CST);
+  bool read_only = true;
   bool side_effects = false;
   tree result, obj, val;
   unsigned int n_elmts;
@@ -1867,6 +1868,9 @@ gnat_build_constructor (tree type, vec<constructor_elt, va_gc> *v)
 	  || !initializer_constant_valid_p (val, TREE_TYPE (val)))
 	allconstant = false;
 
+      if (!TREE_READONLY (val))
+	read_only = false;
+
       if (TREE_SIDE_EFFECTS (val))
 	side_effects = true;
     }
@@ -1881,7 +1885,7 @@ gnat_build_constructor (tree type, vec<constructor_elt, va_gc> *v)
   CONSTRUCTOR_NO_CLEARING (result) = 1;
   TREE_CONSTANT (result) = TREE_STATIC (result) = allconstant;
   TREE_SIDE_EFFECTS (result) = side_effects;
-  TREE_READONLY (result) = TYPE_READONLY (type) || allconstant;
+  TREE_READONLY (result) = TYPE_READONLY (type) || read_only || allconstant;
   return result;
 }
 
@@ -2814,7 +2818,7 @@ object:
   if (!TREE_READONLY (t))
     return NULL_TREE;
 
-  if (TREE_CODE (t) == PARM_DECL)
+  if (TREE_CODE (t) == CONSTRUCTOR || TREE_CODE (t) == PARM_DECL)
     return fold_convert (type, expr);
 
   if (TREE_CODE (t) == VAR_DECL