trans.c (lvalue_required_for_attribute_p): New static function.

	* gcc-interface/trans.c (lvalue_required_for_attribute_p): New static
	function.
	(lvalue_required_p) <N_Attribute_Reference>: Call it.
	(gnat_to_gnu) <N_Selected_Component>: Prevent build_component_ref from
	folding the result only if lvalue_required_for_attribute_p is true.
	* gcc-interface/utils.c (maybe_unconstrained_array): Pass correctly
	typed constant to build_component_ref.
	(unchecked_convert): Likewise.
	* gcc-interface/utils2.c (maybe_wrap_malloc): Likewise.
	(build_allocator): Likewise.

From-SVN: r158202

diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index 626eb4f8b274febcde1d49ad4932eafe5ef2c404..55898e3e4a54baf4b998abf204135d6d68388dfe 100644 (file)
--- a/gcc/ada/ChangeLog
+++ b/gcc/ada/ChangeLog
@@ -1,3 +1,16 @@
+2010-04-11  Eric Botcazou  <ebotcazou@adacore.com>
+
+       * gcc-interface/trans.c (lvalue_required_for_attribute_p): New static
+       function.
+       (lvalue_required_p) <N_Attribute_Reference>: Call it.
+       (gnat_to_gnu) <N_Selected_Component>: Prevent build_component_ref from
+       folding the result only if lvalue_required_for_attribute_p is true.
+       * gcc-interface/utils.c (maybe_unconstrained_array): Pass correctly
+       typed constant to build_component_ref.
+       (unchecked_convert): Likewise.
+       * gcc-interface/utils2.c (maybe_wrap_malloc): Likewise.
+       (build_allocator): Likewise.
+
 2010-04-11  Eric Botcazou  <ebotcazou@adacore.com>
 
        * gcc-interface/utils2.c (build_cond_expr): Take the address and

diff --git a/gcc/ada/gcc-interface/trans.c b/gcc/ada/gcc-interface/trans.c
index cb5ff94d7a552dbbd38ef66765bf94602ce94223..28a2bd414bd62951af3d3d14ece4a58666b1be73 100644 (file)
--- a/gcc/ada/gcc-interface/trans.c
+++ b/gcc/ada/gcc-interface/trans.c
@@ -655,6 +655,51 @@ gigi (Node_Id gnat_root, int max_gnat_node, int number_name,
   error_gnat_node = Empty;
 }
 \f
+/* Return a positive value if an lvalue is required for GNAT_NODE, which is
+   an N_Attribute_Reference.  */
+
+static int
+lvalue_required_for_attribute_p (Node_Id gnat_node)
+{
+  switch (Get_Attribute_Id (Attribute_Name (gnat_node)))
+    {
+    case Attr_Pos:
+    case Attr_Val:
+    case Attr_Pred:
+    case Attr_Succ:
+    case Attr_First:
+    case Attr_Last:
+    case Attr_Range_Length:
+    case Attr_Length:
+    case Attr_Object_Size:
+    case Attr_Value_Size:
+    case Attr_Component_Size:
+    case Attr_Max_Size_In_Storage_Elements:
+    case Attr_Min:
+    case Attr_Max:
+    case Attr_Null_Parameter:
+    case Attr_Passed_By_Reference:
+    case Attr_Mechanism_Code:
+      return 0;
+
+    case Attr_Address:
+    case Attr_Access:
+    case Attr_Unchecked_Access:
+    case Attr_Unrestricted_Access:
+    case Attr_Code_Address:
+    case Attr_Pool_Address:
+    case Attr_Size:
+    case Attr_Alignment:
+    case Attr_Bit_Position:
+    case Attr_Position:
+    case Attr_First_Bit:
+    case Attr_Last_Bit:
+    case Attr_Bit:
+    default:
+      return 1;
+    }
+}
+
 /* Return a positive value if an lvalue is required for GNAT_NODE.  GNU_TYPE
    is the type that will be used for GNAT_NODE in the translated GNU tree.
    CONSTANT indicates whether the underlying object represented by GNAT_NODE
@@ -678,18 +723,7 @@ lvalue_required_p (Node_Id gnat_node, tree gnu_type, bool constant,
       return 1;
 
     case N_Attribute_Reference:
-      {
-       unsigned char id = Get_Attribute_Id (Attribute_Name (gnat_parent));
-       return id == Attr_Address
-              || id == Attr_Access
-              || id == Attr_Unchecked_Access
-              || id == Attr_Unrestricted_Access
-              || id == Attr_Bit_Position
-              || id == Attr_Position
-              || id == Attr_First_Bit
-              || id == Attr_Last_Bit
-              || id == Attr_Bit;
-      }
+      return lvalue_required_for_attribute_p (gnat_parent);
 
     case N_Parameter_Association:
     case N_Function_Call:
@@ -3991,7 +4025,9 @@ gnat_to_gnu (Node_Id gnat_node)
            gnu_result
              = build_component_ref (gnu_prefix, NULL_TREE, gnu_field,
                                     (Nkind (Parent (gnat_node))
-                                     == N_Attribute_Reference));
+                                     == N_Attribute_Reference)
+                                    && lvalue_required_for_attribute_p
+                                       (Parent (gnat_node)));
          }
 
        gcc_assert (gnu_result);

diff --git a/gcc/ada/gcc-interface/utils.c b/gcc/ada/gcc-interface/utils.c
index a59b565b77b033081da1ce4db9a9cf83e2b32fff..fed723fa929f2974af33518f0187a686b1f8f417 100644 (file)
--- a/gcc/ada/gcc-interface/utils.c
+++ b/gcc/ada/gcc-interface/utils.c
@@ -4274,12 +4274,13 @@ maybe_unconstrained_array (tree exp)
              build_component_ref (new_exp, NULL_TREE,
                                   TREE_CHAIN
                                   (TYPE_FIELDS (TREE_TYPE (new_exp))),
-                                  0);
+                                  false);
        }
       else if (TYPE_CONTAINS_TEMPLATE_P (TREE_TYPE (exp)))
        return
          build_component_ref (exp, NULL_TREE,
-                              TREE_CHAIN (TYPE_FIELDS (TREE_TYPE (exp))), 0);
+                              TREE_CHAIN (TYPE_FIELDS (TREE_TYPE (exp))),
+                              false);
       break;
 
     default:
@@ -4416,7 +4417,7 @@ unchecked_convert (tree type, tree expr, bool notrunc_p)
       layout_type (rec_type);
 
       expr = unchecked_convert (rec_type, expr, notrunc_p);
-      expr = build_component_ref (expr, NULL_TREE, field, 0);
+      expr = build_component_ref (expr, NULL_TREE, field, false);
     }
 
   /* Similarly if we are converting from an integral type whose precision

diff --git a/gcc/ada/gcc-interface/utils2.c b/gcc/ada/gcc-interface/utils2.c
index 29d60daf3460cab9f31e27df55635f6ca4c8acbd..7d78c25ffba4c8491e6e5c75d7895838533477f0 100644 (file)
--- a/gcc/ada/gcc-interface/utils2.c
+++ b/gcc/ada/gcc-interface/utils2.c
@@ -1812,7 +1812,7 @@ maybe_wrap_malloc (tree data_size, tree data_type, Node_Id gnat_node)
 
       tree aligning_field
        = build_component_ref (aligning_record, NULL_TREE,
-                              TYPE_FIELDS (aligning_type), 0);
+                              TYPE_FIELDS (aligning_type), false);
 
       tree aligning_field_addr
         = build_unary_op (ADDR_EXPR, NULL_TREE, aligning_field);
@@ -2003,7 +2003,7 @@ build_allocator (tree type, tree init, tree result_type, Entity_Id gnat_proc,
            build_component_ref
            (build_unary_op (INDIRECT_REF, NULL_TREE,
                             convert (storage_ptr_type, storage)),
-            NULL_TREE, TYPE_FIELDS (storage_type), 0),
+            NULL_TREE, TYPE_FIELDS (storage_type), false),
            build_template (template_type, type, NULL_TREE)),
           convert (result_type, convert (storage_ptr_type, storage)));
     }

diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog
index a7ef6764dc95b2967cdcf49f87b8c73156da8464..1c4c5de95eb3c6d8c23773f09818563029f659bb 100644 (file)
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -1,3 +1,8 @@
+2010-04-11  Eric Botcazou  <ebotcazou@adacore.com>
+
+       * gnat.dg/pack9.adb: Remove -cargs option.
+       * gnat.dg/aggr12.ad[sb]: New test.
+
 2010-04-10  Jie Zhang  <jie@codesourcery.com>
 
        PR target/43417

diff --git a/gcc/testsuite/gnat.dg/aggr12.adb b/gcc/testsuite/gnat.dg/aggr12.adb
new file mode 100644 (file)
index 0000000..8a18291
--- /dev/null
+++ b/gcc/testsuite/gnat.dg/aggr12.adb
@@ -0,0 +1,20 @@
+-- { dg-do compile }
+-- { dg-options "-fdump-tree-original" }
+
+package body Aggr12 is
+
+  procedure Print (Data : String) is
+  begin
+    null;
+  end;
+
+  procedure Test is
+  begin
+    Print (Hair_Color_Type'Image (A.I1));
+    Print (Hair_Color_Type'Image (A.I2));
+  end;
+
+end Aggr12;
+
+-- { dg-final { scan-tree-dump-not "{.i1=0, .i2=2}" "original" } }
+-- { dg-final { cleanup-tree-dump "original" } }

diff --git a/gcc/testsuite/gnat.dg/aggr12.ads b/gcc/testsuite/gnat.dg/aggr12.ads
new file mode 100644 (file)
index 0000000..3208417
--- /dev/null
+++ b/gcc/testsuite/gnat.dg/aggr12.ads
@@ -0,0 +1,15 @@
+package Aggr12 is
+
+  type Hair_Color_Type is (Black, Brown, Blonde, Grey, White, Red);
+
+  type Rec is record
+    I1, I2 : Hair_Color_Type;
+  end record;
+
+  A : constant Rec := (Black, Blonde);
+
+  procedure Print (Data : String);
+
+  procedure Test;
+
+end Aggr12;

diff --git a/gcc/testsuite/gnat.dg/pack9.adb b/gcc/testsuite/gnat.dg/pack9.adb
index 232904ac1e183a87dcd62ea532d0795d8e43211a..705e0c1143ae6c700bd20932b4f4fa40ee944357 100644 (file)
--- a/gcc/testsuite/gnat.dg/pack9.adb
+++ b/gcc/testsuite/gnat.dg/pack9.adb
@@ -1,5 +1,5 @@
 -- { dg-do compile }
--- { dg-options "-O2 -gnatp -cargs -fdump-tree-optimized" }
+-- { dg-options "-O2 -gnatp -fdump-tree-optimized" }
 
 package body Pack9 is