From 4bfb35fdce6264b9b711fe70474746fed9dcdfb1 Mon Sep 17 00:00:00 2001 From: Arnaud Charlet Date: Thu, 16 Jun 2016 12:29:00 +0200 Subject: [PATCH] [multiple changes] 2016-06-16 Ed Schonberg * sem_util.adb (May_Be_Lvalue): An actual in an unexpanded attribute reference 'Read is an assignment and must be considered a modification of the object. 2016-06-16 Gary Dismukes * einfo.adb: Minor editorial. From-SVN: r237517 --- gcc/ada/ChangeLog | 10 ++++++++++ gcc/ada/einfo.adb | 2 +- gcc/ada/sem_util.adb | 44 ++++++++++++++++++++++++++++---------------- 3 files changed, 39 insertions(+), 17 deletions(-) diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index 10ccf7ef46a..6cf68c482eb 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,13 @@ +2016-06-16 Ed Schonberg + + * sem_util.adb (May_Be_Lvalue): An actual in an unexpanded + attribute reference 'Read is an assignment and must be considered + a modification of the object. + +2016-06-16 Gary Dismukes + + * einfo.adb: Minor editorial. + 2016-06-16 Ed Schonberg * sem_prag.adb (Overridden_Ancestor): Clean up code to use diff --git a/gcc/ada/einfo.adb b/gcc/ada/einfo.adb index 39cfe35c302..d0d230215f6 100644 --- a/gcc/ada/einfo.adb +++ b/gcc/ada/einfo.adb @@ -8567,7 +8567,7 @@ package body Einfo is Subp_Id : Entity_Id; begin - -- Once set this attribute it cannot be reset + -- Once set, this attribute cannot be reset if No (V) then pragma Assert (No (Default_Init_Cond_Procedure (Id))); diff --git a/gcc/ada/sem_util.adb b/gcc/ada/sem_util.adb index 43b08912504..9e2aba4dab2 100644 --- a/gcc/ada/sem_util.adb +++ b/gcc/ada/sem_util.adb @@ -1231,12 +1231,16 @@ package body Sem_Util is pragma Assert (Has_Default_Init_Cond (Typ)); pragma Assert (Present (Prag)); - -- No action needed if the spec was not built or if the body was - -- already built. + -- Nothing to do if the slec was not built. This occurs when the + -- expression of the Default_Initial_Condition is missing or is + -- null. - if No (Proc_Id) - or else - Present (Corresponding_Body (Unit_Declaration_Node (Proc_Id))) + if No (Proc_Id) then + return; + + -- Nothing to do if the body was already built + + elsif Present (Corresponding_Body (Unit_Declaration_Node (Proc_Id))) then return; end if; @@ -1368,6 +1372,7 @@ package body Sem_Util is Save_Ghost_Mode : constant Ghost_Mode_Type := Ghost_Mode; + Args : List_Id; Proc_Id : Entity_Id; begin @@ -1378,20 +1383,23 @@ package body Sem_Util is pragma Assert (Has_Default_Init_Cond (Typ)); pragma Assert (Present (Prag)); + Args := Pragma_Argument_Associations (Prag); + -- Nothing to do if default initial condition procedure already built if Present (Default_Init_Cond_Procedure (Typ)) then return; - -- The procedure must not be generated when DIC has one of these two - -- forms: 1. Default_Initial_Condition => null - -- 2. Default_Initial_Condition + -- Nothing to do if the default initial condition appears without an + -- expression. - elsif No (Pragma_Argument_Associations (Prag)) - or else - Nkind (Get_Pragma_Arg (First (Pragma_Argument_Associations (Prag)))) - = N_Null - then + elsif No (Args) then + return; + + -- Nothing to do if the expression of the default initial condition is + -- null. + + elsif Nkind (Get_Pragma_Arg (First (Args))) = N_Null then return; end if; @@ -15744,11 +15752,15 @@ package body Sem_Util is return N = Name (P); -- Test prefix of component or attribute. Note that the prefix of an - -- explicit or implicit dereference cannot be an l-value. + -- explicit or implicit dereference cannot be an l-value. In the case + -- of a 'Read attribute, the reference can be an actual in the + -- argument list of the attribute. when N_Attribute_Reference => - return N = Prefix (P) - and then Name_Implies_Lvalue_Prefix (Attribute_Name (P)); + return (N = Prefix (P) + and then Name_Implies_Lvalue_Prefix (Attribute_Name (P))) + or else + Attribute_Name (P) = Name_Read; -- For an expanded name, the name is an lvalue if the expanded name -- is an lvalue, but the prefix is never an lvalue, since it is just -- 2.30.2