+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.
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 (
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 (
elsif Transmit_As_Unconstrained (Typ) then
Append_To (Stms, Stream_Call (Name_Output));
+
else
Append_To (Stms, Stream_Call (Name_Write));
end if;
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))));
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;
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)));
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;
-- 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) :=
-- 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.
-- 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;
-- 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);
-- 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;
-- (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
-- 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;
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.
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;
projects / gcc.git / commitdiff