Skip to content

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

[multiple changes] 

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

	* aspects.adb Add an entry for entry bodies in table
	Has_Aspect_Specifications_Flag.
	(Aspects_On_Body_Or_Stub_OK): Entry bodies now allow for certain
	aspects.
	* contracts.adb (Add_Contract_Items): Code cleanup. Add
	processing for entry bodies, entry declarations and task units.
	(Analyze_Subprogram_Body_Contract): Renamed
	to Analyze_Entry_Or_Subprogram_Body_Contract. Do not
	analyze the contract of an entry body unless annotating the
	original tree.
	(Analyze_Subprogram_Contract): Renamed to
	Analyze_Entry_Or_Subprogram_Contract.  Do not analyze the contract
	of an entry declaration unless annotating the original tree.
	(Analyze_Task_Contract): New routine.
	* contracts.ads (Add_Contract_Item): Update the comment on usage.
	(Analyze_Package_Body_Contract): Update comment on usage.
	(Analyze_Package_Contract): Update the comment on usage.
	(Analyze_Subprogram_Body_Contract): Renamed to
	Analyze_Entry_Or_Subprogram_Body_Contract.
	(Analyze_Subprogram_Body_Stub_Contract): Update the comment on usage.
	(Analyze_Subprogram_Contract): Renamed to
	Analyze_Entry_Or_Subprogram_Contract.
	(Analyze_Task_Contract): New routine.
	* einfo.adb (Contract): Restructure the assertion to include
	entries and task units.
	(SPARK_Pragma): This attribute now applies to operators.
	(SPARK_Pragma_Inherited): This flag now applies to operators.
	(Set_Contract): Restructure the assertion to include entries and task
	units.
	(Set_SPARK_Pragma): This attribute now applies to operators.
	(Set_SPARK_Pragma_Inherited): This flag now applies to operators.
	(Write_Field34_Name): Write out all Ekinds that have a contract.
	(Write_Field40_Name): SPARK_Pragma now applies to operators.
	* einfo.ads: Update the documentation of attribute Contract along
	with usage in nodes.  Update the documentation of attributes
	SPARK_Pragma and SPARK_Pragma_Inherited.
	* exp_ch6.adb (Freeze_Subprogram): Update the call to
	Analyze_Subprogram_Contract.
	* par-ch9.adb (P_Entry_Barrier): Do not parse keyword "is" as it
	is not part of the entry barrier production.
	(P_Entry_Body): Parse the optional aspect specifications. Diagnose
	misplaced aspects.
	* sem_attr.adb (Analyze_Attribute_Old_Result): Update the call
	to Find_Related_Subprogram_Or_Body.
	* sem_aux.adb (Unit_Declaration_Node) Add an entry for entry
	declarations and bodies.
	* sem_ch3.adb (Analyze_Declarations): Analyze the contracts of
	entry declarations, entry bodies and task units.
	* sem_ch6.adb (Analyze_Generic_Subprogram_Body):
	Update the call to Analyze_Subprogram_Body_Contract.
	(Analyze_Subprogram_Body_Helper): Update the call to
	Analyze_Subprogram_Body_Contract.
	* sem_ch9.adb (Analyze_Entry_Body): Analyze the aspect
	specifications and the contract.
	* sem_ch10.adb (Analyze_Compilation_Unit): Update the call to
	Analyze_Subprogram_Contract.
	* sem_ch12.adb (Save_References_In_Pragma): Update the call to
	Find_Related_Subprogram_Or_Body.
	* sem_ch13.adb (Analyze_Aspects_On_Body_Or_Stub): Use
	Unique_Defining_Entity rather than rummaging around in nodes.
	(Diagnose_Misplaced_Aspects): Update comment on usage. Update the
	error messages to accomondate the increasing number of contexts.
	* sem_prag.adb (Analyze_Contract_Cases_In_Decl_Part):
	Update the call to Find_Related_Subprogram_Or_Body.
	(Analyze_Depends_Global): Update the call to
	Find_Related_Subprogram_Or_Body. Add processing for entry
	declarations.
	(Analyze_Depends_In_Decl_Part): Update the call
	to Find_Related_Subprogram_Or_Body. Task units have no formal
	parameters to install.	(Analyze_Global_In_Decl_Part): Update
	the call to Find_Related_Subprogram_Or_Body. Task units have no
	formal parameters to install.
	(Analyze_Global_Item): Use Fix_Msg to handle the increasing number of
	contexts.
	(Analyze_Pragma): Update the call to Find_Related_Subprogram_Or_Body.
	Perform full analysis when various pragmas appear in an entry body.
	(Analyze_Pre_Post_Condition): Update the call to
	Find_Related_Subprogram_Or_Body. Perform full analysis when the pragma
	appears in an entry body.
	(Analyze_Pre_Post_Condition_In_Decl_Part): Update the call to
	Find_Related_Subprogram_Or_Body.
	(Analyze_Refined_Depends_Global_Post): Update
	the call to Find_Related_Subprogram_Or_Body. Use
	Fix_Msg to handle the increasing number of contexts.
	(Analyze_Refined_Depends_In_Decl_Part): Update
	the call to Find_Related_Subprogram_Or_Body. Use
	Unique_Defining_Entity to obtain the entity of the
	spec. Use Fix_Msg to handle the increasing number of contexts.
	(Analyze_Refined_Global_In_Decl_Part): Update the call to
	Find_Related_Subprogram_Or_Body. Use Unique_Defining_Entity to obtain
	the entity of the spec. Use Fix_Msg to handle the increasing number of
	contexts.
	(Analyze_Test_Case_In_Decl_Part): Update the call to
	Find_Related_Subprogram_Or_Body.
	(Check_Dependency_Clause): Use Fix_Msg to handle the increasing number
	of contexts.
	(Check_Mode_Restriction_In_Enclosing_Context): Use
	Fix_Msg to handle the increasing number of contexts.
	(Collect_Subprogram_Inputs_Outputs): Use the refined
	versions of the pragmas when the context is an entry body or
	a task body.
	(Find_Related_Subprogram_Or_Body): Renamed to
	Find_Related_Declaration_Or_Body.  Add processing for entries
	and task units.
	(Fix_Msg): New routine.
	(Role_Error): Use Fix_Msg to handle the increasing number of contexts.
	* sem_prag.ads (Find_Related_Subprogram_Or_Body): Renamed to
	Find_Related_Declaration_Or_Body.  Update the comment on usage.
	* sem_util.adb (Is_Entry_Body): New routine.
	(Is_Entry_Declaration): New routine.
	* sem_util.ads (Is_Entry_Body): New routine.
	(Is_Entry_Declaration): New routine.

2015-10-26  Ed Schonberg  <schonberg@adacore.com>

	* inline.adb (Has_Excluded_Declaration): A subtype declaration
	with a predicate aspect generates a subprogram, and therefore
	prevents the inlining of the enclosing subprogram.
	* osint.ads: Fix typo.

From-SVN: r229333
parent 1f145d79
Showing with 420 additions and 148 deletions
gcc/ada/ChangeLog
2015-10-26 Hristian Kirtchev <kirtchev@adacore.com>
* aspects.adb Add an entry for entry bodies in table
Has_Aspect_Specifications_Flag.
(Aspects_On_Body_Or_Stub_OK): Entry bodies now allow for certain
aspects.
* contracts.adb (Add_Contract_Items): Code cleanup. Add
processing for entry bodies, entry declarations and task units.
(Analyze_Subprogram_Body_Contract): Renamed
to Analyze_Entry_Or_Subprogram_Body_Contract. Do not
analyze the contract of an entry body unless annotating the
original tree.
(Analyze_Subprogram_Contract): Renamed to
Analyze_Entry_Or_Subprogram_Contract. Do not analyze the contract
of an entry declaration unless annotating the original tree.
(Analyze_Task_Contract): New routine.
* contracts.ads (Add_Contract_Item): Update the comment on usage.
(Analyze_Package_Body_Contract): Update comment on usage.
(Analyze_Package_Contract): Update the comment on usage.
(Analyze_Subprogram_Body_Contract): Renamed to
Analyze_Entry_Or_Subprogram_Body_Contract.
(Analyze_Subprogram_Body_Stub_Contract): Update the comment on usage.
(Analyze_Subprogram_Contract): Renamed to
Analyze_Entry_Or_Subprogram_Contract.
(Analyze_Task_Contract): New routine.
* einfo.adb (Contract): Restructure the assertion to include
entries and task units.
(SPARK_Pragma): This attribute now applies to operators.
(SPARK_Pragma_Inherited): This flag now applies to operators.
(Set_Contract): Restructure the assertion to include entries and task
units.
(Set_SPARK_Pragma): This attribute now applies to operators.
(Set_SPARK_Pragma_Inherited): This flag now applies to operators.
(Write_Field34_Name): Write out all Ekinds that have a contract.
(Write_Field40_Name): SPARK_Pragma now applies to operators.
* einfo.ads: Update the documentation of attribute Contract along
with usage in nodes. Update the documentation of attributes
SPARK_Pragma and SPARK_Pragma_Inherited.
* exp_ch6.adb (Freeze_Subprogram): Update the call to
Analyze_Subprogram_Contract.
* par-ch9.adb (P_Entry_Barrier): Do not parse keyword "is" as it
is not part of the entry barrier production.
(P_Entry_Body): Parse the optional aspect specifications. Diagnose
misplaced aspects.
* sem_attr.adb (Analyze_Attribute_Old_Result): Update the call
to Find_Related_Subprogram_Or_Body.
* sem_aux.adb (Unit_Declaration_Node) Add an entry for entry
declarations and bodies.
* sem_ch3.adb (Analyze_Declarations): Analyze the contracts of
entry declarations, entry bodies and task units.
* sem_ch6.adb (Analyze_Generic_Subprogram_Body):
Update the call to Analyze_Subprogram_Body_Contract.
(Analyze_Subprogram_Body_Helper): Update the call to
Analyze_Subprogram_Body_Contract.
* sem_ch9.adb (Analyze_Entry_Body): Analyze the aspect
specifications and the contract.
* sem_ch10.adb (Analyze_Compilation_Unit): Update the call to
Analyze_Subprogram_Contract.
* sem_ch12.adb (Save_References_In_Pragma): Update the call to
Find_Related_Subprogram_Or_Body.
* sem_ch13.adb (Analyze_Aspects_On_Body_Or_Stub): Use
Unique_Defining_Entity rather than rummaging around in nodes.
(Diagnose_Misplaced_Aspects): Update comment on usage. Update the
error messages to accomondate the increasing number of contexts.
* sem_prag.adb (Analyze_Contract_Cases_In_Decl_Part):
Update the call to Find_Related_Subprogram_Or_Body.
(Analyze_Depends_Global): Update the call to
Find_Related_Subprogram_Or_Body. Add processing for entry
declarations.
(Analyze_Depends_In_Decl_Part): Update the call
to Find_Related_Subprogram_Or_Body. Task units have no formal
parameters to install. (Analyze_Global_In_Decl_Part): Update
the call to Find_Related_Subprogram_Or_Body. Task units have no
formal parameters to install.
(Analyze_Global_Item): Use Fix_Msg to handle the increasing number of
contexts.
(Analyze_Pragma): Update the call to Find_Related_Subprogram_Or_Body.
Perform full analysis when various pragmas appear in an entry body.
(Analyze_Pre_Post_Condition): Update the call to
Find_Related_Subprogram_Or_Body. Perform full analysis when the pragma
appears in an entry body.
(Analyze_Pre_Post_Condition_In_Decl_Part): Update the call to
Find_Related_Subprogram_Or_Body.
(Analyze_Refined_Depends_Global_Post): Update
the call to Find_Related_Subprogram_Or_Body. Use
Fix_Msg to handle the increasing number of contexts.
(Analyze_Refined_Depends_In_Decl_Part): Update
the call to Find_Related_Subprogram_Or_Body. Use
Unique_Defining_Entity to obtain the entity of the
spec. Use Fix_Msg to handle the increasing number of contexts.
(Analyze_Refined_Global_In_Decl_Part): Update the call to
Find_Related_Subprogram_Or_Body. Use Unique_Defining_Entity to obtain
the entity of the spec. Use Fix_Msg to handle the increasing number of
contexts.
(Analyze_Test_Case_In_Decl_Part): Update the call to
Find_Related_Subprogram_Or_Body.
(Check_Dependency_Clause): Use Fix_Msg to handle the increasing number
of contexts.
(Check_Mode_Restriction_In_Enclosing_Context): Use
Fix_Msg to handle the increasing number of contexts.
(Collect_Subprogram_Inputs_Outputs): Use the refined
versions of the pragmas when the context is an entry body or
a task body.
(Find_Related_Subprogram_Or_Body): Renamed to
Find_Related_Declaration_Or_Body. Add processing for entries
and task units.
(Fix_Msg): New routine.
(Role_Error): Use Fix_Msg to handle the increasing number of contexts.
* sem_prag.ads (Find_Related_Subprogram_Or_Body): Renamed to
Find_Related_Declaration_Or_Body. Update the comment on usage.
* sem_util.adb (Is_Entry_Body): New routine.
(Is_Entry_Declaration): New routine.
* sem_util.ads (Is_Entry_Body): New routine.
(Is_Entry_Declaration): New routine.
2015-10-26 Ed Schonberg <schonberg@adacore.com>
* inline.adb (Has_Excluded_Declaration): A subtype declaration
with a predicate aspect generates a subprogram, and therefore
prevents the inlining of the enclosing subprogram.
* osint.ads: Fix typo.
2015-10-26 Ed Schonberg <schonberg@adacore.com>
* sem_case.adb (Check_Choice_Set): Choose initial choice range
......
gcc/ada/aspects.adb
......@@ -154,7 +154,8 @@ package body Aspects is
pragma Assert (Has_Aspects (N));
pragma Assert (Nkind (N) in N_Body_Stub
or else Nkind_In (N, N_Package_Body,
or else Nkind_In (N, N_Entry_Body,
N_Package_Body,
N_Protected_Body,
N_Subprogram_Body,
N_Task_Body));
......@@ -427,6 +428,7 @@ package body Aspects is
Has_Aspect_Specifications_Flag : constant array (Node_Kind) of Boolean :=
(N_Abstract_Subprogram_Declaration => True,
N_Component_Declaration => True,
N_Entry_Body => True,
N_Entry_Declaration => True,
N_Exception_Declaration => True,
N_Exception_Renaming_Declaration => True,
......
gcc/ada/contracts.ads
......@@ -31,9 +31,9 @@ with Types; use Types;
package Contracts is
procedure Add_Contract_Item (Prag : Node_Id; Id : Entity_Id);
-- Add pragma Prag to the contract of a constant, entry, package [body],
-- subprogram [body], or variable denoted by Id. The following are valid
-- pragmas:
-- Add pragma Prag to the contract of a constant, entry, entry family,
-- [generic] package, package body, [generic] subprogram, subprogram body,
-- variable or task unit denoted by Id. The following are valid pragmas:
-- Abstract_State
-- Async_Readers
-- Async_Writers
......@@ -60,6 +60,31 @@ package Contracts is
-- Analyze the contract of the nearest package body (if any) enclosing
-- package or subprogram body Body_Decl.
procedure Analyze_Entry_Or_Subprogram_Body_Contract (Body_Id : Entity_Id);
-- Analyze all delayed pragmas chained on the contract of entry or
-- subprogram body Body_Id as if they appeared at the end of a declarative
-- region. Pragmas in question are:
-- Contract_Cases (stand alone subprogram body)
-- Depends (stand alone subprogram body)
-- Global (stand alone subprogram body)
-- Postcondition (stand alone subprogram body)
-- Precondition (stand alone subprogram body)
-- Refined_Depends
-- Refined_Global
-- Refined_Post
-- Test_Case (stand alone subprogram body)
procedure Analyze_Entry_Or_Subprogram_Contract (Subp_Id : Entity_Id);
-- Analyze all delayed pragmas chained on the contract of entry or
-- subprogram Subp_Id as if they appeared at the end of a declarative
-- region. The pragmas in question are:
-- Contract_Cases
-- Depends
-- Global
-- Postcondition
-- Precondition
-- Test_Case
procedure Analyze_Object_Contract (Obj_Id : Entity_Id);
-- Analyze all delayed pragmas chained on the contract of object Obj_Id as
-- if they appeared at the end of the declarative region. The pragmas to be
......@@ -73,51 +98,26 @@ package Contracts is
procedure Analyze_Package_Body_Contract
(Body_Id : Entity_Id;
Freeze_Id : Entity_Id := Empty);
-- Analyze all delayed aspects chained on the contract of package body
-- Analyze all delayed pragmas chained on the contract of package body
-- Body_Id as if they appeared at the end of a declarative region. The
-- aspects that are considered are:
-- pragmas that are considered are:
-- Refined_State
--
-- Freeze_Id is the entity of a [generic] package body or a [generic]
-- subprogram body which "freezes" the contract of Body_Id.
procedure Analyze_Package_Contract (Pack_Id : Entity_Id);
-- Analyze all delayed aspects chained on the contract of package Pack_Id
-- as if they appeared at the end of a declarative region. The aspects
-- Analyze all delayed pragmas chained on the contract of package Pack_Id
-- as if they appeared at the end of a declarative region. The pragmas
-- that are considered are:
-- Initial_Condition
-- Initializes
-- Part_Of
procedure Analyze_Subprogram_Body_Contract (Body_Id : Entity_Id);
-- Analyze all delayed aspects chained on the contract of subprogram body
-- Body_Id as if they appeared at the end of a declarative region. Aspects
-- in question are:
-- Contract_Cases (stand alone body)
-- Depends (stand alone body)
-- Global (stand alone body)
-- Postcondition (stand alone body)
-- Precondition (stand alone body)
-- Refined_Depends
-- Refined_Global
-- Refined_Post
-- Test_Case (stand alone body)
procedure Analyze_Subprogram_Contract (Subp_Id : Entity_Id);
-- Analyze all delayed aspects chained on the contract of subprogram
-- Subp_Id as if they appeared at the end of a declarative region. The
-- aspects in question are:
-- Contract_Cases
-- Depends
-- Global
-- Postcondition
-- Precondition
-- Test_Case
procedure Analyze_Subprogram_Body_Stub_Contract (Stub_Id : Entity_Id);
-- Analyze all delayed aspects chained on the contract of a subprogram body
-- Analyze all delayed pragmas chained on the contract of a subprogram body
-- stub Stub_Id as if they appeared at the end of a declarative region. The
-- aspects in question are:
-- pragmas in question are:
-- Contract_Cases
-- Depends
-- Global
......@@ -128,6 +128,13 @@ package Contracts is
-- Refined_Post
-- Test_Case
procedure Analyze_Task_Contract (Task_Id : Entity_Id);
-- Analyze all delayed pragmas chained on the contract of a task unit
-- Task_Id as if they appeared at the end of a declarative region. The
-- pragmas in question are:
-- Depends
-- Global
procedure Create_Generic_Contract (Unit : Node_Id);
-- Create a contract node for a generic package, generic subprogram, or a
-- generic body denoted by Unit by collecting all source contract-related
......
gcc/ada/einfo.adb
......@@ -1205,16 +1205,25 @@ package body Einfo is
function Contract (Id : E) return N is
begin
pragma Assert
(Ekind_In (Id, E_Constant,
E_Entry,
(Ekind_In (Id, E_Constant, -- object variants
E_Variable)
or else
Ekind_In (Id, E_Entry, -- overloadable variants
E_Entry_Family,
E_Generic_Package,
E_Function,
E_Generic_Function,
E_Generic_Procedure,
E_Operator,
E_Procedure,
E_Subprogram_Body)
or else
Ekind_In (Id, E_Generic_Package, -- package variants
E_Package,
E_Package_Body,
E_Subprogram_Body,
E_Variable,
E_Void)
or else Is_Subprogram_Or_Generic_Subprogram (Id));
E_Package_Body)
or else
Ekind_In (Id, E_Task_Body, -- synchronized variants
E_Task_Type,
E_Void)); -- special purpose
return Node34 (Id);
end Contract;
......@@ -3139,6 +3148,7 @@ package body Einfo is
E_Function,
E_Generic_Function,
E_Generic_Procedure,
E_Operator,
E_Procedure,
E_Subprogram_Body)
or else
......@@ -3161,6 +3171,7 @@ package body Einfo is
E_Function,
E_Generic_Function,
E_Generic_Procedure,
E_Operator,
E_Procedure,
E_Subprogram_Body)
or else
......@@ -3834,16 +3845,25 @@ package body Einfo is
procedure Set_Contract (Id : E; V : N) is
begin
pragma Assert
(Ekind_In (Id, E_Constant,
E_Entry,
(Ekind_In (Id, E_Constant, -- object variants
E_Variable)
or else
Ekind_In (Id, E_Entry, -- overloadable variants
E_Entry_Family,
E_Generic_Package,
E_Function,
E_Generic_Function,
E_Generic_Procedure,
E_Operator,
E_Procedure,
E_Subprogram_Body)
or else
Ekind_In (Id, E_Generic_Package, -- package variants
E_Package,
E_Package_Body,
E_Subprogram_Body,
E_Variable,
E_Void)
or else Is_Subprogram_Or_Generic_Subprogram (Id));
E_Package_Body)
or else
Ekind_In (Id, E_Task_Body, -- synchronized variants
E_Task_Type,
E_Void)); -- special purpose
Set_Node34 (Id, V);
end Set_Contract;
......@@ -6170,6 +6190,7 @@ package body Einfo is
E_Function,
E_Generic_Function,
E_Generic_Procedure,
E_Operator,
E_Procedure,
E_Subprogram_Body)
or else
......@@ -6192,6 +6213,7 @@ package body Einfo is
E_Function,
E_Generic_Function,
E_Generic_Procedure,
E_Operator,
E_Procedure,
E_Subprogram_Body)
or else
......@@ -10212,14 +10234,19 @@ package body Einfo is
when E_Constant |
E_Entry |
E_Entry_Family |
E_Function |
E_Generic_Function |
E_Generic_Package |
E_Generic_Procedure |
E_Operator |
E_Package |
E_Package_Body |
E_Procedure |
E_Subprogram_Body |
E_Task_Body |
E_Task_Type |
E_Variable |
E_Void |
Generic_Subprogram_Kind |
Subprogram_Kind =>
E_Void =>
Write_Str ("Contract");
when others =>
......@@ -10317,6 +10344,7 @@ package body Einfo is
E_Generic_Function |
E_Generic_Package |
E_Generic_Procedure |
E_Operator |
E_Package |
E_Package_Body |
E_Procedure |
......
gcc/ada/einfo.ads
......@@ -705,10 +705,10 @@ package Einfo is
-- of declaration, procedure call, assignment statement or pragma.
-- Contract (Node34)
-- Defined in constant, entry, entry family, [generic] package, package
-- body, [generic] subprogram, subprogram body, and variable entities.
-- Points to the contract of the entity, holding various assertion items
-- and data classifiers.
-- Defined in constant, entry, entry family, operator, [generic] package,
-- package body, [generic] subprogram, subprogram body, variable and task
-- type entities. Points to the contract of the entity, holding various
-- assertion items and data classifiers.
-- Corresponding_Concurrent_Type (Node18)
-- Defined in record types that are constructed by the expander to
......@@ -4087,19 +4087,20 @@ package Einfo is
-- inherited, rather than a local one.
-- SPARK_Pragma (Node40)
-- Present in entries, [generic] package specs, package bodies, [generic]
-- subprogram specs, subprogram bodies and synchronized types. Points to
-- the N_Pragma node that applies to the spec or body. This is either set
-- by a local SPARK_Mode pragma or is inherited from the context (from an
-- outer scope for the spec case or from the spec for the body case). In
-- the case where it is inherited the flag SPARK_Pragma_Inherited is set.
-- Empty if no SPARK_Mode pragma is applicable.
-- Present in entries, operators, [generic] packages, package bodies,
-- [generic] subprograms, subprogram bodies and synchronized types.
-- Points to the N_Pragma node that applies to the spec or body. This
-- is either set by a local SPARK_Mode pragma or is inherited from the
-- context (from an outer scope for the spec case or from the spec for
-- the body case). In the case where it is inherited the flag
-- SPARK_Pragma_Inherited is set. Empty if no SPARK_Mode pragma is
-- applicable.
-- SPARK_Pragma_Inherited (Flag265)
-- Present in entries, [generic] package specs, package bodies, [generic]
-- subprogram specs, subprogram bodies and synchronized types. Set if the
-- SPARK_Pragma attribute points to a pragma that is inherited, rather
-- than a local one.
-- Present in entries, operators, [generic] packages, package bodies,
-- [generic] subprograms, subprogram bodies and synchronized types. Set
-- if the SPARK_Pragma attribute points to a pragma that is inherited,
-- rather than a local one.
-- Spec_Entity (Node19)
-- Defined in package body entities. Points to corresponding package
......@@ -6041,13 +6042,15 @@ package Einfo is
-- Linker_Section_Pragma (Node33)
-- Contract (Node34)
-- Import_Pragma (Node35)
-- SPARK_Pragma (Node40)
-- Default_Expressions_Processed (Flag108)
-- Has_Invariants (Flag232)
-- Has_Nested_Subprogram (Flag282)
-- Is_Machine_Code_Subprogram (Flag137)
-- Is_Pure (Flag44)
-- Is_Intrinsic_Subprogram (Flag64)
-- Is_Machine_Code_Subprogram (Flag137)
-- Is_Primitive (Flag218)
-- Default_Expressions_Processed (Flag108)
-- Is_Pure (Flag44)
-- SPARK_Pragma_Inherited (Flag265)
-- Aren't there more flags and fields? seems like this list should be
-- more similar to the E_Function list, which is much longer ???
......@@ -6378,6 +6381,7 @@ package Einfo is
-- (plus type attributes)
-- E_Task_Body
-- Contract (Node34)
-- SPARK_Pragma (Node40)
-- SPARK_Pragma_Inherited (Flag265)
-- (any others??? First/Last Entity, Scope_Depth???)
......@@ -6396,6 +6400,7 @@ package Einfo is
-- Task_Body_Procedure (Node25)
-- Storage_Size_Variable (Node26) (base type only)
-- Relative_Deadline_Variable (Node28) (base type only)
-- Contract (Node34)
-- SPARK_Pragma (Node40)
-- SPARK_Aux_Pragma (Node41)
-- Delay_Cleanups (Flag114)
......
gcc/ada/exp_ch6.adb
......@@ -7105,7 +7105,7 @@ package body Exp_Ch6 is
if Nkind (Parent (Subp)) = N_Procedure_Specification
and then Null_Present (Parent (Subp))
then
Analyze_Subprogram_Contract (Subp);
Analyze_Entry_Or_Subprogram_Contract (Subp);
end if;
end Freeze_Subprogram;
......
gcc/ada/inline.adb
......@@ -3513,6 +3513,37 @@ package body Inline is
("cannot inline & (nested procedure instantiation)?",
D, Subp);
return True;
-- Subtype declarations with predicates will generate predicate
-- functions, i.e. nested subprogram bodies, so inlining is not
-- possible.
elsif Nkind (D) = N_Subtype_Declaration
and then Present (Aspect_Specifications (D))
then
declare
A : Node_Id;
A_Id : Aspect_Id;
begin
A := First (Aspect_Specifications (D));
while Present (A) loop
A_Id := Get_Aspect_Id (Chars (Identifier (A)));
if A_Id = Aspect_Predicate
or else A_Id = Aspect_Static_Predicate
or else A_Id = Aspect_Dynamic_Predicate
then
Cannot_Inline
("cannot inline & "
& "(subtype declaration with predicate)?",
D, Subp);
return True;
end if;
Next (A);
end loop;
end;
end if;
Next (D);
......
gcc/ada/osint.ads
......@@ -760,7 +760,7 @@ private
-- for this file. This routine merely constructs the name.
procedure Write_Info (Info : String);
-- Implement Write_Binder_Info, Write_Debug_Info, and Write_Library_Info
-- Implements Write_Binder_Info, Write_Debug_Info, and Write_Library_Info
procedure Write_With_Check (A : Address; N : Integer);
-- Writes N bytes from buffer starting at address A to file whose FD is
......
gcc/ada/par-ch9.adb
......@@ -6,7 +6,7 @@
-- --
-- B o d y --
-- --
-- Copyright (C) 1992-2013, Free Software Foundation, Inc. --
-- Copyright (C) 1992-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- --
......@@ -1089,7 +1089,6 @@ package body Ch9 is
Resync_Past_Semicolon;
Pop_Scope_Stack; -- discard unused entry
return Error;
end P_Accept_Statement;
------------------------
......@@ -1098,12 +1097,45 @@ package body Ch9 is
-- Parsed by P_Expression (4.4)
--------------------------
-- 9.5.2 Entry Barrier --
--------------------------
-- ENTRY_BARRIER ::= when CONDITION
-- Error_Recovery: cannot raise Error_Resync
function P_Entry_Barrier return Node_Id is
Bnode : Node_Id;
begin
if Token = Tok_When then
Scan; -- past WHEN;
Bnode := P_Expression_No_Right_Paren;
if Token = Tok_Colon_Equal then
Error_Msg_SC -- CODEFIX
("|"":="" should be ""=""");
Scan;
Bnode := P_Expression_No_Right_Paren;
end if;
else
T_When; -- to give error message
Bnode := Error;
end if;
return Bnode;
end P_Entry_Barrier;
-----------------------
-- 9.5.2 Entry Body --
-----------------------
-- ENTRY_BODY ::=
-- entry DEFINING_IDENTIFIER ENTRY_BODY_FORMAL_PART ENTRY_BARRIER is
-- entry DEFINING_IDENTIFIER ENTRY_BODY_FORMAL_PART
-- [ASPECT_SPECIFICATIONS] ENTRY_BARRIER
-- is
-- DECLARATIVE_PART
-- begin
-- HANDLED_SEQUENCE_OF_STATEMENTS
......@@ -1114,6 +1146,7 @@ package body Ch9 is
-- Error_Recovery: cannot raise Error_Resync
function P_Entry_Body return Node_Id is
Dummy_Node : Node_Id;
Entry_Node : Node_Id;
Formal_Part_Node : Node_Id;
Name_Node : Node_Id;
......@@ -1135,8 +1168,34 @@ package body Ch9 is
Formal_Part_Node := P_Entry_Body_Formal_Part;
Set_Entry_Body_Formal_Part (Entry_Node, Formal_Part_Node);
-- Ada 2012 (AI12-0169): Aspect specifications may appear on an entry
-- body immediately after the formal part. Do not parse the aspect
-- specifications directly because the "when" of the entry barrier may
-- be interpreted as a misused "with".
if Token = Tok_With then
P_Aspect_Specifications (Entry_Node, Semicolon => False);
end if;
Set_Condition (Formal_Part_Node, P_Entry_Barrier);
-- Detect an illegal placement of aspect specifications following the
-- entry barrier.
-- entry E ... when Barrier with Aspect is
if Token = Tok_With then
Error_Msg_SC ("aspect specifications must come before entry barrier");
-- Consume the illegal aspects to allow for parsing to continue
Dummy_Node := New_Node (N_Entry_Body, Sloc (Entry_Node));
P_Aspect_Specifications (Dummy_Node, Semicolon => False);
end if;
TF_Is;
Parse_Decls_Begin_End (Entry_Node);
return Entry_Node;
end P_Entry_Body;
......@@ -1185,38 +1244,6 @@ package body Ch9 is
return Fpart_Node;
end P_Entry_Body_Formal_Part;
--------------------------
-- 9.5.2 Entry Barrier --
--------------------------
-- ENTRY_BARRIER ::= when CONDITION
-- Error_Recovery: cannot raise Error_Resync
function P_Entry_Barrier return Node_Id is
Bnode : Node_Id;
begin
if Token = Tok_When then
Scan; -- past WHEN;
Bnode := P_Expression_No_Right_Paren;
if Token = Tok_Colon_Equal then
Error_Msg_SC -- CODEFIX
("|"":="" should be ""=""");
Scan;
Bnode := P_Expression_No_Right_Paren;
end if;
else
T_When; -- to give error message
Bnode := Error;
end if;
TF_Is;
return Bnode;
end P_Entry_Barrier;
--------------------------------------
-- 9.5.2 Entry Index Specification --
--------------------------------------
......
gcc/ada/sem_attr.adb
......@@ -1330,7 +1330,7 @@ package body Sem_Attr is
if Nkind (Prag) = N_Aspect_Specification then
Subp_Decl := Parent (Prag);
else
Subp_Decl := Find_Related_Subprogram_Or_Body (Prag);
Subp_Decl := Find_Related_Declaration_Or_Body (Prag);
end if;
-- The aspect or pragma where the attribute resides should be
......
gcc/ada/sem_aux.adb
......@@ -819,8 +819,8 @@ package body Sem_Aux is
-- Generic subprogram body
elsif Is_Subprogram (S)
and then Nkind (Unit_Declaration_Node (S))
= N_Generic_Subprogram_Declaration
and then Nkind (Unit_Declaration_Node (S)) =
N_Generic_Subprogram_Declaration
then
return True;
end if;
......@@ -1649,6 +1649,8 @@ package body Sem_Aux is
-- Isn't there some better way to express the following ???
while Nkind (N) /= N_Abstract_Subprogram_Declaration
and then Nkind (N) /= N_Entry_Body
and then Nkind (N) /= N_Entry_Declaration
and then Nkind (N) /= N_Formal_Package_Declaration
and then Nkind (N) /= N_Function_Instantiation
and then Nkind (N) /= N_Generic_Package_Declaration
......
gcc/ada/sem_ch10.adb
......@@ -939,7 +939,7 @@ package body Sem_Ch10 is
if Nkind_In (Unit_Node, N_Generic_Subprogram_Declaration,
N_Subprogram_Declaration)
then
Analyze_Subprogram_Contract (Defining_Entity (Unit_Node));
Analyze_Entry_Or_Subprogram_Contract (Defining_Entity (Unit_Node));
end if;
-- Generate distribution stubs if requested and no error
......
gcc/ada/sem_ch12.adb
......@@ -14796,10 +14796,9 @@ package body Sem_Ch12 is
elsif Is_Generic_Contract_Pragma (Prag) and then Prag /= Templ then
if Is_Package_Contract_Annotation (Prag) then
Context := Find_Related_Package_Or_Body (Prag);
else
pragma Assert (Is_Subprogram_Contract_Annotation (Prag));
Context := Find_Related_Subprogram_Or_Body (Prag);
Context := Find_Related_Declaration_Or_Body (Prag);
end if;
-- The use of Original_Node accounts for the case when the
......
gcc/ada/sem_ch13.adb
......@@ -3474,9 +3474,9 @@ package body Sem_Ch13 is
Body_Id : constant Entity_Id := Defining_Entity (N);
procedure Diagnose_Misplaced_Aspects (Spec_Id : Entity_Id);
-- Subprogram body [stub] N has aspects, but they are not properly
-- placed. Emit an error message depending on the aspects involved.
-- Spec_Id is the entity of the corresponding spec.
-- Body [stub] N has aspects, but they are not properly placed. Emit an
-- error message depending on the aspects involved. Spec_Id denotes the
-- entity of the corresponding spec.
--------------------------------
-- Diagnose_Misplaced_Aspects --
......@@ -3532,7 +3532,7 @@ package body Sem_Ch13 is
else
Error_Msg_N
("aspect specification must appear in subprogram declaration",
("aspect specification must appear on initial declaration",
Asp);
end if;
end Misplaced_Aspect_Error;
......@@ -3574,7 +3574,7 @@ package body Sem_Ch13 is
else
Error_Msg_N
("aspect specification must appear in subprogram declaration",
("aspect specification must appear on initial declaration",
Asp);
end if;
......@@ -3584,23 +3584,17 @@ package body Sem_Ch13 is
-- Local variables
Spec_Id : Entity_Id;
Spec_Id : constant Entity_Id := Unique_Defining_Entity (N);
-- Start of processing for Analyze_Aspects_On_Body_Or_Stub
begin
if Nkind (N) = N_Subprogram_Body_Stub then
Spec_Id := Corresponding_Spec_Of_Stub (N);
else
Spec_Id := Corresponding_Spec (N);
end if;
-- Language-defined aspects cannot be associated with a subprogram body
-- [stub] if the subprogram has a spec. Certain implementation defined
-- aspects are allowed to break this rule (for all applicable cases, see
-- table Aspects.Aspect_On_Body_Or_Stub_OK).
if Present (Spec_Id) and then not Aspects_On_Body_Or_Stub_OK (N) then
if Spec_Id /= Body_Id and then not Aspects_On_Body_Or_Stub_OK (N) then
Diagnose_Misplaced_Aspects (Spec_Id);
else
Analyze_Aspect_Specifications (N, Body_Id);
......
gcc/ada/sem_ch3.adb
......@@ -2505,16 +2505,23 @@ package body Sem_Ch3 is
Analyze_Object_Contract (Defining_Entity (Decl));
elsif Nkind_In (Decl, N_Abstract_Subprogram_Declaration,
N_Entry_Declaration,
N_Generic_Subprogram_Declaration,
N_Subprogram_Declaration)
then
Analyze_Subprogram_Contract (Defining_Entity (Decl));
Analyze_Entry_Or_Subprogram_Contract (Defining_Entity (Decl));
elsif Nkind (Decl) = N_Subprogram_Body then
Analyze_Subprogram_Body_Contract (Defining_Entity (Decl));
elsif Nkind_In (Decl, N_Entry_Body, N_Subprogram_Body) then
Analyze_Entry_Or_Subprogram_Body_Contract
(Defining_Entity (Decl));
elsif Nkind (Decl) = N_Subprogram_Body_Stub then
Analyze_Subprogram_Body_Stub_Contract (Defining_Entity (Decl));
elsif Nkind_In (Decl, N_Single_Task_Declaration,
N_Task_Type_Declaration)
then
Analyze_Task_Contract (Defining_Entity (Decl));
end if;
Next (Decl);
......
gcc/ada/sem_ch6.adb
......@@ -1385,7 +1385,7 @@ package body Sem_Ch6 is
-- have been analyzed. This ensures that any contract-related pragmas
-- are available through the N_Contract node of the body.
Analyze_Subprogram_Body_Contract (Body_Id);
Analyze_Entry_Or_Subprogram_Body_Contract (Body_Id);
Analyze (Handled_Statement_Sequence (N));
Save_Global_References (Original_Node (N));
......@@ -3789,7 +3789,7 @@ package body Sem_Ch6 is
-- after the declarations of the body have been processed as pragmas
-- are now chained on the contract of the subprogram body.
Analyze_Subprogram_Body_Contract (Body_Id);
Analyze_Entry_Or_Subprogram_Body_Contract (Body_Id);
-- If SPARK_Mode for body is not On, disable frontend inlining for this
-- subprogram in GNATprove mode, as its body should not be analyzed.
......
gcc/ada/sem_ch9.adb
......@@ -1213,8 +1213,8 @@ package body Sem_Ch9 is
Set_Ekind (Id, E_Entry);
end if;
Set_Scope (Id, Current_Scope);
Set_Etype (Id, Standard_Void_Type);
Set_Scope (Id, Current_Scope);
Set_Accept_Address (Id, New_Elmt_List);
-- Set the SPARK_Mode from the current context (may be overwritten later
......@@ -1223,6 +1223,12 @@ package body Sem_Ch9 is
Set_SPARK_Pragma (Id, SPARK_Mode_Pragma);
Set_SPARK_Pragma_Inherited (Id);
-- Analyze any aspect specifications that appear on the entry body
if Has_Aspects (N) then
Analyze_Aspect_Specifications_On_Body_Or_Stub (N);
end if;
E := First_Entity (P_Type);
while Present (E) loop
if Chars (E) = Chars (Id)
......@@ -1352,6 +1358,12 @@ package body Sem_Ch9 is
Inspect_Deferred_Constant_Completion (Decls);
end if;
-- Process the contract of the subprogram body after all declarations
-- have been analyzed. This ensures that any contract-related pragmas
-- are available through the N_Contract node of the body.
Analyze_Entry_Or_Subprogram_Body_Contract (Id);
if Present (Stats) then
Analyze (Stats);
end if;
......
gcc/ada/sem_prag.ads
......@@ -327,22 +327,29 @@ package Sem_Prag is
-- the pragma is illegal. If flag Do_Checks is set, the routine reports
-- duplicate pragmas.
function Find_Related_Subprogram_Or_Body
function Find_Related_Declaration_Or_Body
(Prag : Node_Id;
Do_Checks : Boolean := False) return Node_Id;
-- Subsidiary to the analysis of pragmas Contract_Cases, Depends, Global,
-- Refined_Depends, Refined_Global and Refined_Post and attribute 'Result.
-- Find the declaration of the related subprogram [body or stub] subject
-- to pragma Prag. If flag Do_Checks is set, the routine reports duplicate
-- pragmas and detects improper use of refinement pragmas in stand alone
-- expression functions. The returned value depends on the related pragma
-- as follows:
-- 1) Pragmas Contract_Cases, Depends and Global yield the corresponding
-- N_Subprogram_Declaration node or if the pragma applies to a stand
-- alone body, the N_Subprogram_Body node or Empty if illegal.
-- 2) Pragmas Refined_Depends, Refined_Global and Refined_Post yield
-- N_Subprogram_Body or N_Subprogram_Body_Stub nodes or Empty if
-- illegal.
-- Subsidiary to the analysis of pragmas
-- Contract_Cases
-- Depends
-- Extensions_Visible
-- Global
-- Post
-- Post_Class
-- Postcondition
-- Pre
-- Pre_Class
-- Precondition
-- Refined_Depends
-- Refined_Global
-- Refined_Post
-- Test_Case
-- as well as attributes 'Old and 'Result. Find the declaration of the
-- related entry, subprogram or task type [body] subject to pragma Prag.
-- If flag Do_Checks is set, the routine reports duplicate pragmas and
-- detects improper use of refinement pragmas in stand alone expression
-- functions.
function Get_Argument
(Prag : Node_Id;
......
gcc/ada/sem_util.adb
......@@ -11444,6 +11444,28 @@ package body Sem_Util is
end if;
end Is_Effectively_Volatile_Object;
-------------------
-- Is_Entry_Body --
-------------------
function Is_Entry_Body (Id : Entity_Id) return Boolean is
begin
return
Ekind_In (Id, E_Entry, E_Entry_Family)
and then Nkind (Unit_Declaration_Node (Id)) = N_Entry_Body;
end Is_Entry_Body;
--------------------------
-- Is_Entry_Declaration --
--------------------------
function Is_Entry_Declaration (Id : Entity_Id) return Boolean is
begin
return
Ekind_In (Id, E_Entry, E_Entry_Family)
and then Nkind (Unit_Declaration_Node (Id)) = N_Entry_Declaration;
end Is_Entry_Declaration;
----------------------------
-- Is_Expression_Function --
----------------------------
......
gcc/ada/sem_util.ads
......@@ -1283,6 +1283,12 @@ package Sem_Util is
-- Determine whether an arbitrary node denotes an effectively volatile
-- object (SPARK RM 7.1.2).
function Is_Entry_Body (Id : Entity_Id) return Boolean;
-- Determine whether entity Id is the body entity of an entry [family]
function Is_Entry_Declaration (Id : Entity_Id) return Boolean;
-- Determine whether entity Id is the spec entity of an entry [family]
function Is_Expression_Function (Subp : Entity_Id) return Boolean;
-- Predicate to determine whether a scope entity comes from a rewritten
-- expression function call, and should be inlined unconditionally. Also
......
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