Commit 5073ad7a by Arnaud Charlet

[multiple changes]

2014-11-20  Robert Dewar  <dewar@adacore.com>

	* gnatcmd.adb, sem_ch6.adb, exp_dist.adb: Minor reformatting.
	* sem_util.adb (Bad_Unordered_Enumeration_Reference): Suppress
	warning (return False) for generic type.

2014-11-20  Hristian Kirtchev  <kirtchev@adacore.com>

	* sem_res.adb (Appears_In_Check): Removed.
	(Is_OK_Volatile_Context): Rewrite the checks which verify that
	an effectively volatile object subject to enabled properties
	Async_Writers or Effective_Reads appears in a suitable context to
	properly recognize a procedure call.
	(Within_Check): New routine.
	(Within_Procedure_Call): New routine.

From-SVN: r217848
parent bc5e261c
2014-11-20 Robert Dewar <dewar@adacore.com>
* gnatcmd.adb, sem_ch6.adb, exp_dist.adb: Minor reformatting.
* sem_util.adb (Bad_Unordered_Enumeration_Reference): Suppress
warning (return False) for generic type.
2014-11-20 Hristian Kirtchev <kirtchev@adacore.com>
* sem_res.adb (Appears_In_Check): Removed.
(Is_OK_Volatile_Context): Rewrite the checks which verify that
an effectively volatile object subject to enabled properties
Async_Writers or Effective_Reads appears in a suitable context to
properly recognize a procedure call.
(Within_Check): New routine.
(Within_Procedure_Call): New routine.
2014-11-20 Ed Schonberg <schonberg@adacore.com> 2014-11-20 Ed Schonberg <schonberg@adacore.com>
* sem_ch6.adb: Improve better error message. * sem_ch6.adb: Improve better error message.
......
...@@ -9802,14 +9802,10 @@ package body Exp_Dist is ...@@ -9802,14 +9802,10 @@ package body Exp_Dist is
declare declare
Discriminant : constant Entity_Id := Discriminant : constant Entity_Id :=
Make_Selected_Component (Loc, Make_Selected_Component (Loc,
Prefix => Prefix => Expr_Formal,
Expr_Formal, Selector_Name => Chars (Disc));
Selector_Name =>
Chars (Disc));
begin begin
Set_Etype (Discriminant, Etype (Disc)); Set_Etype (Discriminant, Etype (Disc));
Append_To (Elements, Append_To (Elements,
Make_Component_Association (Loc, Make_Component_Association (Loc,
Choices => New_List ( Choices => New_List (
...@@ -10031,7 +10027,8 @@ package body Exp_Dist is ...@@ -10031,7 +10027,8 @@ package body Exp_Dist is
if Is_Limited_Type (Typ) then if Is_Limited_Type (Typ) then
Append_To (Stms, Append_To (Stms,
Make_Implicit_If_Statement (Typ, Make_Implicit_If_Statement (Typ,
Condition => New_Occurrence_Of (Cstr_Formal, Loc), Condition =>
New_Occurrence_Of (Cstr_Formal, Loc),
Then_Statements => New_List ( Then_Statements => New_List (
Stream_Call (Name_Write)), Stream_Call (Name_Write)),
Else_Statements => New_List ( Else_Statements => New_List (
...@@ -10039,6 +10036,7 @@ package body Exp_Dist is ...@@ -10039,6 +10036,7 @@ package body Exp_Dist is
elsif Transmit_As_Unconstrained (Typ) then elsif Transmit_As_Unconstrained (Typ) then
Append_To (Stms, Stream_Call (Name_Output)); Append_To (Stms, Stream_Call (Name_Output));
else else
Append_To (Stms, Stream_Call (Name_Write)); Append_To (Stms, Stream_Call (Name_Write));
end if; end if;
...@@ -10049,7 +10047,8 @@ package body Exp_Dist is ...@@ -10049,7 +10047,8 @@ package body Exp_Dist is
Append_To (Stms, Append_To (Stms,
Make_Procedure_Call_Statement (Loc, Make_Procedure_Call_Statement (Loc,
Name => New_Occurrence_Of (RTE (RE_BS_To_Any), Loc), Name =>
New_Occurrence_Of (RTE (RE_BS_To_Any), Loc),
Parameter_Associations => New_List ( Parameter_Associations => New_List (
New_Occurrence_Of (Strm, Loc), New_Occurrence_Of (Strm, Loc),
New_Occurrence_Of (Any, Loc)))); New_Occurrence_Of (Any, Loc))));
...@@ -10059,7 +10058,8 @@ package body Exp_Dist is ...@@ -10059,7 +10058,8 @@ package body Exp_Dist is
Append_To (Stms, Append_To (Stms,
Make_Procedure_Call_Statement (Loc, Make_Procedure_Call_Statement (Loc,
Name => New_Occurrence_Of (RTE (RE_Release_Buffer), Loc), Name =>
New_Occurrence_Of (RTE (RE_Release_Buffer), Loc),
Parameter_Associations => New_List ( Parameter_Associations => New_List (
New_Occurrence_Of (Strm, Loc)))); New_Occurrence_Of (Strm, Loc))));
end; end;
...@@ -10070,7 +10070,8 @@ package body Exp_Dist is ...@@ -10070,7 +10070,8 @@ package body Exp_Dist is
if Present (Result_TC) then if Present (Result_TC) then
Append_To (Stms, Append_To (Stms,
Make_Procedure_Call_Statement (Loc, Make_Procedure_Call_Statement (Loc,
Name => New_Occurrence_Of (RTE (RE_Set_TC), Loc), Name =>
New_Occurrence_Of (RTE (RE_Set_TC), Loc),
Parameter_Associations => New_List ( Parameter_Associations => New_List (
New_Occurrence_Of (Any, Loc), New_Occurrence_Of (Any, Loc),
Result_TC))); Result_TC)));
......
...@@ -489,8 +489,7 @@ procedure GNATCmd is ...@@ -489,8 +489,7 @@ procedure GNATCmd is
for Index in 1 .. Last_Switches.Last loop for Index in 1 .. Last_Switches.Last loop
if Last_Switches.Table (Index) (1) /= '-' if Last_Switches.Table (Index) (1) /= '-'
or else or else (Last_Switches.Table (Index).all'Length > 7
(Last_Switches.Table (Index).all'Length > 7
and then Last_Switches.Table (Index) (1 .. 7) = "-files=") and then Last_Switches.Table (Index) (1 .. 7) = "-files=")
then then
Add_Sources := False; Add_Sources := False;
...@@ -507,9 +506,7 @@ procedure GNATCmd is ...@@ -507,9 +506,7 @@ procedure GNATCmd is
-- put the list of sources in it. For gnatstack create a temporary -- put the list of sources in it. For gnatstack create a temporary
-- file with the list of .ci files. -- file with the list of .ci files.
if The_Command = List or else if The_Command = List or else The_Command = Stack then
The_Command = Stack
then
Tempdir.Create_Temp_File (FD, Temp_File_Name); Tempdir.Create_Temp_File (FD, Temp_File_Name);
Last_Switches.Increment_Last; Last_Switches.Increment_Last;
Last_Switches.Table (Last_Switches.Last) := Last_Switches.Table (Last_Switches.Last) :=
...@@ -1937,6 +1934,7 @@ begin ...@@ -1937,6 +1934,7 @@ begin
-- a configuration pragmas file, if necessary. -- a configuration pragmas file, if necessary.
if The_Command = Sync then if The_Command = Sync then
-- If there are switches in package Compiler, put them in the -- If there are switches in package Compiler, put them in the
-- Carg_Switches table. -- Carg_Switches table.
......
...@@ -331,8 +331,8 @@ package body Sem_Ch6 is ...@@ -331,8 +331,8 @@ package body Sem_Ch6 is
-- which case the redeclaration is illegal. -- which case the redeclaration is illegal.
if Present (Prev) if Present (Prev)
and then Nkind (Original_Node (Unit_Declaration_Node (Prev))) and then Nkind (Original_Node (Unit_Declaration_Node (Prev))) =
= N_Expression_Function N_Expression_Function
then then
Error_Msg_Sloc := Sloc (Prev); Error_Msg_Sloc := Sloc (Prev);
Error_Msg_N ("& conflicts with declaration#", Def_Id); Error_Msg_N ("& conflicts with declaration#", Def_Id);
......
...@@ -6897,9 +6897,6 @@ package body Sem_Res is ...@@ -6897,9 +6897,6 @@ package body Sem_Res is
-- Used to resolve identifiers and expanded names -- Used to resolve identifiers and expanded names
procedure Resolve_Entity_Name (N : Node_Id; Typ : Entity_Id) is procedure Resolve_Entity_Name (N : Node_Id; Typ : Entity_Id) is
function Appears_In_Check (Nod : Node_Id) return Boolean;
-- Denote whether an arbitrary node Nod appears in a check node
function Is_OK_Volatile_Context function Is_OK_Volatile_Context
(Context : Node_Id; (Context : Node_Id;
Obj_Ref : Node_Id) return Boolean; Obj_Ref : Node_Id) return Boolean;
...@@ -6907,11 +6904,25 @@ package body Sem_Res is ...@@ -6907,11 +6904,25 @@ package body Sem_Res is
-- (as defined in SPARK RM 7.1.3(13)) where volatile reference Obj_Ref -- (as defined in SPARK RM 7.1.3(13)) where volatile reference Obj_Ref
-- can safely reside. -- can safely reside.
---------------------- ----------------------------
-- Appears_In_Check -- -- Is_OK_Volatile_Context --
---------------------- ----------------------------
function Is_OK_Volatile_Context
(Context : Node_Id;
Obj_Ref : Node_Id) return Boolean
is
function Within_Check (Nod : Node_Id) return Boolean;
-- Determine whether an arbitrary node appears in a check node
function Within_Procedure_Call (Nod : Node_Id) return Boolean;
-- Determine whether an arbitrary node appears in a procedure call
------------------
-- Within_Check --
------------------
function Appears_In_Check (Nod : Node_Id) return Boolean is function Within_Check (Nod : Node_Id) return Boolean is
Par : Node_Id; Par : Node_Id;
begin begin
...@@ -6932,16 +6943,37 @@ package body Sem_Res is ...@@ -6932,16 +6943,37 @@ package body Sem_Res is
end loop; end loop;
return False; return False;
end Appears_In_Check; end Within_Check;
---------------------------- ---------------------------
-- Is_OK_Volatile_Context -- -- Within_Procedure_Call --
---------------------------- ---------------------------
function Within_Procedure_Call (Nod : Node_Id) return Boolean is
Par : Node_Id;
begin
-- Climb the parent chain looking for a procedure call
Par := Nod;
while Present (Par) loop
if Nkind (Par) = N_Procedure_Call_Statement then
return True;
-- Prevent the search from going too far
elsif Is_Body_Or_Package_Declaration (Par) then
exit;
end if;
Par := Parent (Par);
end loop;
return False;
end Within_Procedure_Call;
-- Start of processing for Is_OK_Volatile_Context
function Is_OK_Volatile_Context
(Context : Node_Id;
Obj_Ref : Node_Id) return Boolean
is
begin begin
-- The volatile object appears on either side of an assignment -- The volatile object appears on either side of an assignment
...@@ -6996,9 +7028,19 @@ package body Sem_Res is ...@@ -6996,9 +7028,19 @@ package body Sem_Res is
-- Allow references to volatile objects in various checks. This is -- Allow references to volatile objects in various checks. This is
-- not a direct SPARK 2014 requirement. -- not a direct SPARK 2014 requirement.
elsif Appears_In_Check (Context) then elsif Within_Check (Context) then
return True;
-- Assume that references to effectively volatile objects that appear
-- as actual parameters in a procedure call are always legal. A full
-- legality check is done when the actuals are resolved.
elsif Within_Procedure_Call (Context) then
return True; return True;
-- Otherwise the context is not suitable for an effectively volatile
-- object.
else else
return False; return False;
end if; end if;
...@@ -7140,13 +7182,6 @@ package body Sem_Res is ...@@ -7140,13 +7182,6 @@ package body Sem_Res is
if Is_OK_Volatile_Context (Par, N) then if Is_OK_Volatile_Context (Par, N) then
null; null;
-- Assume that references to effectively volatile objects that appear
-- as actual parameters in a procedure call are always legal. A full
-- legality check is done when the actuals are resolved.
elsif Nkind (Par) = N_Procedure_Call_Statement then
null;
-- Otherwise the context causes a side effect with respect to the -- Otherwise the context causes a side effect with respect to the
-- effectively volatile object. -- effectively volatile object.
......
...@@ -897,8 +897,9 @@ package body Sem_Util is ...@@ -897,8 +897,9 @@ package body Sem_Util is
is is
begin begin
return Is_Enumeration_Type (T) return Is_Enumeration_Type (T)
and then Comes_From_Source (N)
and then Warn_On_Unordered_Enumeration_Type and then Warn_On_Unordered_Enumeration_Type
and then not Is_Generic_Type (T)
and then Comes_From_Source (N)
and then not Has_Pragma_Ordered (T) and then not Has_Pragma_Ordered (T)
and then not In_Same_Extended_Unit (N, T); and then not In_Same_Extended_Unit (N, T);
end Bad_Unordered_Enumeration_Reference; end Bad_Unordered_Enumeration_Reference;
......
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