Patchwork [Ada] Discriminant references in aggregates

login
register
mail settings
Submitter Arnaud Charlet
Date June 22, 2010, 3:37 p.m.
Message ID <20100622153740.GA4048@adacore.com>
Download mbox | patch
Permalink /patch/56524/
State New
Headers show

Comments

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
      private
         The_Data : GNAT.Sockets.Sock_Addr_Type :=
           (GNAT.Sockets.Family_Inet,
            GNAT.Sockets.No_Inet_Addr,
            Port_Num);
   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.

Patch

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))
          then
             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;