[Ada] Fix ICE on unchecked conversion from atomic record type

[Eric Botcazou]

This is a regression present on the mainline and 4.6 branch.

Tested on i586-suse-linux, applied on the mainline and 4.6 branch.


2011-09-11  Eric Botcazou  <ebotca...@adacore.com>

        * gcc-interface/decl.c (maybe_pad_type): Do not try to change the form
        of an addressable type.
        * gcc-interface/trans.c (gnat_gimplify_expr) <VIEW_CONVERT_EXPR>: New.
        Deal with those cases for which creating a temporary is mandatory.


2011-09-11  Eric Botcazou  <ebotca...@adacore.com>

        * gnat.dg/atomic5.ad[sb]: New test.


-- 
Eric Botcazou

Index: gcc-interface/decl.c
===================================================================
--- gcc-interface/decl.c	(revision 178762)
+++ gcc-interface/decl.c	(working copy)
@@ -6521,6 +6521,7 @@ maybe_pad_type (tree type, tree size, un
   if (align != 0
       && TREE_CODE (type) == RECORD_TYPE
       && TYPE_MODE (type) == BLKmode
+      && !TREE_ADDRESSABLE (type)
       && TREE_CODE (orig_size) == INTEGER_CST
       && !TREE_OVERFLOW (orig_size)
       && compare_tree_int (orig_size, MAX_FIXED_MODE_SIZE) <= 0
Index: gcc-interface/trans.c
===================================================================
--- gcc-interface/trans.c	(revision 178763)
+++ gcc-interface/trans.c	(working copy)
@@ -6446,6 +6446,28 @@ gnat_gimplify_expr (tree *expr_p, gimple
 
       return GS_UNHANDLED;
 
+    case VIEW_CONVERT_EXPR:
+      op = TREE_OPERAND (expr, 0);
+
+      /* If we are view-converting a CONSTRUCTOR or a call from an aggregate
+	 type to a scalar one, explicitly create the local temporary.  That's
+	 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)))
+	{
+	  tree mod, new_var = create_tmp_var_raw (TREE_TYPE (op), "C");
+	  gimple_add_tmp_var (new_var);
+
+	  mod = build2 (INIT_EXPR, TREE_TYPE (new_var), new_var, op);
+	  gimplify_and_add (mod, pre_p);
+
+	  TREE_OPERAND (expr, 0) = new_var;
+	  return GS_OK;
+	}
+
+      return GS_UNHANDLED;
+
     case DECL_EXPR:
       op = DECL_EXPR_DECL (expr);
 

package body Atomic5 is

  function Create return R is
  begin
    return (A => 0, B => 1, C => 2, D => 4);
  end;

  procedure Proc1 is
    I : Unsigned_32;
  begin
    I := Conv(Create);
  end;

  procedure Proc2 is
    I : Unsigned_32;
  begin
    I := Conv(R'(A => 0, B => 1, C => 2, D => 4));
  end;

end Atomic5;

-- { dg-do compile }

with Unchecked_Conversion;

package Atomic5 is

  type Byte is mod 2 ** 8;
  for Byte'Size use 8;

  type Unsigned_32 is mod 2 ** 32;
  for Unsigned_32'Size use 32;

  type R is record
    A,B,C,D : Byte;
  end record;
  for R'Alignment use 4;
  pragma Atomic (R);

  function Conv is new Unchecked_Conversion (R, Unsigned_32);

  procedure Proc1;

  procedure Proc2;

end Atomic5;