Skip to content

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

[multiple changes] 

2015-10-16  Hristian Kirtchev  <kirtchev@adacore.com>

	* aspects.adb Add an entry for Constant_After_Elaboration in
	table Canonical_Aspect.
	* aspects.ads Add entries for Constant_After_Elaboration in
	tables Aspect_Argument, Aspect_Delay, Aspect_Id, Aspect_Names
	and Implementation_Defined_Aspect.
	* par-prag.adb Pragma Constant_After_Elaboration does not require
	special processing by the parser.
	* sem_ch13.adb Add an entry for Constant_After_Elaboration
	in table Sig_Flags.
	(Analyze_Aspect_Specifications):
	Add processing for aspect Constant_After_Elaboration.
	(Check_Aspect_At_Freeze_Point): Aspect Constant_After_Elaboration
	does not require special processing at freeze time.
	* sem_prag.adb (Analyze_Pragma): Add processing for pragma
	Constant_After_Elaboration. Use routine Find_Related_Context to
	retrieve the context of pragma Part_Of.
	(Duplication_Error): Update comment on usage.
	(Find_Related_Context): New routine.
	* sem_prag.ads Add an entry for Constant_After_Elaboration
	in table Aspect_Specifying_Pragma.
	(Analyze_Contract_Cases_In_Decl_Part): Update the comment on usage.
	* sem_util.adb (Add_Contract_Item): Add processing for pragma
	Constant_After_Elaboration.
	* sem_util.ads (Add_Contract_Item): Update the comment on usage.
	* snames.ads-tmpl Add new predefined name and aspect id for
	Constant_After_Elaboration.

2015-10-16  Vincent Celier  <celier@adacore.com>

	* prj-pp.adb (Pretty_Print.Print): Correctly display extending
	packages, instead of making them renamed packages.

From-SVN: r228911
parent e1e307d9
Showing with 247 additions and 65 deletions
gcc/ada/ChangeLog
2015-10-16 Hristian Kirtchev <kirtchev@adacore.com>
* aspects.adb Add an entry for Constant_After_Elaboration in
table Canonical_Aspect.
* aspects.ads Add entries for Constant_After_Elaboration in
tables Aspect_Argument, Aspect_Delay, Aspect_Id, Aspect_Names
and Implementation_Defined_Aspect.
* par-prag.adb Pragma Constant_After_Elaboration does not require
special processing by the parser.
* sem_ch13.adb Add an entry for Constant_After_Elaboration
in table Sig_Flags.
(Analyze_Aspect_Specifications):
Add processing for aspect Constant_After_Elaboration.
(Check_Aspect_At_Freeze_Point): Aspect Constant_After_Elaboration
does not require special processing at freeze time.
* sem_prag.adb (Analyze_Pragma): Add processing for pragma
Constant_After_Elaboration. Use routine Find_Related_Context to
retrieve the context of pragma Part_Of.
(Duplication_Error): Update comment on usage.
(Find_Related_Context): New routine.
* sem_prag.ads Add an entry for Constant_After_Elaboration
in table Aspect_Specifying_Pragma.
(Analyze_Contract_Cases_In_Decl_Part): Update the comment on usage.
* sem_util.adb (Add_Contract_Item): Add processing for pragma
Constant_After_Elaboration.
* sem_util.ads (Add_Contract_Item): Update the comment on usage.
* snames.ads-tmpl Add new predefined name and aspect id for
Constant_After_Elaboration.
2015-10-16 Vincent Celier <celier@adacore.com>
* prj-pp.adb (Pretty_Print.Print): Correctly display extending
packages, instead of making them renamed packages.
2015-10-16 Hristian Kirtchev <kirtchev@adacore.com>
* sem_ch12.adb (Analyze_Package_Instantiation):
Treat a missing SPARK_Mode annotation as having mode "Off".
(Analyze_Subprogram_Instantiation): Treat a missing SPARK_Mode
......
gcc/ada/aspects.adb
......@@ -505,6 +505,7 @@ package body Aspects is
Aspect_Attach_Handler => Aspect_Attach_Handler,
Aspect_Bit_Order => Aspect_Bit_Order,
Aspect_Component_Size => Aspect_Component_Size,
Aspect_Constant_After_Elaboration => Aspect_Constant_After_Elaboration,
Aspect_Constant_Indexing => Aspect_Constant_Indexing,
Aspect_Contract_Cases => Aspect_Contract_Cases,
Aspect_Convention => Aspect_Convention,
......
gcc/ada/par-prag.adb
......@@ -1304,6 +1304,7 @@ begin
Pragma_Check_Policy |
Pragma_Compile_Time_Error |
Pragma_Compile_Time_Warning |
Pragma_Constant_After_Elaboration |
Pragma_Contract_Cases |
Pragma_Convention_Identifier |
Pragma_CPP_Class |
......
gcc/ada/prj-pp.adb
......@@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
-- Copyright (C) 2001-2014, Free Software Foundation, Inc. --
-- Copyright (C) 2001-2015, Free Software Foundation, Inc. --
-- --
-- GNAT is free software; you can redistribute it and/or modify it under --
-- terms of the GNU General Public License as published by the Free Soft- --
......@@ -522,7 +522,13 @@ package body Prj.PP is
if Project_Of_Renamed_Package_Of (Node, In_Tree) /=
Empty_Node
then
Write_String (" renames ", Indent);
if First_Declarative_Item_Of (Node, In_Tree) = Empty_Node
then
Write_String (" renames ", Indent);
else
Write_String (" extends ", Indent);
end if;
Output_Name
(Name_Of
(Project_Of_Renamed_Package_Of (Node, In_Tree),
......@@ -530,6 +536,13 @@ package body Prj.PP is
Indent);
Write_String (".", Indent);
Output_Name (Name_Of (Node, In_Tree), Indent);
end if;
if Project_Of_Renamed_Package_Of (Node, In_Tree) /=
Empty_Node
and then
First_Declarative_Item_Of (Node, In_Tree) = Empty_Node
then
Write_String (";", Indent);
Write_End_Of_Line_Comment (Node);
Print (First_Comment_After_End (Node, In_Tree), Indent);
......
gcc/ada/sem_ch13.adb
......@@ -2263,6 +2263,22 @@ package body Sem_Ch13 is
goto Continue;
end Abstract_State;
-- Aspect Constant_After_Elaboration is never delayed because
-- it is equivalent to a source pragma which appears after the
-- related object declaration.
when Aspect_Constant_After_Elaboration =>
Make_Aitem_Pragma
(Pragma_Argument_Associations => New_List (
Make_Pragma_Argument_Association (Loc,
Expression => Relocate_Node (Expr))),
Pragma_Name =>
Name_Constant_After_Elaboration);
Decorate (Aspect, Aitem);
Insert_Pragma (Aitem);
goto Continue;
-- Aspect Default_Internal_Condition is never delayed because
-- it is equivalent to a source pragma which appears after the
-- related private type. To deal with forward references, the
......@@ -9246,32 +9262,33 @@ package body Sem_Ch13 is
-- Here is the list of aspects that don't require delay analysis
when Aspect_Abstract_State |
Aspect_Annotate |
Aspect_Contract_Cases |
Aspect_Default_Initial_Condition |
Aspect_Depends |
Aspect_Dimension |
Aspect_Dimension_System |
Aspect_Extensions_Visible |
Aspect_Ghost |
Aspect_Global |
Aspect_Implicit_Dereference |
Aspect_Initial_Condition |
Aspect_Initializes |
Aspect_Obsolescent |
Aspect_Part_Of |
Aspect_Post |
Aspect_Postcondition |
Aspect_Pre |
Aspect_Precondition |
Aspect_Refined_Depends |
Aspect_Refined_Global |
Aspect_Refined_Post |
Aspect_Refined_State |
Aspect_SPARK_Mode |
Aspect_Test_Case |
Aspect_Unimplemented =>
when Aspect_Abstract_State |
Aspect_Annotate |
Aspect_Constant_After_Elaboration |
Aspect_Contract_Cases |
Aspect_Default_Initial_Condition |
Aspect_Depends |
Aspect_Dimension |
Aspect_Dimension_System |
Aspect_Extensions_Visible |
Aspect_Ghost |
Aspect_Global |
Aspect_Implicit_Dereference |
Aspect_Initial_Condition |
Aspect_Initializes |
Aspect_Obsolescent |
Aspect_Part_Of |
Aspect_Post |
Aspect_Postcondition |
Aspect_Pre |
Aspect_Precondition |
Aspect_Refined_Depends |
Aspect_Refined_Global |
Aspect_Refined_Post |
Aspect_Refined_State |
Aspect_SPARK_Mode |
Aspect_Test_Case |
Aspect_Unimplemented =>
raise Program_Error;
end case;
......
gcc/ada/sem_prag.adb
......@@ -200,9 +200,17 @@ package body Sem_Prag is
-- context denoted by Context. If this is the case, emit an error.
procedure Duplication_Error (Prag : Node_Id; Prev : Node_Id);
-- Subsidiary to routines Find_Related_Package_Or_Body and
-- Find_Related_Subprogram_Or_Body. Emit an error on pragma Prag that
-- duplicates previous pragma Prev.
-- Subsidiary to all Find_Related_xxx routines. Emit an error on pragma
-- Prag that duplicates previous pragma Prev.
function Find_Related_Context
(Prag : Node_Id;
Do_Checks : Boolean := False) return Node_Id;
-- Subsidiaty to the analysis of pragmas Constant_After_Elaboration and
-- Part_Of. Find the first source declaration or statement found while
-- traversing the previous node chain starting from pragma Prag. If flag
-- Do_Checks is set, the routine reports duplicate pragmas. The routine
-- returns Empty when reaching the start of the node chain.
function Get_Base_Subprogram (Def_Id : Entity_Id) return Entity_Id;
-- If Def_Id refers to a renamed subprogram, then the base subprogram (the
......@@ -12134,6 +12142,88 @@ package body Sem_Prag is
end if;
end Component_AlignmentP;
--------------------------------
-- Constant_After_Elaboration --
--------------------------------
-- pragma Constant_After_Elaboration [ (boolean_EXPRESSION) ];
when Pragma_Constant_After_Elaboration => Constant_After_Elaboration :
declare
Expr : Node_Id;
Obj_Decl : Node_Id;
Obj_Id : Entity_Id;
begin
GNAT_Pragma;
Check_No_Identifiers;
Check_At_Most_N_Arguments (1);
Obj_Decl := Find_Related_Context (N, Do_Checks => True);
-- Object declaration
if Nkind (Obj_Decl) = N_Object_Declaration then
null;
-- Otherwise the pragma is associated with an illegal construct
else
Pragma_Misplaced;
return;
end if;
Obj_Id := Defining_Entity (Obj_Decl);
-- A pragma that applies to a Ghost entity becomes Ghost for the
-- purposes of legality checks and removal of ignored Ghost code.
Mark_Pragma_As_Ghost (N, Obj_Id);
-- The object declaration must be a library-level variable with
-- an initialization expression. The expression must depend on
-- a variable, parameter, or another constant_after_elaboration,
-- but the compiler cannot detect this property, as this requires
-- full flow analysis (SPARK RM 3.3.1).
if Ekind (Obj_Id) = E_Variable then
if not Is_Library_Level_Entity (Obj_Id) then
Error_Pragma
("pragma % must apply to a library level variable");
return;
elsif not Has_Init_Expression (Obj_Decl) then
Error_Pragma
("pragma % must apply to a variable with initialization "
& "expression");
end if;
-- Otherwise the pragma applies to a constant, which is illegal
else
Error_Pragma ("pragma % must apply to a variable declaration");
return;
end if;
-- Analyze the Boolean expression (if any)
if Present (Arg1) then
Expr := Get_Pragma_Arg (Arg1);
Analyze_And_Resolve (Expr, Standard_Boolean);
if not Is_OK_Static_Expression (Expr) then
Error_Pragma_Arg
("expression of pragma % must be static", Expr);
return;
end if;
end if;
-- Chain the pragma on the contract for completeness
Add_Contract_Item (N, Obj_Id);
end Constant_After_Elaboration;
--------------------
-- Contract_Cases --
--------------------
......@@ -17394,45 +17484,24 @@ package body Sem_Prag is
Check_No_Identifiers;
Check_Arg_Count (1);
-- Ensure the proper placement of the pragma. Part_Of must appear
-- on an object declaration or a package instantiation.
Stmt := Find_Related_Context (N, Do_Checks => True);
Stmt := Prev (N);
while Present (Stmt) loop
-- Object declaration
-- Skip prior pragmas, but check for duplicates
if Nkind (Stmt) = N_Pragma then
if Pragma_Name (Stmt) = Pname then
Error_Msg_Name_1 := Pname;
Error_Msg_Sloc := Sloc (Stmt);
Error_Msg_N ("pragma% duplicates pragma declared#", N);
end if;
-- Skip internally generated code
elsif not Comes_From_Source (Stmt) then
null;
-- The pragma applies to an object declaration (possibly a
-- variable) or a package instantiation. Stop the traversal
-- and continue the analysis.
if Nkind (Stmt) = N_Object_Declaration then
null;
elsif Nkind_In (Stmt, N_Object_Declaration,
N_Package_Instantiation)
then
exit;
-- Package instantiation
-- The pragma does not apply to a legal construct, issue an
-- error and stop the analysis.
elsif Nkind (Stmt) = N_Package_Instantiation then
null;
else
Pragma_Misplaced;
return;
end if;
-- Otherwise the pragma is associated with an illegal construct
Stmt := Prev (Stmt);
end loop;
else
Pragma_Misplaced;
return;
end if;
-- Extract the entity of the related object declaration or package
-- instantiation. In the case of the instantiation, use the entity
......@@ -25680,6 +25749,46 @@ package body Sem_Prag is
end if;
end Duplication_Error;
--------------------------
-- Find_Related_Context --
--------------------------
function Find_Related_Context
(Prag : Node_Id;
Do_Checks : Boolean := False) return Node_Id
is
Stmt : Node_Id;
begin
Stmt := Prev (Prag);
while Present (Stmt) loop
-- Skip prior pragmas, but check for duplicates
if Nkind (Stmt) = N_Pragma then
if Do_Checks and then Pragma_Name (Stmt) = Pragma_Name (Prag) then
Duplication_Error
(Prag => Prag,
Prev => Stmt);
end if;
-- Skip internally generated code
elsif not Comes_From_Source (Stmt) then
null;
-- Return the current source construct
else
return Stmt;
end if;
Prev (Stmt);
end loop;
return Empty;
end Find_Related_Context;
----------------------------------
-- Find_Related_Package_Or_Body --
----------------------------------
......@@ -26223,6 +26332,7 @@ package body Sem_Prag is
Pragma_Complete_Representation => 0,
Pragma_Complex_Representation => 0,
Pragma_Component_Alignment => 0,
Pragma_Constant_After_Elaboration => 0,
Pragma_Contract_Cases => -1,
Pragma_Controlled => 0,
Pragma_Convention => 0,
......
gcc/ada/sem_prag.ads
......@@ -45,6 +45,7 @@ package Sem_Prag is
Pragma_Atomic => True,
Pragma_Atomic_Components => True,
Pragma_Attach_Handler => True,
Pragma_Constant_After_Elaboration => True,
Pragma_Contract_Cases => True,
Pragma_Convention => True,
Pragma_CPU => True,
......@@ -171,7 +172,7 @@ package Sem_Prag is
-- Analyze procedure for pragma reference node N
procedure Analyze_Contract_Cases_In_Decl_Part (N : Node_Id);
-- Perform full analysis and expansion of delayed pragma Contract_Cases
-- Perform full analysis of delayed pragma Contract_Cases
procedure Analyze_Depends_In_Decl_Part (N : Node_Id);
-- Perform full analysis of delayed pragma Depends. This routine is also
......
gcc/ada/sem_util.adb
......@@ -424,6 +424,7 @@ package body Sem_Util is
-- Contract items related to variables. Applicable pragmas are:
-- Async_Readers
-- Async_Writers
-- Constant_After_Elaboration
-- Effective_Reads
-- Effective_Writes
-- Part_Of
......@@ -431,6 +432,7 @@ package body Sem_Util is
elsif Ekind (Id) = E_Variable then
if Nam_In (Prag_Nam, Name_Async_Readers,
Name_Async_Writers,
Name_Constant_After_Elaboration,
Name_Effective_Reads,
Name_Effective_Writes,
Name_Part_Of)
......
gcc/ada/sem_util.ads
......@@ -56,6 +56,7 @@ package Sem_Util is
-- Abstract_State
-- Async_Readers
-- Async_Writers
-- Constant_After_Elaboration
-- Contract_Cases
-- Depends
-- Effective_Reads
......
gcc/ada/snames.ads-tmpl
......@@ -468,6 +468,7 @@ package Snames is
Name_Common_Object : constant Name_Id := N + $; -- GNAT
Name_Complete_Representation : constant Name_Id := N + $; -- GNAT
Name_Complex_Representation : constant Name_Id := N + $; -- GNAT
Name_Constant_After_Elaboration : constant Name_Id := N + $; -- GNAT
Name_Contract_Cases : constant Name_Id := N + $; -- GNAT
Name_Controlled : constant Name_Id := N + $;
Name_Convention : constant Name_Id := N + $;
......@@ -1813,6 +1814,7 @@ package Snames is
Pragma_Common_Object,
Pragma_Complete_Representation,
Pragma_Complex_Representation,
Pragma_Constant_After_Elaboration,
Pragma_Contract_Cases,
Pragma_Controlled,
Pragma_Convention,
......
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