[Ada] Discriminant references in aggregates

Message ID 20100622153740.GA4048@adacore.com
State New
Headers show

Commit Message

Arnaud Charlet June 22, 2010, 3:37 p.m.
This change fixes two unrelated issues in the handling of references to
discriminants appearing in aggregates. If such a reference comes from
a default expression, it denotes a discriminal of the type of the aggregate,
and must be rewritten into a selected component prefixed by the entity
for the aggregate object. But if the reference is to a discriminal of some
other type (case of the aggregate being in a protected body), it must
be left untouched at this point.

When the rewriting does occur, it must use the Lhs parameter of
Build_Record_Aggregate_Code, not Obj, which is present only in the
variable declaration and dynamic allocation cases.

The following compilation must be accepted quietly:

$ gcc -c prot_discriminal_in_aggr.adb
with GNAT.Sockets;
package Prot_Discriminal_In_Aggr is
   protected type Prot (Port_Num : GNAT.Sockets.Port_Type) is
         The_Data : GNAT.Sockets.Sock_Addr_Type :=
   end Prot;
end Prot_Discriminal_In_Aggr;

package body Prot_Discriminal_In_Aggr is
   protected body Prot is
   end Prot;
end Prot_Discriminal_In_Aggr;

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

2010-06-22  Thomas Quinot  <quinot@adacore.com>

	* exp_aggr.adb (Rewrite_Discriminant): Rewriting must occur only for an
	expression referring to a discriminal of the type of the aggregate (not
	a discriminal of some other unrelated type), and the prefix in the
	generated selected component must come from Lhs, not Obj.


Index: exp_aggr.adb
--- exp_aggr.adb	(revision 161194)
+++ exp_aggr.adb	(working copy)
@@ -93,7 +93,7 @@  package body Exp_Aggr is
    function Has_Default_Init_Comps (N : Node_Id) return Boolean;
    --  N is an aggregate (record or array). Checks the presence of default
-   --  initialization (<>) in any component (Ada 2005: AI-287)
+   --  initialization (<>) in any component (Ada 2005: AI-287).
    function Is_Static_Dispatch_Table_Aggregate (N : Node_Id) return Boolean;
    --  Returns true if N is an aggregate used to initialize the components
@@ -2431,10 +2431,12 @@  package body Exp_Aggr is
            and then Present (Entity (Expr))
            and then Ekind (Entity (Expr)) = E_In_Parameter
            and then Present (Discriminal_Link (Entity (Expr)))
+           and then Scope (Discriminal_Link (Entity (Expr)))
+                      = Base_Type (Etype (N))
             Rewrite (Expr,
               Make_Selected_Component (Loc,
-                Prefix        => New_Occurrence_Of (Obj, Loc),
+                Prefix        => New_Copy_Tree (Lhs),
                 Selector_Name => Make_Identifier (Loc, Chars (Expr))));
          end if;
          return OK;