Skip to content

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

[multiple changes] 

2013-04-25  Hristian Kirtchev  <kirtchev@adacore.com>

	* einfo.adb (Set_Abstract_States): The attribute now applies
	to generic packages.
	* sem_ch4.adb (Referenced): Moved to sem_util.
	* sem_ch7.adb (Unit_Requires_Body): A [generic] package with
	a non-null abstract state needs a body.
	* sem_prag.adb (Analyze_Depends_In_Decl_Part): Update the calls
	to Collect_Subprogram_Inputs_Outputs.
	(Analyze_Global_Item): Verify the proper usage of an item with mode
	In_Out or Output relative to the enclosing context.
	(Analyze_Pragma): Abstract_State can now be applied to a generic
	package. Do not reset the Analyzed flag for pragmas Depends and Global
	as this is not needed.
	(Appears_In): Moved to library level.
	(Check_Mode_Restiction_In_Enclosing_Context): New routine.
	(Collect_Subprogram_Inputs_Outputs): Moved to library level. Add
	formal parameters Subp_Id, Subp_Inputs, Subp_Outputs and Global
	seen along with comments on usage.
	* sem_util.ads, sem_util.adb (Referenced): New routine.

2013-04-25  Hristian Kirtchev  <kirtchev@adacore.com>

	* sem_ch6.adb (Expand_Contract_Cases): Generate
	detailed error messages only when switch -gnateE is in effect.

2013-04-25  Yannick Moy  <moy@adacore.com>

	* sem_attr.adb (Analyze_Attribute): Do not issue
	an error for a possibly misplaced 'Result or 'Old attribute when
	analyzing the aspect.

From-SVN: r198290
parent d1ec4768
Showing with 113 additions and 57 deletions
gcc/ada/ChangeLog
2013-04-25 Hristian Kirtchev <kirtchev@adacore.com>
* einfo.adb (Set_Abstract_States): The attribute now applies
to generic packages.
* sem_ch4.adb (Referenced): Moved to sem_util.
* sem_ch7.adb (Unit_Requires_Body): A [generic] package with
a non-null abstract state needs a body.
* sem_prag.adb (Analyze_Depends_In_Decl_Part): Update the calls
to Collect_Subprogram_Inputs_Outputs.
(Analyze_Global_Item): Verify the proper usage of an item with mode
In_Out or Output relative to the enclosing context.
(Analyze_Pragma): Abstract_State can now be applied to a generic
package. Do not reset the Analyzed flag for pragmas Depends and Global
as this is not needed.
(Appears_In): Moved to library level.
(Check_Mode_Restiction_In_Enclosing_Context): New routine.
(Collect_Subprogram_Inputs_Outputs): Moved to library level. Add
formal parameters Subp_Id, Subp_Inputs, Subp_Outputs and Global
seen along with comments on usage.
* sem_util.ads, sem_util.adb (Referenced): New routine.
2013-04-25 Hristian Kirtchev <kirtchev@adacore.com>
* sem_ch6.adb (Expand_Contract_Cases): Generate
detailed error messages only when switch -gnateE is in effect.
2013-04-25 Yannick Moy <moy@adacore.com>
* sem_attr.adb (Analyze_Attribute): Do not issue
an error for a possibly misplaced 'Result or 'Old attribute when
analyzing the aspect.
2013-04-25 Robert Dewar <dewar@adacore.com>
* sem_ch12.adb, sem_util.adb, sem_ch4.adb: Minor reformatting.
......
gcc/ada/einfo.adb
......@@ -3233,7 +3233,7 @@ package body Einfo is
procedure Set_Abstract_States (Id : E; V : L) is
begin
pragma Assert (Ekind (Id) = E_Package);
pragma Assert (Ekind_In (Id, E_Generic_Package, E_Package));
Set_Elist25 (Id, V);
end Set_Abstract_States;
......
gcc/ada/sem_attr.adb
......@@ -4222,15 +4222,24 @@ package body Sem_Attr is
-- Check in postcondition, Test_Case or Contract_Cases
Prag := N;
while not Nkind_In (Prag, N_Pragma,
N_Function_Specification,
N_Procedure_Specification,
N_Subprogram_Body)
while Present (Prag)
and then not Nkind_In (Prag, N_Pragma,
N_Function_Specification,
N_Procedure_Specification,
N_Aspect_Specification,
N_Subprogram_Body)
loop
Prag := Parent (Prag);
end loop;
if Nkind (Prag) /= N_Pragma then
-- In ASIS mode, the aspect itself is analyzed, in addition to the
-- corresponding pragma. Do not issue errors when analyzing the
-- aspect.
if Nkind (Prag) = N_Aspect_Specification then
null;
elsif Nkind (Prag) /= N_Pragma then
Error_Attr ("% attribute can only appear in postcondition", P);
elsif Get_Pragma_Id (Prag) = Pragma_Test_Case then
......@@ -4241,7 +4250,7 @@ package body Sem_Attr is
begin
Arg := N;
while Arg /= Prag and Arg /= Arg_Ens loop
while Arg /= Prag and then Arg /= Arg_Ens loop
Arg := Parent (Arg);
end loop;
......@@ -4258,7 +4267,7 @@ package body Sem_Attr is
begin
Arg := N;
while Arg /= Prag and Parent (Parent (Arg)) /= Aggr loop
while Arg /= Prag and then Parent (Parent (Arg)) /= Aggr loop
Arg := Parent (Arg);
end loop;
......@@ -4628,14 +4637,23 @@ package body Sem_Attr is
-- Check in postcondition, Test_Case or Contract_Cases of function
Prag := N;
while not Nkind_In (Prag, N_Pragma,
N_Function_Specification,
N_Subprogram_Body)
while Present (Prag)
and then not Nkind_In (Prag, N_Pragma,
N_Function_Specification,
N_Aspect_Specification,
N_Subprogram_Body)
loop
Prag := Parent (Prag);
end loop;
if Nkind (Prag) /= N_Pragma then
-- In ASIS mode, the aspect itself is analyzed, in addition to the
-- corresponding pragma. Do not issue errors when analyzing the
-- aspect.
if Nkind (Prag) = N_Aspect_Specification then
null;
elsif Nkind (Prag) /= N_Pragma then
Error_Attr
("% attribute can only appear in postcondition of function",
P);
......@@ -4648,7 +4666,7 @@ package body Sem_Attr is
begin
Arg := N;
while Arg /= Prag and Arg /= Arg_Ens loop
while Arg /= Prag and then Arg /= Arg_Ens loop
Arg := Parent (Arg);
end loop;
......@@ -4665,7 +4683,7 @@ package body Sem_Attr is
begin
Arg := N;
while Arg /= Prag and Parent (Parent (Arg)) /= Aggr loop
while Arg /= Prag and then Parent (Parent (Arg)) /= Aggr loop
Arg := Parent (Arg);
end loop;
......
gcc/ada/sem_ch4.adb
......@@ -3510,10 +3510,6 @@ package body Sem_Ch4 is
-- Determine whether if expression If_Expr lacks an else part or if it
-- has one, it evaluates to True.
function Referenced (Id : Entity_Id; Expr : Node_Id) return Boolean;
-- Determine whether entity Id is referenced within expression Expr
-- This should be moved to sem_util ???
--------------------
-- Is_Empty_Range --
--------------------
......@@ -3565,43 +3561,6 @@ package body Sem_Ch4 is
and then Is_True (Expr_Value (Else_Expr)));
end No_Else_Or_Trivial_True;
----------------
-- Referenced --
----------------
function Referenced (Id : Entity_Id; Expr : Node_Id) return Boolean is
Seen : Boolean := False;
function Is_Reference (N : Node_Id) return Traverse_Result;
-- Determine whether node N denotes a reference to Id. If this is the
-- case, set global flag Seen to True and stop the traversal.
------------------
-- Is_Reference --
------------------
function Is_Reference (N : Node_Id) return Traverse_Result is
begin
if Is_Entity_Name (N)
and then Present (Entity (N))
and then Entity (N) = Id
then
Seen := True;
return Abandon;
else
return OK;
end if;
end Is_Reference;
procedure Inspect_Expression is new Traverse_Proc (Is_Reference);
-- Start of processing for Referenced
begin
Inspect_Expression (Expr);
return Seen;
end Referenced;
-- Local variables
Cond : constant Node_Id := Condition (N);
......
gcc/ada/sem_ch6.adb
......@@ -11655,7 +11655,7 @@ package body Sem_Ch6 is
-- Check possible overlap between a case guard and "others"
if Multiple_PCs then
if Multiple_PCs and then Exception_Extra_Info then
Case_Guard_Error
(Decls => Error_Decls,
Flag => Others_Flag,
......@@ -11695,7 +11695,7 @@ package body Sem_Ch6 is
-- Check whether this case guard overlaps with another case
-- guard.
if Multiple_PCs then
if Multiple_PCs and then Exception_Extra_Info then
Case_Guard_Error
(Decls => Error_Decls,
Flag => Flag,
......
gcc/ada/sem_ch7.adb
......@@ -2615,6 +2615,16 @@ package body Sem_Ch7 is
return True;
end if;
end;
-- A [generic] package that introduces at least one non-null abstract
-- state requires completion. A null abstract state always appears as
-- the sole element of the state list.
elsif Ekind_In (P, E_Generic_Package, E_Package)
and then Present (Abstract_States (P))
and then not Is_Null_State (Node (First_Elmt (Abstract_States (P))))
then
return True;
end if;
-- Otherwise search entity chain for entity requiring completion
......
gcc/ada/sem_util.adb
......@@ -12964,6 +12964,40 @@ package body Sem_Util is
Set_Sloc (Endl, Loc);
end Process_End_Label;
----------------
-- Referenced --
----------------
function Referenced (Id : Entity_Id; Expr : Node_Id) return Boolean is
Seen : Boolean := False;
function Is_Reference (N : Node_Id) return Traverse_Result;
-- Determine whether node N denotes a reference to Id. If this is the
-- case, set global flag Seen to True and stop the traversal.
function Is_Reference (N : Node_Id) return Traverse_Result is
begin
if Is_Entity_Name (N)
and then Present (Entity (N))
and then Entity (N) = Id
then
Seen := True;
return Abandon;
else
return OK;
end if;
end Is_Reference;
procedure Inspect_Expression is new Traverse_Proc (Is_Reference);
-- Start of processing for Referenced
begin
Inspect_Expression (Expr);
return Seen;
end Referenced;
------------------------------------
-- References_Generic_Formal_Type --
------------------------------------
......
gcc/ada/sem_util.ads
......@@ -1358,6 +1358,9 @@ package Sem_Util is
-- parameter Ent gives the entity to which the End_Label refers,
-- and to which cross-references are to be generated.
function Referenced (Id : Entity_Id; Expr : Node_Id) return Boolean;
-- Determine whether entity Id is referenced within expression Expr
function References_Generic_Formal_Type (N : Node_Id) return Boolean;
-- Returns True if the expression Expr contains any references to a
-- generic type. This can only happen within a generic template.
......
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