[multiple changes]

2009-07-10  Thomas Quinot  <quinot@adacore.com>

	* exp_disp.adb (Make_Disp_Asynchronous_Select_Body,
	Make_Disp_Conditional_Select_Body,
	Make_Disp_Timed_Select_Body): For the case of a type that is neither an
	interface nor a concurrent type, the primitive body is empty. Generate
	a null statement so that it remains well formed.

2009-07-10  Ed Schonberg  <schonberg@adacore.com>

	* exp_aggr.adb (Build_Record_Aggr_Code): If the type has discriminants,
	replace references to them in defaulted component expressions with
	references to the values of the discriminants of the target object.

From-SVN: r149465

diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index c40a2434af5f41a862f2baef1bc3a99663002082..39c808011289ee63d32b1311d7a993e55c232c30 100644 (file)
--- a/gcc/ada/ChangeLog
+++ b/gcc/ada/ChangeLog
@@ -1,3 +1,17 @@
+2009-07-10  Thomas Quinot  <quinot@adacore.com>
+
+       * exp_disp.adb (Make_Disp_Asynchronous_Select_Body,
+       Make_Disp_Conditional_Select_Body,
+       Make_Disp_Timed_Select_Body): For the case of a type that is neither an
+       interface nor a concurrent type, the primitive body is empty. Generate
+       a null statement so that it remains well formed.
+
+2009-07-10  Ed Schonberg  <schonberg@adacore.com>
+
+       * exp_aggr.adb (Build_Record_Aggr_Code): If the type has discriminants,
+       replace references to them in defaulted component expressions with
+       references to the values of the discriminants of the target object.
+
 2009-07-10  Ed Schonberg  <schonberg@adacore.com>
 
        * sem_prag.adb (Analyze pragma, case Task_Name): Analyze argument of

diff --git a/gcc/ada/exp_aggr.adb b/gcc/ada/exp_aggr.adb
index db9e1d7784c5e02d7d3f59ba9a84a916229b308a..3d0c2d14e04f8d04f13186d8764934ac88ec1822 100644 (file)
--- a/gcc/ada/exp_aggr.adb
+++ b/gcc/ada/exp_aggr.adb
@@ -2379,11 +2379,35 @@ package body Exp_Aggr is
          end if;
       end Gen_Ctrl_Actions_For_Aggr;
 
+      function Rewrite_Discriminant (Expr : Node_Id) return Traverse_Result;
+      --  If the default expression of a component mentions a discriminant of
+      --  the type, it has to be rewritten as the discriminant of the target
+      --  object.
+
       function Replace_Type (Expr : Node_Id) return Traverse_Result;
       --  If the aggregate contains a self-reference, traverse each expression
       --  to replace a possible self-reference with a reference to the proper
       --  component of the target of the assignment.
 
+      --------------------------
+      -- Rewrite_Discriminant --
+      --------------------------
+
+      function Rewrite_Discriminant (Expr : Node_Id) return Traverse_Result is
+      begin
+         if Nkind (Expr) = N_Identifier
+           and then Present (Entity (Expr))
+           and then Ekind (Entity (Expr)) = E_In_Parameter
+           and then Present (Discriminal_Link (Entity (Expr)))
+         then
+            Rewrite (Expr,
+              Make_Selected_Component (Loc,
+                Prefix => New_Occurrence_Of (Obj, Loc),
+                Selector_Name => Make_Identifier (Loc, Chars (Expr))));
+         end if;
+         return OK;
+      end Rewrite_Discriminant;
+
       ------------------
       -- Replace_Type --
       ------------------
@@ -2430,6 +2454,9 @@ package body Exp_Aggr is
       procedure Replace_Self_Reference is
         new Traverse_Proc (Replace_Type);
 
+      procedure Replace_Discriminants is
+        new Traverse_Proc (Rewrite_Discriminant);
+
    --  Start of processing for Build_Record_Aggr_Code
 
    begin
@@ -3019,10 +3046,14 @@ package body Exp_Aggr is
             --  Expr_Q is not delayed aggregate
 
             else
+               if Has_Discriminants (Typ) then
+                  Replace_Discriminants (Expr_Q);
+               end if;
+
                Instr :=
                  Make_OK_Assignment_Statement (Loc,
                    Name       => Comp_Expr,
-                   Expression => Expression (Comp));
+                   Expression =>  Expr_Q);
 
                Set_No_Ctrl_Actions (Instr);
                Append_To (L, Instr);

diff --git a/gcc/ada/exp_disp.adb b/gcc/ada/exp_disp.adb
index 5c5534b7a3ef606f870fb8f3ef2a6469c0c6db27..54f66919cb874206eca2c9d1d2614fdf7ea5e2ab 100644 (file)
--- a/gcc/ada/exp_disp.adb
+++ b/gcc/ada/exp_disp.adb
@@ -1831,6 +1831,11 @@ package body Exp_Disp is
                       RTE (RE_Asynchronous_Call), Loc),
                     Make_Identifier (Loc, Name_uF))));    --  status flag
          end if;
+
+      else
+         --  Ensure that the statements list is non-empty
+
+         Append_To (Stmts, Make_Null_Statement (Loc));
       end if;
 
       return
@@ -2199,6 +2204,11 @@ package body Exp_Disp is
                       RTE (RE_Conditional_Call), Loc),
                     Make_Identifier (Loc, Name_uF))));    --  status flag
          end if;
+
+      else
+         --  Ensure that the statements list is non-empty
+
+         Append_To (Stmts, Make_Null_Statement (Loc));
       end if;
 
       return
@@ -3022,6 +3032,11 @@ package body Exp_Disp is
                     Make_Identifier (Loc, Name_uM),       --  delay mode
                     Make_Identifier (Loc, Name_uF))));    --  status flag
          end if;
+
+      else
+         --  Ensure that the statements list is non-empty
+
+         Append_To (Stmts, Make_Null_Statement (Loc));
       end if;
 
       return