[Ada] Heap objects constrained by their initial value

Message ID 20100614081650.GA12383@adacore.com
State New
Headers show

Commit Message

Arnaud Charlet June 14, 2010, 8:16 a.m.
If a heap object has an indefinite subtype, it is constrained by its initial
value, and when it is the target of an assignment a discriminant check must
be performed on the right-hand side. This patch extends this check to the
case where the object is a renaming of a heap object. Previously the check
only applied to explicit dereferences of heap objects.

The following, compiled in 2005 mode, must yield at execution:

   raised CONSTRAINT_ERROR : check.adb:15 discriminant check failed

proredure Check  is
   type T (D: Boolean := True) is record
      I: Integer;
   end record;

   type T_Access is access T;

   P_V: constant T_Access := new T;
   V: T renames P_V.all;

   P_W: constant T_Access := new T'(False, 0);
   W: T renames P_W.all;

   V := W;   --  must raise constraint error.
end Check;

Tested on x86_64-pc-linux-gnu, committed on trunk

2010-06-14  Ed Schonberg  <schonberg@adacore.com>

	* checks.adb (Apply_Discriminant_Check): If the target of the
	assignment is a renaming of a heap object, create constrained type for
	it to apply check.


Index: checks.adb
--- checks.adb	(revision 160705)
+++ checks.adb	(working copy)
@@ -1084,6 +1084,11 @@  package body Checks is
       Cond      : Node_Id;
       T_Typ     : Entity_Id;
+      function Denotes_Explicit_Dereference (Obj : Node_Id) return Boolean;
+      --  A heap object with an indefinite subtype is constrained by its
+      --  initial value, and assigning to it requires a constraint_check.
+      --  The target may be an explicit dereference, or a renaming of one.
       function Is_Aliased_Unconstrained_Component return Boolean;
       --  It is possible for an aliased component to have a nominal
       --  unconstrained subtype (through instantiation). If this is a
@@ -1091,6 +1096,21 @@  package body Checks is
       --  in an initialization, the check must be suppressed. This unusual
       --  situation requires a predicate of its own.
+      ----------------------------------
+      -- Denotes_Explicit_Dereference --
+      ----------------------------------
+      function Denotes_Explicit_Dereference (Obj : Node_Id) return Boolean is
+      begin
+         return
+           Nkind (Obj) = N_Explicit_Dereference
+             or else
+               (Is_Entity_Name (Obj)
+                 and then Present (Renamed_Object (Entity (Obj)))
+                and then Nkind (Renamed_Object (Entity (Obj)))
+                  = N_Explicit_Dereference);
+      end Denotes_Explicit_Dereference;
       -- Is_Aliased_Unconstrained_Component --
@@ -1164,7 +1184,7 @@  package body Checks is
       --  Ada 2005 (AI-363): For Ada 2005, we limit the building of the actual
       --  subtype to the parameter and dereference cases, since other aliased
       --  objects are unconstrained (unless the nominal subtype is explicitly
-      --  constrained). (But we also need to test for renamings???)
+      --  constrained).
       if Present (Lhs)
         and then (Present (Param_Entity (Lhs))
@@ -1174,7 +1194,7 @@  package body Checks is
                              and then not Is_Aliased_Unconstrained_Component)
                    or else (Ada_Version >= Ada_05
                              and then not Is_Constrained (T_Typ)
-                             and then Nkind (Lhs) = N_Explicit_Dereference
+                             and then Denotes_Explicit_Dereference (Lhs)
                              and then Nkind (Original_Node (Lhs)) /=