From 7c949aad408a5361d9bbea8f7174aecaa1a03444 Mon Sep 17 00:00:00 2001 From: charlet Date: Fri, 10 Jul 2009 09:21:34 +0000 Subject: [PATCH] 2009-07-10 Thomas Quinot * 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 * 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. git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@149465 138bc75d-0d04-0410-961f-82ee72b054a4 --- gcc/ada/ChangeLog | 14 ++++++++++++++ gcc/ada/exp_aggr.adb | 33 ++++++++++++++++++++++++++++++++- gcc/ada/exp_disp.adb | 15 +++++++++++++++ 3 files changed, 61 insertions(+), 1 deletion(-) diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index c40a243..39c8080 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,17 @@ +2009-07-10 Thomas Quinot + + * 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 + + * 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 * 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 db9e1d7..3d0c2d1 100644 --- 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 5c5534b..54f6691 100644 --- 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 -- 2.7.4