OSDN Git Service

PR ada/53766
authorebotcazou <ebotcazou@138bc75d-0d04-0410-961f-82ee72b054a4>
Sat, 15 Dec 2012 18:16:28 +0000 (18:16 +0000)
committerebotcazou <ebotcazou@138bc75d-0d04-0410-961f-82ee72b054a4>
Sat, 15 Dec 2012 18:16:28 +0000 (18:16 +0000)
Backport from mainline

2012-07-17  Hristian Kirtchev  <kirtchev@adacore.com>

* exp_attr.adb (Expand_N_Attribute_Reference): Add local variables Attr
and Conversion_Added.  Add local constant Typ.
Retrieve the original attribute after the arithmetic check
machinery has modified the node. Add a conversion to the target
type when the prefix of attribute Max_Size_In_Storage_Elements
is a controlled type.

git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/branches/gcc-4_7-branch@194522 138bc75d-0d04-0410-961f-82ee72b054a4

gcc/ada/ChangeLog
gcc/ada/exp_attr.adb
gcc/testsuite/ChangeLog
gcc/testsuite/gnat.dg/controlled7.adb [new file with mode: 0644]
gcc/testsuite/gnat.dg/controlled7.ads [new file with mode: 0644]

index 61c28a0..06fdd53 100644 (file)
@@ -1,3 +1,17 @@
+2012-12-15  Eric Botcazou  <ebotcazou@adacore.com>
+
+       PR ada/53766
+       Backport from mainline
+
+       2012-07-17  Hristian Kirtchev  <kirtchev@adacore.com>
+
+       * exp_attr.adb (Expand_N_Attribute_Reference): Add local variables Attr
+       and Conversion_Added.  Add local constant Typ.
+       Retrieve the original attribute after the arithmetic check
+       machinery has modified the node. Add a conversion to the target
+       type when the prefix of attribute Max_Size_In_Storage_Elements
+       is a controlled type.
+
 2012-12-01  John David Anglin  <dave.anglin@nrc-cnrc.gc.ca>
 
        PR ada/52110
index 4e0c60c..b2f53ec 100644 (file)
@@ -2996,9 +2996,26 @@ package body Exp_Attr is
       -- Max_Size_In_Storage_Elements --
       ----------------------------------
 
-      when Attribute_Max_Size_In_Storage_Elements =>
+      when Attribute_Max_Size_In_Storage_Elements => declare
+         Typ  : constant Entity_Id := Etype (N);
+         Attr : Node_Id;
+
+         Conversion_Added : Boolean := False;
+         --  A flag which tracks whether the original attribute has been
+         --  wrapped inside a type conversion.
+
+      begin
          Apply_Universal_Integer_Attribute_Checks (N);
 
+         --  The universal integer check may sometimes add a type conversion,
+         --  retrieve the original attribute reference from the expression.
+
+         Attr := N;
+         if Nkind (Attr) = N_Type_Conversion then
+            Attr := Expression (Attr);
+            Conversion_Added := True;
+         end if;
+
          --  Heap-allocated controlled objects contain two extra pointers which
          --  are not part of the actual type. Transform the attribute reference
          --  into a runtime expression to add the size of the hidden header.
@@ -3007,20 +3024,20 @@ package body Exp_Attr is
          --  two pointers are already present in the type.
 
          if VM_Target = No_VM
-           and then Nkind (N) = N_Attribute_Reference
+           and then Nkind (Attr) = N_Attribute_Reference
            and then Needs_Finalization (Ptyp)
-           and then not Header_Size_Added (N)
+           and then not Header_Size_Added (Attr)
          then
-            Set_Header_Size_Added (N);
+            Set_Header_Size_Added (Attr);
 
             --  Generate:
             --    P'Max_Size_In_Storage_Elements +
             --      Universal_Integer
             --        (Header_Size_With_Padding (Ptyp'Alignment))
 
-            Rewrite (N,
+            Rewrite (Attr,
               Make_Op_Add (Loc,
-                Left_Opnd  => Relocate_Node (N),
+                Left_Opnd  => Relocate_Node (Attr),
                 Right_Opnd =>
                   Convert_To (Universal_Integer,
                     Make_Function_Call (Loc,
@@ -3034,9 +3051,19 @@ package body Exp_Attr is
                             New_Reference_To (Ptyp, Loc),
                           Attribute_Name => Name_Alignment))))));
 
-            Analyze (N);
+            --  Add a conversion to the target type
+
+            if not Conversion_Added then
+               Rewrite (Attr,
+                 Make_Type_Conversion (Loc,
+                   Subtype_Mark => New_Reference_To (Typ, Loc),
+                   Expression   => Relocate_Node (Attr)));
+            end if;
+
+            Analyze (Attr);
             return;
          end if;
+      end;
 
       --------------------
       -- Mechanism_Code --
index 72ea814..7f11821 100644 (file)
@@ -1,3 +1,8 @@
+2012-12-15  Eric Botcazou  <ebotcazou@adacore.com>
+
+       PR ada/53766
+       * gnat.dg/controlled7.ad[sb]: New test.
+
 2012-12-11  Jakub Jelinek  <jakub@redhat.com>
 
        PR c++/55643
diff --git a/gcc/testsuite/gnat.dg/controlled7.adb b/gcc/testsuite/gnat.dg/controlled7.adb
new file mode 100644 (file)
index 0000000..bdcf67a
--- /dev/null
@@ -0,0 +1,18 @@
+-- PR ada/53766
+-- Reported by Duncan Sands <baldrick@gcc.gnu.org>
+
+-- { dg-do compile }
+-- { dg-options "-gnatp" }
+
+with Ada.Strings.Unbounded; use Ada.Strings.Unbounded;
+
+package body Controlled7 is
+
+   procedure Proc (Offset : Storage_Offset) is
+   begin
+      if Offset + Unbounded_String'Max_Size_In_Storage_Elements >= 16 then
+         raise Program_Error;
+      end if;
+   end;
+
+end Controlled7;
diff --git a/gcc/testsuite/gnat.dg/controlled7.ads b/gcc/testsuite/gnat.dg/controlled7.ads
new file mode 100644 (file)
index 0000000..672a8e7
--- /dev/null
@@ -0,0 +1,7 @@
+with System.Storage_Elements; use System.Storage_Elements;
+
+package Controlled7 is
+
+  procedure Proc (Offset : Storage_Offset);
+
+end Controlled7;