Commit 84f80f5b by Arnaud Charlet

[multiple changes]

2014-01-21  Robert Dewar  <dewar@adacore.com>

	* 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  <schonberg@adacore.com>

	* 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
parent 6c3c671e
2014-01-21 Robert Dewar <dewar@adacore.com>
* 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 <schonberg@adacore.com>
* 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 <kirtchev@adacore.com> 2014-01-21 Hristian Kirtchev <kirtchev@adacore.com>
* aspects.adb Add entries for Async_Readers, Async_Writers, * aspects.adb Add entries for Async_Readers, Async_Writers,
......
...@@ -991,11 +991,14 @@ package body Ada.Exceptions is ...@@ -991,11 +991,14 @@ package body Ada.Exceptions is
Message : String := "") Message : String := "")
is is
X : constant EOA := Exception_Propagation.Allocate_Occurrence; X : constant EOA := Exception_Propagation.Allocate_Occurrence;
begin begin
Exception_Data.Set_Exception_Msg (X, E, Message); Exception_Data.Set_Exception_Msg (X, E, Message);
if not ZCX_By_Default then if not ZCX_By_Default then
Abort_Defer.all; Abort_Defer.all;
end if; end if;
Complete_And_Propagate_Occurrence (X); Complete_And_Propagate_Occurrence (X);
end Raise_Exception_Always; end Raise_Exception_Always;
...@@ -1527,6 +1530,7 @@ package body Ada.Exceptions is ...@@ -1527,6 +1530,7 @@ package body Ada.Exceptions is
if not ZCX_By_Default then if not ZCX_By_Default then
Abort_Defer.all; Abort_Defer.all;
end if; end if;
Save_Occurrence (Excep.all, Get_Current_Excep.all.all); Save_Occurrence (Excep.all, Get_Current_Excep.all.all);
Excep.Machine_Occurrence := Saved_MO; Excep.Machine_Occurrence := Saved_MO;
Complete_And_Propagate_Occurrence (Excep); Complete_And_Propagate_Occurrence (Excep);
......
...@@ -5504,7 +5504,9 @@ package body Exp_Ch3 is ...@@ -5504,7 +5504,9 @@ package body Exp_Ch3 is
-- itypes may have been generated already, and the full -- itypes may have been generated already, and the full
-- chain must be preserved for final freezing. Finally, -- chain must be preserved for final freezing. Finally,
-- preserve Comes_From_Source setting, so that debugging -- 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 declare
New_Id : constant Entity_Id := Defining_Identifier (N); New_Id : constant Entity_Id := Defining_Identifier (N);
...@@ -5519,6 +5521,7 @@ package body Exp_Ch3 is ...@@ -5519,6 +5521,7 @@ package body Exp_Ch3 is
Set_Chars (Defining_Identifier (N), Chars (Def_Id)); Set_Chars (Defining_Identifier (N), Chars (Def_Id));
Set_Homonym (Defining_Identifier (N), Homonym (Def_Id)); Set_Homonym (Defining_Identifier (N), Homonym (Def_Id));
Set_Ekind (Defining_Identifier (N), Ekind (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); Set_Comes_From_Source (Def_Id, False);
Exchange_Entities (Defining_Identifier (N), Def_Id); Exchange_Entities (Defining_Identifier (N), Def_Id);
......
...@@ -9844,6 +9844,9 @@ package body Sem_Ch12 is ...@@ -9844,6 +9844,9 @@ package body Sem_Ch12 is
-- it is not a standard Ada legality rule. A volatile object cannot be -- it is not a standard Ada legality rule. A volatile object cannot be
-- used as an actual in a generic instantiation. -- 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 if GNATprove_Mode and then Is_Volatile_Object (Actual) then
Error_Msg_N Error_Msg_N
("volatile object cannot act as actual in generic instantiation", ("volatile object cannot act as actual in generic instantiation",
......
...@@ -93,8 +93,8 @@ package body Sem_Ch3 is ...@@ -93,8 +93,8 @@ package body Sem_Ch3 is
procedure Analyze_Variable_Contract (Var_Id : Entity_Id); procedure Analyze_Variable_Contract (Var_Id : Entity_Id);
-- Analyze all delayed aspects chained on the contract of variable Var_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 -- as if they appeared at the end of the declarative region. The aspects
-- consideration are: -- to be considered are:
-- Async_Readers -- Async_Readers
-- Async_Writers -- Async_Writers
-- Effective_Reads -- Effective_Reads
......
...@@ -11121,6 +11121,8 @@ package body Sem_Ch6 is ...@@ -11121,6 +11121,8 @@ package body Sem_Ch6 is
-- as it is not a standard Ada legality rule. A function cannot have -- as it is not a standard Ada legality rule. A function cannot have
-- a volatile formal parameter. -- a volatile formal parameter.
-- Need to mention this is a SPARK rule, with SPARK RM reference ???
if GNATprove_Mode if GNATprove_Mode
and then Is_Volatile_Object (Formal) and then Is_Volatile_Object (Formal)
and then Ekind_In (Scope (Formal), E_Function, E_Generic_Function) and then Ekind_In (Scope (Formal), E_Function, E_Generic_Function)
......
...@@ -9526,8 +9526,7 @@ package body Sem_Prag is ...@@ -9526,8 +9526,7 @@ package body Sem_Prag is
Null_Seen : Boolean := False; Null_Seen : Boolean := False;
Pack_Id : Entity_Id; Pack_Id : Entity_Id;
-- The entity of the related package when pragma Abstract_State -- Entity of related package when pragma Abstract_State appears
-- appears.
procedure Analyze_Abstract_State (State : Node_Id); procedure Analyze_Abstract_State (State : Node_Id);
-- Verify the legality of a single state declaration. Create and -- Verify the legality of a single state declaration. Create and
...@@ -9659,7 +9658,7 @@ package body Sem_Prag is ...@@ -9659,7 +9658,7 @@ package body Sem_Prag is
begin begin
-- The external property must be one of the predefined four -- The external property must be one of the predefined four
-- reader / writer choices. -- reader/writer choices.
if Nkind (Prop) /= N_Identifier if Nkind (Prop) /= N_Identifier
or else not Nam_In (Chars (Prop), Name_Async_Readers, or else not Nam_In (Chars (Prop), Name_Async_Readers,
...@@ -9721,8 +9720,7 @@ package body Sem_Prag is ...@@ -9721,8 +9720,7 @@ package body Sem_Prag is
Analyze (Par_State); Analyze (Par_State);
-- The expression of option Part_Of must denote an abstract -- Expression of option Part_Of must denote abstract state
-- state.
if not Is_Entity_Name (Par_State) if not Is_Entity_Name (Par_State)
or else No (Entity (Par_State)) or else No (Entity (Par_State))
...@@ -22527,34 +22525,34 @@ package body Sem_Prag is ...@@ -22527,34 +22525,34 @@ package body Sem_Prag is
begin begin
-- All properties enabled -- 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; null;
-- Async_Readers + Effective_Writes -- Async_Readers + Effective_Writes
-- Async_Readers + Async_Writers + 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; null;
-- Async_Writers + Effective_Reads -- Async_Writers + Effective_Reads
-- Async_Readers + 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; null;
-- Async_Readers + Async_Writers -- 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; null;
-- Async_Readers -- 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; null;
-- Async_Writers -- 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; null;
else else
......
...@@ -136,8 +136,8 @@ package Sem_Prag is ...@@ -136,8 +136,8 @@ package Sem_Prag is
EW : Boolean); EW : Boolean);
-- Flags AR, AW, ER and EW denote the static values of external properties -- Flags AR, AW, ER and EW denote the static values of external properties
-- Async_Readers, Async_Writers, Effective_Reads and Effective_Writes. Item -- Async_Readers, Async_Writers, Effective_Reads and Effective_Writes. Item
-- is the related variable or state. Ensure the legality of the permutation -- is the related variable or state. Ensure legality of the combination and
-- and if this is not the case, issue an error. -- issue an error for an illegal combination.
function Delay_Config_Pragma_Analyze (N : Node_Id) return Boolean; function Delay_Config_Pragma_Analyze (N : Node_Id) return Boolean;
-- N is a pragma appearing in a configuration pragma file. Most such -- N is a pragma appearing in a configuration pragma file. Most such
......
...@@ -4270,6 +4270,9 @@ package body Sem_Res is ...@@ -4270,6 +4270,9 @@ package body Sem_Res is
null; null;
else else
-- Error message should mention SPARK, and perhaps give
-- a SPARK RM reference ???
Error_Msg_N Error_Msg_N
("volatile object cannot act as actual in a call", A); ("volatile object cannot act as actual in a call", A);
end if; end if;
...@@ -5518,12 +5521,11 @@ package body Sem_Res is ...@@ -5518,12 +5521,11 @@ package body Sem_Res is
and then and then
((Is_Array_Type (Etype (Nam)) ((Is_Array_Type (Etype (Nam))
and then Covers (Typ, Component_Type (Etype (Nam)))) and then Covers (Typ, Component_Type (Etype (Nam))))
or else (Is_Access_Type (Etype (Nam)) or else
and then Is_Array_Type (Designated_Type (Etype (Nam))) (Is_Access_Type (Etype (Nam))
and then and then Is_Array_Type (Designated_Type (Etype (Nam)))
Covers and then
(Typ, Covers (Typ, Component_Type (Designated_Type (Etype (Nam))))))
Component_Type (Designated_Type (Etype (Nam))))))
then then
declare declare
Index_Node : Node_Id; Index_Node : Node_Id;
...@@ -6518,6 +6520,8 @@ package body Sem_Res is ...@@ -6518,6 +6520,8 @@ package body Sem_Res is
Par := Parent (Par); Par := Parent (Par);
end loop; end loop;
-- Message should mention SPARK, and perhaps SPARK RM ref ???
if not Usage_OK then if not Usage_OK then
Error_Msg_N ("volatile object cannot appear in this context", N); Error_Msg_N ("volatile object cannot appear in this context", N);
end if; end if;
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment