From 84f80f5bf11215999e2e5461bcdd8a2adae2c127 Mon Sep 17 00:00:00 2001 From: Arnaud Charlet Date: Tue, 21 Jan 2014 17:20:24 +0100 Subject: [PATCH] [multiple changes] 2014-01-21 Robert Dewar * sem_ch3.adb, sem_prag.adb, sem_prag.ads, sem_ch12.adb, sem_res.adb, sem_ch6.adb, a-except-2005.adb: Minor reformatting. 2014-01-21 Ed Schonberg * exp_ch3.adb (Expand_N_Object_Declaration): When a class-wide object is declared, it is rewritten as a renaming of an dynamic expression that wraps the initial value. The renaming declaration is first given an internal name, to prevent collisions with the entity already declared, and then the name is modified to reflect the original one. the modification of the name must preserve the source location of the original, to prevent spurious errors when compiling with style checks if the declaration involves more than one entity. From-SVN: r206887 --- gcc/ada/ChangeLog | 17 +++++++++++++++++ gcc/ada/a-except-2005.adb | 4 ++++ gcc/ada/exp_ch3.adb | 5 ++++- gcc/ada/sem_ch12.adb | 3 +++ gcc/ada/sem_ch3.adb | 4 ++-- gcc/ada/sem_ch6.adb | 2 ++ gcc/ada/sem_prag.adb | 20 +++++++++----------- gcc/ada/sem_prag.ads | 4 ++-- gcc/ada/sem_res.adb | 16 ++++++++++------ 9 files changed, 53 insertions(+), 22 deletions(-) diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index 2fbcd79..6bb46e7 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,20 @@ +2014-01-21 Robert Dewar + + * sem_ch3.adb, sem_prag.adb, sem_prag.ads, sem_ch12.adb, sem_res.adb, + sem_ch6.adb, a-except-2005.adb: Minor reformatting. + +2014-01-21 Ed Schonberg + + * exp_ch3.adb (Expand_N_Object_Declaration): When a class-wide + object is declared, it is rewritten as a renaming of an dynamic + expression that wraps the initial value. The renaming declaration + is first given an internal name, to prevent collisions with the + entity already declared, and then the name is modified to reflect + the original one. the modification of the name must preserve + the source location of the original, to prevent spurious errors + when compiling with style checks if the declaration involves + more than one entity. + 2014-01-21 Hristian Kirtchev * aspects.adb Add entries for Async_Readers, Async_Writers, diff --git a/gcc/ada/a-except-2005.adb b/gcc/ada/a-except-2005.adb index b47f167..4fc60e5 100644 --- a/gcc/ada/a-except-2005.adb +++ b/gcc/ada/a-except-2005.adb @@ -991,11 +991,14 @@ package body Ada.Exceptions is Message : String := "") is X : constant EOA := Exception_Propagation.Allocate_Occurrence; + begin Exception_Data.Set_Exception_Msg (X, E, Message); + if not ZCX_By_Default then Abort_Defer.all; end if; + Complete_And_Propagate_Occurrence (X); end Raise_Exception_Always; @@ -1527,6 +1530,7 @@ package body Ada.Exceptions is if not ZCX_By_Default then Abort_Defer.all; end if; + Save_Occurrence (Excep.all, Get_Current_Excep.all.all); Excep.Machine_Occurrence := Saved_MO; Complete_And_Propagate_Occurrence (Excep); diff --git a/gcc/ada/exp_ch3.adb b/gcc/ada/exp_ch3.adb index 4a0fdf6..ce7f01f 100644 --- a/gcc/ada/exp_ch3.adb +++ b/gcc/ada/exp_ch3.adb @@ -5504,7 +5504,9 @@ package body Exp_Ch3 is -- itypes may have been generated already, and the full -- chain must be preserved for final freezing. Finally, -- preserve Comes_From_Source setting, so that debugging - -- and cross-referencing information is properly kept. + -- and cross-referencing information is properly kept, and + -- preserve source location, to prevent spurious errors when + -- entities are declared (they must have their own Sloc). declare New_Id : constant Entity_Id := Defining_Identifier (N); @@ -5519,6 +5521,7 @@ package body Exp_Ch3 is Set_Chars (Defining_Identifier (N), Chars (Def_Id)); Set_Homonym (Defining_Identifier (N), Homonym (Def_Id)); Set_Ekind (Defining_Identifier (N), Ekind (Def_Id)); + Set_Sloc (Defining_Identifier (N), Sloc (Def_Id)); Set_Comes_From_Source (Def_Id, False); Exchange_Entities (Defining_Identifier (N), Def_Id); diff --git a/gcc/ada/sem_ch12.adb b/gcc/ada/sem_ch12.adb index 1f030d9..0e2787f 100644 --- a/gcc/ada/sem_ch12.adb +++ b/gcc/ada/sem_ch12.adb @@ -9844,6 +9844,9 @@ package body Sem_Ch12 is -- it is not a standard Ada legality rule. A volatile object cannot be -- used as an actual in a generic instantiation. + -- Should mention that this is a rule for SPARK only, perhaps with + -- a SPARK RM reference??? + if GNATprove_Mode and then Is_Volatile_Object (Actual) then Error_Msg_N ("volatile object cannot act as actual in generic instantiation", diff --git a/gcc/ada/sem_ch3.adb b/gcc/ada/sem_ch3.adb index f40d1cf..99f85cb 100644 --- a/gcc/ada/sem_ch3.adb +++ b/gcc/ada/sem_ch3.adb @@ -93,8 +93,8 @@ package body Sem_Ch3 is procedure Analyze_Variable_Contract (Var_Id : Entity_Id); -- Analyze all delayed aspects chained on the contract of variable Var_Id - -- as if they appeared at the end of the declarative region. The aspects in - -- consideration are: + -- as if they appeared at the end of the declarative region. The aspects + -- to be considered are: -- Async_Readers -- Async_Writers -- Effective_Reads diff --git a/gcc/ada/sem_ch6.adb b/gcc/ada/sem_ch6.adb index 91efb6f..edf2c84 100644 --- a/gcc/ada/sem_ch6.adb +++ b/gcc/ada/sem_ch6.adb @@ -11121,6 +11121,8 @@ package body Sem_Ch6 is -- as it is not a standard Ada legality rule. A function cannot have -- a volatile formal parameter. + -- Need to mention this is a SPARK rule, with SPARK RM reference ??? + if GNATprove_Mode and then Is_Volatile_Object (Formal) and then Ekind_In (Scope (Formal), E_Function, E_Generic_Function) diff --git a/gcc/ada/sem_prag.adb b/gcc/ada/sem_prag.adb index 8148c46..54ef5f3 100644 --- a/gcc/ada/sem_prag.adb +++ b/gcc/ada/sem_prag.adb @@ -9526,8 +9526,7 @@ package body Sem_Prag is Null_Seen : Boolean := False; Pack_Id : Entity_Id; - -- The entity of the related package when pragma Abstract_State - -- appears. + -- Entity of related package when pragma Abstract_State appears procedure Analyze_Abstract_State (State : Node_Id); -- Verify the legality of a single state declaration. Create and @@ -9659,7 +9658,7 @@ package body Sem_Prag is begin -- The external property must be one of the predefined four - -- reader / writer choices. + -- reader/writer choices. if Nkind (Prop) /= N_Identifier or else not Nam_In (Chars (Prop), Name_Async_Readers, @@ -9721,8 +9720,7 @@ package body Sem_Prag is Analyze (Par_State); - -- The expression of option Part_Of must denote an abstract - -- state. + -- Expression of option Part_Of must denote abstract state if not Is_Entity_Name (Par_State) or else No (Entity (Par_State)) @@ -22527,34 +22525,34 @@ package body Sem_Prag is begin -- All properties enabled - if AR and then AW and then ER and then EW then + if AR and AW and ER and EW then null; -- Async_Readers + Effective_Writes -- Async_Readers + Async_Writers + Effective_Writes - elsif AR and then EW and then not ER then + elsif AR and EW and not ER then null; -- Async_Writers + Effective_Reads -- Async_Readers + Async_Writers + Effective_Reads - elsif AW and then ER and then not EW then + elsif AW and ER and not EW then null; -- Async_Readers + Async_Writers - elsif AR and then AW and then not ER and then not EW then + elsif AR and AW and not ER and not EW then null; -- Async_Readers - elsif AR and then not AW and then not ER and then not EW then + elsif AR and not AW and not ER and not EW then null; -- Async_Writers - elsif AW and then not AR and then not ER and then not EW then + elsif AW and not AR and not ER and not EW then null; else diff --git a/gcc/ada/sem_prag.ads b/gcc/ada/sem_prag.ads index bb57d99..6d1a01a 100644 --- a/gcc/ada/sem_prag.ads +++ b/gcc/ada/sem_prag.ads @@ -136,8 +136,8 @@ package Sem_Prag is EW : Boolean); -- Flags AR, AW, ER and EW denote the static values of external properties -- Async_Readers, Async_Writers, Effective_Reads and Effective_Writes. Item - -- is the related variable or state. Ensure the legality of the permutation - -- and if this is not the case, issue an error. + -- is the related variable or state. Ensure legality of the combination and + -- issue an error for an illegal combination. function Delay_Config_Pragma_Analyze (N : Node_Id) return Boolean; -- N is a pragma appearing in a configuration pragma file. Most such diff --git a/gcc/ada/sem_res.adb b/gcc/ada/sem_res.adb index e86ca31..c308ed7 100644 --- a/gcc/ada/sem_res.adb +++ b/gcc/ada/sem_res.adb @@ -4270,6 +4270,9 @@ package body Sem_Res is null; else + -- Error message should mention SPARK, and perhaps give + -- a SPARK RM reference ??? + Error_Msg_N ("volatile object cannot act as actual in a call", A); end if; @@ -5518,12 +5521,11 @@ package body Sem_Res is and then ((Is_Array_Type (Etype (Nam)) and then Covers (Typ, Component_Type (Etype (Nam)))) - or else (Is_Access_Type (Etype (Nam)) - and then Is_Array_Type (Designated_Type (Etype (Nam))) - and then - Covers - (Typ, - Component_Type (Designated_Type (Etype (Nam)))))) + or else + (Is_Access_Type (Etype (Nam)) + and then Is_Array_Type (Designated_Type (Etype (Nam))) + and then + Covers (Typ, Component_Type (Designated_Type (Etype (Nam)))))) then declare Index_Node : Node_Id; @@ -6518,6 +6520,8 @@ package body Sem_Res is Par := Parent (Par); end loop; + -- Message should mention SPARK, and perhaps SPARK RM ref ??? + if not Usage_OK then Error_Msg_N ("volatile object cannot appear in this context", N); end if; -- 2.7.4