Skip to content

R
riscv-gcc-1
Commit f9966234 by Arnaud Charlet
Options

[multiple changes] 

2014-02-25  Yannick Moy  <moy@adacore.com>

	* sem_ch3.adb, sem_ch5.adb, sem_ch9.adb, sem_prag.adb, sem_attr.adb,
	sem_ch6.adb: Remove useless references to SPARK RM in error messages.

2014-02-25  Hristian Kirtchev  <kirtchev@adacore.com>

	* sem_res.adb (Appears_In_Check): New routine.
	(Resolve_Entity_Name): Remove local variables Prev and
	Usage_OK. Par is now a constant. Remove the parent chain traversal
	as the placement of a volatile object with enabled property
	Async_Writers and/or Effective_Reads must appear immediately
	within a legal construct.

2014-02-25  Hristian Kirtchev  <kirtchev@adacore.com>

	* checks.adb (Apply_Selected_Range_Checks):
	Alphabetize local constants and variables. Add comments.
	Always insert a range check that requires runtime evaluation into
	the tree.

From-SVN: r208128
parent a6abfd78
Showing with 134 additions and 90 deletions
gcc/ada/ChangeLog
2014-02-25 Yannick Moy <moy@adacore.com>
* sem_ch3.adb, sem_ch5.adb, sem_ch9.adb, sem_prag.adb, sem_attr.adb,
sem_ch6.adb: Remove useless references to SPARK RM in error messages.
2014-02-25 Hristian Kirtchev <kirtchev@adacore.com>
* sem_res.adb (Appears_In_Check): New routine.
(Resolve_Entity_Name): Remove local variables Prev and
Usage_OK. Par is now a constant. Remove the parent chain traversal
as the placement of a volatile object with enabled property
Async_Writers and/or Effective_Reads must appear immediately
within a legal construct.
2014-02-25 Hristian Kirtchev <kirtchev@adacore.com>
* checks.adb (Apply_Selected_Range_Checks):
Alphabetize local constants and variables. Add comments.
Always insert a range check that requires runtime evaluation into
the tree.
2014-02-25 Robert Dewar <dewar@adacore.com>
* sem_attr.adb, sem_ch6.adb, par-ch3.adb: Minor reformatting.
......
gcc/ada/checks.adb
......@@ -3061,14 +3061,14 @@ package body Checks is
Source_Typ : Entity_Id;
Do_Static : Boolean)
is
Cond : Node_Id;
R_Result : Check_Result;
R_Cno : Node_Id;
Loc : constant Source_Ptr := Sloc (Ck_Node);
Checks_On : constant Boolean :=
(not Index_Checks_Suppressed (Target_Typ))
or else (not Range_Checks_Suppressed (Target_Typ));
not Index_Checks_Suppressed (Target_Typ)
or else not Range_Checks_Suppressed (Target_Typ);
Cond : Node_Id;
R_Cno : Node_Id;
R_Result : Check_Result;
begin
if not Expander_Active or else not Checks_On then
......@@ -3079,27 +3079,33 @@ package body Checks is
Selected_Range_Checks (Ck_Node, Target_Typ, Source_Typ, Empty);
for J in 1 .. 2 loop
R_Cno := R_Result (J);
exit when No (R_Cno);
-- If the item is a conditional raise of constraint error, then have
-- a look at what check is being performed and ???
-- The range check requires runtime evaluation. Depending on what its
-- triggering condition is, the check may be converted into a compile
-- time constraint check.
if Nkind (R_Cno) = N_Raise_Constraint_Error
and then Present (Condition (R_Cno))
then
Cond := Condition (R_Cno);
if not Has_Dynamic_Range_Check (Ck_Node) then
Insert_Action (Ck_Node, R_Cno);
-- Insert the range check before the related context. Note that
-- this action analyses the triggering condition.
if not Do_Static then
Set_Has_Dynamic_Range_Check (Ck_Node);
end if;
Insert_Action (Ck_Node, R_Cno);
-- This old code doesn't make sense, why is the context flagged as
-- requiring dynamic range checks now in the middle of generating
-- them ???
if not Do_Static then
Set_Has_Dynamic_Range_Check (Ck_Node);
end if;
-- Output a warning if the condition is known to be True
-- The triggering condition evaluates to True, the range check
-- can be converted into a compile time constraint check.
if Is_Entity_Name (Cond)
and then Entity (Cond) = Standard_True
......@@ -3130,11 +3136,15 @@ package body Checks is
-- on, then we want to delete the check, since it is not needed.
-- We do this by replacing the if statement by a null statement
-- Why are we even generating checks if checks are turned off ???
elsif Do_Static or else not Checks_On then
Remove_Warning_Messages (R_Cno);
Rewrite (R_Cno, Make_Null_Statement (Loc));
end if;
-- The range check raises Constrant_Error explicitly
else
Install_Static_Check (R_Cno, Loc);
end if;
......
gcc/ada/sem_attr.adb
......@@ -4480,11 +4480,12 @@ package body Sem_Attr is
-- Attribute 'Old appears in the condition of a contract case.
-- Emit an error since this is not a postcondition-like context.
-- (SPARK RM 6.1.3(2))
else
Error_Attr
("attribute % cannot appear in the condition of a contract "
& "case (SPARK 'R'M 6.1.3(2))", P);
("attribute % cannot appear in the condition "
& "of a contract case", P);
end if;
end Check_Use_In_Contract_Cases;
......
gcc/ada/sem_ch3.adb
......@@ -2992,14 +2992,13 @@ package body Sem_Ch3 is
-- A constant cannot be volatile. This check is only relevant when
-- SPARK_Mode is on as it is not standard Ada legality rule. Do not
-- flag internally-generated constants that map generic formals to
-- actuals in instantiations.
-- actuals in instantiations (SPARK RM 7.1.3(6)).
if SPARK_Mode = On
and then Is_SPARK_Volatile_Object (Obj_Id)
and then No (Corresponding_Generic_Association (Parent (Obj_Id)))
then
Error_Msg_N
("constant cannot be volatile (SPARK 'R'M 7.1.3(6))", Obj_Id);
Error_Msg_N ("constant cannot be volatile", Obj_Id);
end if;
else pragma Assert (Ekind (Obj_Id) = E_Variable);
......@@ -3010,13 +3009,14 @@ package body Sem_Ch3 is
if SPARK_Mode = On then
-- A non-volatile object cannot have volatile components
-- (SPARK RM 7.1.3(7)).
if not Is_SPARK_Volatile_Object (Obj_Id)
and then Has_Volatile_Component (Etype (Obj_Id))
then
Error_Msg_N
("non-volatile variable & cannot have volatile components "
& "(SPARK 'R'M 7.1.3(7))", Obj_Id);
("non-volatile variable & cannot have volatile components",
Obj_Id);
-- The declaration of a volatile object must appear at the library
-- level.
......@@ -18042,13 +18042,13 @@ package body Sem_Ch3 is
end if;
-- A discriminant cannot be volatile. This check is only relevant
-- when SPARK_Mode is on as it is not standard Ada legality rule.
-- when SPARK_Mode is on as it is not standard Ada legality rule
-- (SPARK RM 7.1.3(6)).
if SPARK_Mode = On
and then Is_SPARK_Volatile_Object (Defining_Identifier (Discr))
then
Error_Msg_N
("discriminant cannot be volatile (SPARK 'R'M 7.1.3(6))", Discr);
Error_Msg_N ("discriminant cannot be volatile", Discr);
end if;
Next (Discr);
......
gcc/ada/sem_ch5.adb
......@@ -1961,8 +1961,9 @@ package body Sem_Ch5 is
end if;
end if;
-- A loop parameter cannot be volatile. This check is peformed only when
-- SPARK_Mode is on as it is not a standard Ada legality check.
-- A loop parameter cannot be volatile. This check is peformed only
-- when SPARK_Mode is on as it is not a standard Ada legality check
-- (SPARK RM 7.1.3(6)).
-- Not clear whether this applies to element iterators, where the
-- cursor is not an explicit entity ???
......@@ -1971,8 +1972,7 @@ package body Sem_Ch5 is
and then not Of_Present (N)
and then Is_SPARK_Volatile_Object (Ent)
then
Error_Msg_N
("loop parameter cannot be volatile (SPARK 'R'M 7.1.3(6))", Ent);
Error_Msg_N ("loop parameter cannot be volatile", Ent);
end if;
end Analyze_Iterator_Specification;
......@@ -2613,12 +2613,12 @@ package body Sem_Ch5 is
end;
end if;
-- A loop parameter cannot be volatile. This check is peformed only when
-- SPARK_Mode is on as it is not a standard Ada legality check.
-- A loop parameter cannot be volatile. This check is peformed only
-- when SPARK_Mode is on as it is not a standard Ada legality check
-- (SPARK RM 7.1.3(6)).
if SPARK_Mode = On and then Is_SPARK_Volatile_Object (Id) then
Error_Msg_N
("loop parameter cannot be volatile (SPARK 'R'M 7.1.3(6))", Id);
Error_Msg_N ("loop parameter cannot be volatile", Id);
end if;
end Analyze_Loop_Parameter_Specification;
......
gcc/ada/sem_ch6.adb
......@@ -11418,18 +11418,19 @@ package body Sem_Ch6 is
and then Ekind_In (Scope (Formal), E_Function, E_Generic_Function)
then
-- A function cannot have a parameter of mode IN OUT or OUT
-- (SPARK RM 6.1).
if Ekind_In (Formal, E_In_Out_Parameter, E_Out_Parameter) then
Error_Msg_N
("function cannot have parameter of mode `OUT` or `IN OUT` "
& "(SPARK 'R'M 6.1)", Formal);
("function cannot have parameter of mode `OUT` or `IN OUT`",
Formal);
-- A function cannot have a volatile formal parameter
-- (SPARK RM 7.1.3(10)).
elsif Is_SPARK_Volatile_Object (Formal) then
Error_Msg_N
("function cannot have a volatile formal parameter "
& "(SPARK 'R'M 7.1.3(10))", Formal);
("function cannot have a volatile formal parameter", Formal);
end if;
end if;
......
gcc/ada/sem_ch9.adb
......@@ -3089,8 +3089,8 @@ package body Sem_Ch9 is
(Entity (Name (Trigger)))
then
Error_Msg_N
("triggering statement must be procedure_or_entry_call " &
"('R'M 9.7.2) or delay statement", Trigger);
("triggering statement must be procedure or entry call " &
"or delay statement", Trigger);
end if;
end if;
......
gcc/ada/sem_res.adb
......@@ -6434,12 +6434,42 @@ package body Sem_Res is
-- Used to resolve identifiers and expanded names
procedure Resolve_Entity_Name (N : Node_Id; Typ : Entity_Id) is
E : constant Entity_Id := Entity (N);
Par : Node_Id;
Prev : Node_Id;
function Appears_In_Check (Nod : Node_Id) return Boolean;
-- Denote whether an arbitrary node Nod appears in a check node
Usage_OK : Boolean := False;
-- Flag set when the use of a volatile object agrees with its context
----------------------
-- Appears_In_Check --
----------------------
function Appears_In_Check (Nod : Node_Id) return Boolean is
Par : Node_Id;
begin
-- Climb the parent chain looking for a check node
Par := Nod;
while Present (Par) loop
if Nkind (Par) in N_Raise_xxx_Error 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 Appears_In_Check;
-- Local variables
E : constant Entity_Id := Entity (N);
Par : constant Node_Id := Parent (N);
-- Start of processing for Resolve_Entity_Name
begin
-- If garbage from errors, set to Any_Type and return
......@@ -6555,62 +6585,43 @@ package body Sem_Res is
(Async_Writers_Enabled (E)
or else Effective_Reads_Enabled (E))
then
Par := Parent (N);
Prev := N;
while Present (Par) loop
-- The volatile object can appear on either side of an assignment
-- The volatile object can appear on either side of an assignment
if Nkind (Par) = N_Assignment_Statement then
Usage_OK := True;
exit;
-- The volatile object is part of the initialization expression of
-- another object. Ensure that the climb of the parent chain came
-- from the expression side and not from the name side.
elsif Nkind (Par) = N_Object_Declaration
and then Present (Expression (Par))
and then Prev = Expression (Par)
then
Usage_OK := True;
exit;
-- The volatile object appears as an actual parameter in a call to
-- an instance of Unchecked_Conversion whose result is renamed.
if Nkind (Par) = N_Assignment_Statement then
null;
elsif Nkind (Par) = N_Function_Call
and then Is_Unchecked_Conversion_Instance (Entity (Name (Par)))
and then Nkind (Parent (Par)) = N_Object_Renaming_Declaration
then
Usage_OK := True;
exit;
-- The volatile object is part of the initialization expression of
-- another object. Ensure that the climb of the parent chain came
-- from the expression side and not from the name side.
-- Assume that references to volatile objects that appear as
-- actual parameters in a procedure call are always legal. The
-- full legality check is done when the actuals are resolved.
elsif Nkind (Par) = N_Object_Declaration
and then Present (Expression (Par))
and then N = Expression (Par)
then
null;
elsif Nkind (Par) = N_Procedure_Call_Statement then
Usage_OK := True;
exit;
-- The volatile object appears as an actual parameter in a call to an
-- instance of Unchecked_Conversion whose result is renamed.
-- Allow references to volatile objects in various checks
elsif Nkind (Par) = N_Function_Call
and then Is_Unchecked_Conversion_Instance (Entity (Name (Par)))
and then Nkind (Parent (Par)) = N_Object_Renaming_Declaration
then
null;
elsif Nkind (Par) in N_Raise_xxx_Error then
Usage_OK := True;
exit;
-- Assume that references to volatile objects that appear as actual
-- parameters in a procedure call are always legal. The full legality
-- check is done when the actuals are resolved.
-- Prevent the search from going too far
elsif Nkind (Par) = N_Procedure_Call_Statement then
null;
elsif Is_Body_Or_Package_Declaration (Par) then
exit;
end if;
-- Allow references to volatile objects in various checks
Prev := Par;
Par := Parent (Par);
end loop;
elsif Appears_In_Check (Par) then
null;
if not Usage_OK then
else
Error_Msg_N
("volatile object cannot appear in this context "
& "(SPARK RM 7.1.3(13))", N);
......
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