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>
* sem_ch6.adb: Improve better error message.
......
......@@ -9801,15 +9801,11 @@ package body Exp_Dist is
while Present (Disc) loop
declare
Discriminant : constant Entity_Id :=
Make_Selected_Component (Loc,
Prefix =>
Expr_Formal,
Selector_Name =>
Chars (Disc));
Make_Selected_Component (Loc,
Prefix => Expr_Formal,
Selector_Name => Chars (Disc));
begin
Set_Etype (Discriminant, Etype (Disc));
Append_To (Elements,
Make_Component_Association (Loc,
Choices => New_List (
......@@ -10031,7 +10027,8 @@ package body Exp_Dist is
if Is_Limited_Type (Typ) then
Append_To (Stms,
Make_Implicit_If_Statement (Typ,
Condition => New_Occurrence_Of (Cstr_Formal, Loc),
Condition =>
New_Occurrence_Of (Cstr_Formal, Loc),
Then_Statements => New_List (
Stream_Call (Name_Write)),
Else_Statements => New_List (
......@@ -10039,6 +10036,7 @@ package body Exp_Dist is
elsif Transmit_As_Unconstrained (Typ) then
Append_To (Stms, Stream_Call (Name_Output));
else
Append_To (Stms, Stream_Call (Name_Write));
end if;
......@@ -10049,7 +10047,8 @@ package body Exp_Dist is
Append_To (Stms,
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 (
New_Occurrence_Of (Strm, Loc),
New_Occurrence_Of (Any, Loc))));
......@@ -10059,7 +10058,8 @@ package body Exp_Dist is
Append_To (Stms,
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 (
New_Occurrence_Of (Strm, Loc))));
end;
......@@ -10070,7 +10070,8 @@ package body Exp_Dist is
if Present (Result_TC) then
Append_To (Stms,
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 (
New_Occurrence_Of (Any, Loc),
Result_TC)));
......
......@@ -489,9 +489,8 @@ procedure GNATCmd is
for Index in 1 .. Last_Switches.Last loop
if Last_Switches.Table (Index) (1) /= '-'
or else
(Last_Switches.Table (Index).all'Length > 7
and then Last_Switches.Table (Index) (1 .. 7) = "-files=")
or else (Last_Switches.Table (Index).all'Length > 7
and then Last_Switches.Table (Index) (1 .. 7) = "-files=")
then
Add_Sources := False;
exit;
......@@ -507,9 +506,7 @@ procedure GNATCmd is
-- put the list of sources in it. For gnatstack create a temporary
-- file with the list of .ci files.
if The_Command = List or else
The_Command = Stack
then
if The_Command = List or else The_Command = Stack then
Tempdir.Create_Temp_File (FD, Temp_File_Name);
Last_Switches.Increment_Last;
Last_Switches.Table (Last_Switches.Last) :=
......@@ -1937,6 +1934,7 @@ begin
-- a configuration pragmas file, if necessary.
if The_Command = Sync then
-- If there are switches in package Compiler, put them in the
-- Carg_Switches table.
......@@ -2155,8 +2153,8 @@ begin
-- on the command line, call tool with all the sources of the main
-- project.
if The_Command = Sync or else
The_Command = List or else
if The_Command = Sync or else
The_Command = List or else
The_Command = Stack
then
Check_Files;
......
......@@ -331,8 +331,8 @@ package body Sem_Ch6 is
-- which case the redeclaration is illegal.
if Present (Prev)
and then Nkind (Original_Node (Unit_Declaration_Node (Prev)))
= N_Expression_Function
and then Nkind (Original_Node (Unit_Declaration_Node (Prev))) =
N_Expression_Function
then
Error_Msg_Sloc := Sloc (Prev);
Error_Msg_N ("& conflicts with declaration#", Def_Id);
......
......@@ -6897,9 +6897,6 @@ package body Sem_Res is
-- Used to resolve identifiers and expanded names
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
(Context : Node_Id;
Obj_Ref : Node_Id) return Boolean;
......@@ -6907,41 +6904,76 @@ package body Sem_Res is
-- (as defined in SPARK RM 7.1.3(13)) where volatile reference Obj_Ref
-- can safely reside.
----------------------
-- Appears_In_Check --
----------------------
----------------------------
-- Is_OK_Volatile_Context --
----------------------------
function Appears_In_Check (Nod : Node_Id) return Boolean is
Par : Node_Id;
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
begin
-- Climb the parent chain looking for a check node
function Within_Procedure_Call (Nod : Node_Id) return Boolean;
-- Determine whether an arbitrary node appears in a procedure call
Par := Nod;
while Present (Par) loop
if Nkind (Par) in N_Raise_xxx_Error then
return True;
------------------
-- Within_Check --
------------------
-- Prevent the search from going too far
function Within_Check (Nod : Node_Id) return Boolean is
Par : Node_Id;
elsif Is_Body_Or_Package_Declaration (Par) then
exit;
end if;
begin
-- Climb the parent chain looking for a check node
Par := Parent (Par);
end loop;
Par := Nod;
while Present (Par) loop
if Nkind (Par) in N_Raise_xxx_Error then
return True;
return False;
end Appears_In_Check;
-- Prevent the search from going too far
----------------------------
-- Is_OK_Volatile_Context --
----------------------------
elsif Is_Body_Or_Package_Declaration (Par) then
exit;
end if;
Par := Parent (Par);
end loop;
return False;
end Within_Check;
---------------------------
-- 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
-- The volatile object appears on either side of an assignment
......@@ -6996,9 +7028,19 @@ package body Sem_Res is
-- Allow references to volatile objects in various checks. This is
-- 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;
-- Otherwise the context is not suitable for an effectively volatile
-- object.
else
return False;
end if;
......@@ -7140,13 +7182,6 @@ package body Sem_Res is
if Is_OK_Volatile_Context (Par, N) then
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
-- effectively volatile object.
......
......@@ -897,8 +897,9 @@ package body Sem_Util is
is
begin
return Is_Enumeration_Type (T)
and then Comes_From_Source (N)
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 In_Same_Extended_Unit (N, T);
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