[Ada] Expansion of selected components that denote discriminants

[Arnaud Charlet]

In general a selected component that denotes a discriminant can be replaced
with the corresponding discriminant value if it comes from a constrained type.
However if the discriminant is not static and is an expression with implicit
control, such as a short-circuit operation, copying the value may lead to
anomalies in code coverage.  Nevertheless, if the reference occurs within the
initialization code generated for an object declaration (typically because of
a change of representation in a derived type) the discriminant value must always
be copied from the type, because it may denote the still uninitialized component
of the object itself.

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

2011-08-03  Ed Schonberg  <schonberg@adacore.com>

	* exp_ch4.adb (Expand_N_Selected_Component): If the discriminant value
	is an integer literal it is always safe to replace the reference. In
	addition, if the reference appears in the generated code for an object
	declaration it is necessary to copy because otherwise the reference
	might be to the uninitilized value of the discriminant of the object
	itself.

-------------- next part --------------
Index: exp_ch4.adb
===================================================================
--- exp_ch4.adb	(revision 177233)
+++ exp_ch4.adb	(working copy)
@@ -7594,6 +7594,18 @@
       --  unless the context of an assignment can provide size information.
       --  Don't we have a general routine that does this???
 
+      function Is_Subtype_Declaration return Boolean;
+      --  The replacement of a discriminant reference by its value is required
+      --  if this is part of the initialization of an temporary generated by
+      --  a change of representation. This shows up as the construction of a
+      --  discriminant constraint for a subtype declared at the same point as
+      --  the entity in the prefix of the selected component.
+      --  We recognize this case when the context of the reference is:
+      --
+      --   subtype ST is T(Obj.D);
+      --
+      --   The entity for Obj comes from source, and ST has the same sloc.
+
       -----------------------
       -- In_Left_Hand_Side --
       -----------------------
@@ -7607,6 +7619,21 @@
                      and then In_Left_Hand_Side (Parent (Comp)));
       end In_Left_Hand_Side;
 
+      -----------------------------
+      --  Is_Subtype_Declaration --
+      -----------------------------
+
+      function Is_Subtype_Declaration return Boolean is
+         Par : constant Node_Id := Parent (N);
+
+      begin
+         return
+           Nkind (Par) = N_Index_Or_Discriminant_Constraint
+             and then Nkind (Parent (Parent (Par))) = N_Subtype_Declaration
+             and then Comes_From_Source (Entity (Prefix (N)))
+             and then Sloc (Par) = Sloc (Entity (Prefix (N)));
+      end Is_Subtype_Declaration;
+
    --  Start of processing for Expand_N_Selected_Component
 
    begin
@@ -7730,9 +7757,19 @@
                   --  AND THEN was copied, causing problems for coverage
                   --  analysis tools).
 
+                  --  However, if the reference is part of the initialization
+                  --  code generated for an object declaration, we must use
+                  --  the discriminant value from the subtype constraint,
+                  --  because the selected component may be a reference to the
+                  --  object being initialized, whose discriminant is not yet
+                  --  set. This only happens in complex cases involving changes
+                  --  or representation.
+
                   if Disc = Entity (Selector_Name (N))
                     and then (Is_Entity_Name (Dval)
-                               or else Is_Static_Expression (Dval))
+                              or else Nkind (Dval) = N_Integer_Literal
+                              or else Is_Subtype_Declaration
+                              or else Is_Static_Expression (Dval))
                   then
                      --  Here we have the matching discriminant. Check for
                      --  the case of a discriminant of a component that is