mirror of
git://gcc.gnu.org/git/gcc.git
synced 2025-04-10 22:31:24 +08:00
[multiple changes]
2013-10-10 Hristian Kirtchev <kirtchev@adacore.com> * aspects.adb: Add entries in table Canonical_Aspects for aspects Refined_Depends and Refined_Global. * aspects.ads: Add entries in tables Aspect_Id, Aspect_Argument, Aspect_Names, Aspect_Declay, Aspect_On_Body_Or_Stub_OK for aspects Refined_Depends and Refined_Global. * einfo.adb (Contract): Subprogram bodies are now valid owners of contracts. (Set_Contract): Subprogram bodies are now valid owners of contracts. (Write_Field24_Name): Output the contract attribute for subprogram bodies. * exp_ch6.adb (Expand_Subprogram_Contract): New routine. * exp_ch6.ads (Expand_Subprogram_Contract): New routine. * par-prag.adb: Pragmas Refined_Depends and Refined_Global do not require any special processing by the parser. * sem_ch3.adb (Adjust_D): Renamed to Adjust_Decl. (Analyze_Declarations): Code reformatting. Analyze the contract of a subprogram body at the end of the declarative region. * sem_ch6.adb (Analyze_Generic_Subprogram_Body): Subprogram bodies can now have contracts. Use Expand_Subprogram_Contract to handle the various contract assertions. (Analyze_Subprogram_Body_Contract): New null routine. (Analyze_Subprogram_Body_Helper): Subprogram bodies can now have contracts. Use Expand_Subprogram_Contract to handle the various contract assertions. (Analyze_Subprogram_Contract): Add local variable Nam. Update the call to Analyze_PPC_In_Decl_Part. Capture the pragma name in Nam. (Process_PPCs): Removed. * sem_ch6.ads (Analyze_Subprogram_Body_Contract): New routine. (Analyze_Subprogram_Contract): Update the comment on usage. * sem_ch13.adb (Analyze_Aspect_Specifications): Add null implementations for aspects Refined_Depends and Refined_Global. (Check_Aspect_At_Freeze_Point): Aspects Refined_Depends and Refined_Global do not need to be checked at the freeze point. * sem_prag.adb: Add entries in table Sig_Flags for pragmas Refined_Depends and Refined_Global. (Analyze_Contract_Cases_In_Decl_Part): Add local variable Restore. Use Restore to pop the scope. (Analyze_Depends_In_Decl_Part): Add local variable Restore. Use Restore to pop the scope. (Analyze_Global_In_Decl_List): Add local variable Restore. Use Restore to pop the scope. (Analyze_PPC_In_Decl_Part): Renamed to Analyze_Pre_Post_Condition_In_Decl_Part. (Analyze_Pragma): Add null implementations for pragmas Refined_Depends and Refined_Global. Refined_Pre and Refined_Post are now handled by routine Analyze_Refined_Pre_Post_Condition exclusively. (Analyze_Refined_Depends_In_Decl_Part): New null routine. (Analyze_Refined_Global_In_Decl_Part): New null routine. (Analyze_Refined_Pre_Post): Renamed to Analyze_Refined_Pre_Post_Condition. (Analyze_Refined_Pre_Post_Condition): Analyze the boolean expression. (Check_Precondition_Postcondition): Update the call to Analyze_PPC_In_Decl_Part. * sem_prag.ads: Add entries in table Pragma_On_Body_Or_Stub_OK for pragmas Refined_Depends and Refined_Global. (Analyze_PPC_In_Decl_Part): Renamed to Analyze_Pre_Post_Condition_In_Decl_Part. Update the comment on usage. (Analyze_Refined_Depends_In_Decl_Part): New routine. (Analyze_Refined_Global_In_Decl_Part): New routine. (Analyze_Test_Case_In_Decl_Part): Update the comment on usage. * sem_util.adb (Add_Contract_Item): Rename formal Item to Prag and update all occurrences. Subprogram body contracts can now contain pragmas Refined_Depends and Refined_Global. * sem_util.ads (Add_Contract_Item): Rename formal Item to Prag. Update the comment on usage. * sinfo.ads: Update the comment on structure and usage of N_Contract. * snames.ads-tmpl: Add new predefined names for Refined_Depends and Refined_Global. Add entries in table Pragma_Id for Refined_Depends and Refined_Global. 2013-10-10 Robert Dewar <dewar@adacore.com> * types.ads: Minor reformatting. From-SVN: r203365
This commit is contained in:
parent
c76bf0bffd
commit
ea3c0651d3
@ -1,3 +1,90 @@
|
||||
2013-10-10 Hristian Kirtchev <kirtchev@adacore.com>
|
||||
|
||||
* aspects.adb: Add entries in table Canonical_Aspects for aspects
|
||||
Refined_Depends and Refined_Global.
|
||||
* aspects.ads: Add entries in tables Aspect_Id, Aspect_Argument,
|
||||
Aspect_Names, Aspect_Declay, Aspect_On_Body_Or_Stub_OK for
|
||||
aspects Refined_Depends and Refined_Global.
|
||||
* einfo.adb (Contract): Subprogram bodies are now valid owners
|
||||
of contracts.
|
||||
(Set_Contract): Subprogram bodies are now valid
|
||||
owners of contracts.
|
||||
(Write_Field24_Name): Output the contract
|
||||
attribute for subprogram bodies.
|
||||
* exp_ch6.adb (Expand_Subprogram_Contract): New routine.
|
||||
* exp_ch6.ads (Expand_Subprogram_Contract): New routine.
|
||||
* par-prag.adb: Pragmas Refined_Depends and Refined_Global do
|
||||
not require any special processing by the parser.
|
||||
* sem_ch3.adb (Adjust_D): Renamed to Adjust_Decl.
|
||||
(Analyze_Declarations): Code reformatting. Analyze the contract
|
||||
of a subprogram body at the end of the declarative region.
|
||||
* sem_ch6.adb (Analyze_Generic_Subprogram_Body):
|
||||
Subprogram bodies can now have contracts. Use
|
||||
Expand_Subprogram_Contract to handle the various contract
|
||||
assertions.
|
||||
(Analyze_Subprogram_Body_Contract): New null routine.
|
||||
(Analyze_Subprogram_Body_Helper): Subprogram bodies can now have
|
||||
contracts. Use Expand_Subprogram_Contract to handle the various
|
||||
contract assertions.
|
||||
(Analyze_Subprogram_Contract): Add local
|
||||
variable Nam. Update the call to Analyze_PPC_In_Decl_Part. Capture
|
||||
the pragma name in Nam.
|
||||
(Process_PPCs): Removed.
|
||||
* sem_ch6.ads (Analyze_Subprogram_Body_Contract): New routine.
|
||||
(Analyze_Subprogram_Contract): Update the comment on usage.
|
||||
* sem_ch13.adb (Analyze_Aspect_Specifications): Add null
|
||||
implementations for aspects Refined_Depends and Refined_Global.
|
||||
(Check_Aspect_At_Freeze_Point): Aspects Refined_Depends and
|
||||
Refined_Global do not need to be checked at the freeze point.
|
||||
* sem_prag.adb: Add entries in table Sig_Flags
|
||||
for pragmas Refined_Depends and Refined_Global.
|
||||
(Analyze_Contract_Cases_In_Decl_Part): Add local
|
||||
variable Restore. Use Restore to pop the scope.
|
||||
(Analyze_Depends_In_Decl_Part): Add local variable Restore. Use
|
||||
Restore to pop the scope.
|
||||
(Analyze_Global_In_Decl_List): Add local variable Restore. Use Restore
|
||||
to pop the scope.
|
||||
(Analyze_PPC_In_Decl_Part): Renamed to
|
||||
Analyze_Pre_Post_Condition_In_Decl_Part.
|
||||
(Analyze_Pragma):
|
||||
Add null implementations for pragmas Refined_Depends and
|
||||
Refined_Global. Refined_Pre and Refined_Post are now
|
||||
handled by routine Analyze_Refined_Pre_Post_Condition
|
||||
exclusively.
|
||||
(Analyze_Refined_Depends_In_Decl_Part): New
|
||||
null routine.
|
||||
(Analyze_Refined_Global_In_Decl_Part):
|
||||
New null routine.
|
||||
(Analyze_Refined_Pre_Post):
|
||||
Renamed to Analyze_Refined_Pre_Post_Condition.
|
||||
(Analyze_Refined_Pre_Post_Condition): Analyze the boolean
|
||||
expression.
|
||||
(Check_Precondition_Postcondition): Update the call
|
||||
to Analyze_PPC_In_Decl_Part.
|
||||
* sem_prag.ads: Add entries in table
|
||||
Pragma_On_Body_Or_Stub_OK for pragmas Refined_Depends
|
||||
and Refined_Global.
|
||||
(Analyze_PPC_In_Decl_Part): Renamed
|
||||
to Analyze_Pre_Post_Condition_In_Decl_Part. Update the
|
||||
comment on usage.
|
||||
(Analyze_Refined_Depends_In_Decl_Part): New routine.
|
||||
(Analyze_Refined_Global_In_Decl_Part): New routine.
|
||||
(Analyze_Test_Case_In_Decl_Part): Update the comment on usage.
|
||||
* sem_util.adb (Add_Contract_Item): Rename formal Item to Prag
|
||||
and update all occurrences. Subprogram body contracts can now
|
||||
contain pragmas Refined_Depends and Refined_Global.
|
||||
* sem_util.ads (Add_Contract_Item): Rename formal Item to
|
||||
Prag. Update the comment on usage.
|
||||
* sinfo.ads: Update the comment on structure and usage of
|
||||
N_Contract.
|
||||
* snames.ads-tmpl: Add new predefined names for Refined_Depends
|
||||
and Refined_Global. Add entries in table Pragma_Id for
|
||||
Refined_Depends and Refined_Global.
|
||||
|
||||
2013-10-10 Robert Dewar <dewar@adacore.com>
|
||||
|
||||
* types.ads: Minor reformatting.
|
||||
|
||||
2013-10-10 Thomas Quinot <quinot@adacore.com>
|
||||
|
||||
* s-taprop-posix.adb: Add missing comment.
|
||||
|
@ -466,6 +466,8 @@ package body Aspects is
|
||||
Aspect_Pure_05 => Aspect_Pure_05,
|
||||
Aspect_Pure_12 => Aspect_Pure_12,
|
||||
Aspect_Pure_Function => Aspect_Pure_Function,
|
||||
Aspect_Refined_Depends => Aspect_Refined_Depends,
|
||||
Aspect_Refined_Global => Aspect_Refined_Global,
|
||||
Aspect_Refined_Post => Aspect_Refined_Post,
|
||||
Aspect_Refined_Pre => Aspect_Refined_Pre,
|
||||
Aspect_Remote_Access_Type => Aspect_Remote_Access_Type,
|
||||
|
@ -111,6 +111,8 @@ package Aspects is
|
||||
Aspect_Predicate, -- GNAT
|
||||
Aspect_Priority,
|
||||
Aspect_Read,
|
||||
Aspect_Refined_Depends, -- GNAT
|
||||
Aspect_Refined_Global, -- GNAT
|
||||
Aspect_Refined_Post, -- GNAT
|
||||
Aspect_Refined_Pre, -- GNAT
|
||||
Aspect_Relative_Deadline,
|
||||
@ -321,6 +323,8 @@ package Aspects is
|
||||
Aspect_Predicate => Expression,
|
||||
Aspect_Priority => Expression,
|
||||
Aspect_Read => Name,
|
||||
Aspect_Refined_Depends => Expression,
|
||||
Aspect_Refined_Global => Expression,
|
||||
Aspect_Refined_Post => Expression,
|
||||
Aspect_Refined_Pre => Expression,
|
||||
Aspect_Relative_Deadline => Expression,
|
||||
@ -419,6 +423,8 @@ package Aspects is
|
||||
Aspect_Pure_12 => Name_Pure_12,
|
||||
Aspect_Pure_Function => Name_Pure_Function,
|
||||
Aspect_Read => Name_Read,
|
||||
Aspect_Refined_Depends => Name_Refined_Depends,
|
||||
Aspect_Refined_Global => Name_Refined_Global,
|
||||
Aspect_Refined_Post => Name_Refined_Post,
|
||||
Aspect_Refined_Pre => Name_Refined_Pre,
|
||||
Aspect_Relative_Deadline => Name_Relative_Deadline,
|
||||
@ -612,6 +618,8 @@ package Aspects is
|
||||
Aspect_Pure_12 => Always_Delay,
|
||||
Aspect_Pure_Function => Always_Delay,
|
||||
Aspect_Read => Always_Delay,
|
||||
Aspect_Refined_Depends => Always_Delay,
|
||||
Aspect_Refined_Global => Always_Delay,
|
||||
Aspect_Relative_Deadline => Always_Delay,
|
||||
Aspect_Remote_Access_Type => Always_Delay,
|
||||
Aspect_Remote_Call_Interface => Always_Delay,
|
||||
@ -703,7 +711,9 @@ package Aspects is
|
||||
-- Sem_Prag if the aspects below are implemented by a pragma.
|
||||
|
||||
Aspect_On_Body_Or_Stub_OK : constant array (Aspect_Id) of Boolean :=
|
||||
(Aspect_Refined_Post => True,
|
||||
(Aspect_Refined_Depends => True,
|
||||
Aspect_Refined_Global => True,
|
||||
Aspect_Refined_Post => True,
|
||||
Aspect_Refined_Pre => True,
|
||||
Aspect_SPARK_Mode => True,
|
||||
Aspect_Warnings => True,
|
||||
|
@ -1065,7 +1065,7 @@ package body Einfo is
|
||||
function Contract (Id : E) return N is
|
||||
begin
|
||||
pragma Assert
|
||||
(Ekind_In (Id, E_Entry, E_Entry_Family)
|
||||
(Ekind_In (Id, E_Entry, E_Entry_Family, E_Subprogram_Body)
|
||||
or else Is_Subprogram (Id)
|
||||
or else Is_Generic_Subprogram (Id));
|
||||
return Node24 (Id);
|
||||
@ -3651,7 +3651,7 @@ package body Einfo is
|
||||
procedure Set_Contract (Id : E; V : N) is
|
||||
begin
|
||||
pragma Assert
|
||||
(Ekind_In (Id, E_Entry, E_Entry_Family, E_Void)
|
||||
(Ekind_In (Id, E_Entry, E_Entry_Family, E_Subprogram_Body, E_Void)
|
||||
or else Is_Subprogram (Id)
|
||||
or else Is_Generic_Subprogram (Id));
|
||||
Set_Node24 (Id, V);
|
||||
@ -9012,10 +9012,15 @@ package body Einfo is
|
||||
|
||||
when E_Entry |
|
||||
E_Entry_Family |
|
||||
E_Subprogram_Body |
|
||||
Subprogram_Kind |
|
||||
Generic_Subprogram_Kind =>
|
||||
Write_Str ("Contract");
|
||||
|
||||
-- The Subprogram_Kind and Generic_Subrpogram_Kind entries
|
||||
-- here are odd, since the assertions for [Set_]Contract do not
|
||||
-- allow these possibilities ???
|
||||
|
||||
when others =>
|
||||
Write_Str ("Field24???");
|
||||
end case;
|
||||
|
1044
gcc/ada/exp_ch6.adb
1044
gcc/ada/exp_ch6.adb
File diff suppressed because it is too large
Load Diff
@ -82,6 +82,18 @@ package Exp_Ch6 is
|
||||
-- Subp_Id's body. All generated code is added to list Stmts. If Stmts is
|
||||
-- empty, a new list is created.
|
||||
|
||||
procedure Expand_Subprogram_Contract
|
||||
(N : Node_Id;
|
||||
Spec_Id : Entity_Id;
|
||||
Body_Id : Entity_Id);
|
||||
-- Expand the contracts of a subprogram body and its correspoding spec (if
|
||||
-- any). This routine processes all [refined] pre- and postconditions as
|
||||
-- well as Contract_Cases, invariants and predicates. N is the body of the
|
||||
-- subprogram. Spec_Id denotes the entity of its specification. Body_Id
|
||||
-- denotes the entity of the subprogram body. This routine is not a "pure"
|
||||
-- expansion mechanism as it is invoked during analysis and may perform
|
||||
-- actions for generic subprograms or set up contract assertions for ASIS.
|
||||
|
||||
procedure Freeze_Subprogram (N : Node_Id);
|
||||
-- generate the appropriate expansions related to Subprogram freeze
|
||||
-- nodes (e.g. the filling of the corresponding Dispatch Table for
|
||||
|
@ -1250,6 +1250,8 @@ begin
|
||||
Pragma_Pure_12 |
|
||||
Pragma_Pure_Function |
|
||||
Pragma_Queuing_Policy |
|
||||
Pragma_Refined_Depends |
|
||||
Pragma_Refined_Global |
|
||||
Pragma_Refined_Post |
|
||||
Pragma_Refined_Pre |
|
||||
Pragma_Relative_Deadline |
|
||||
|
@ -1928,6 +1928,20 @@ package body Sem_Ch13 is
|
||||
Expression => Relocate_Node (Expr))),
|
||||
Pragma_Name => Name_SPARK_Mode);
|
||||
|
||||
-- Refined_Depends
|
||||
|
||||
-- ??? To be implemented
|
||||
|
||||
when Aspect_Refined_Depends =>
|
||||
null;
|
||||
|
||||
-- Refined_Global
|
||||
|
||||
-- ??? To be implemented
|
||||
|
||||
when Aspect_Refined_Global =>
|
||||
null;
|
||||
|
||||
-- Refined_Post
|
||||
|
||||
when Aspect_Refined_Post =>
|
||||
@ -7962,6 +7976,8 @@ package body Sem_Ch13 is
|
||||
Aspect_Postcondition |
|
||||
Aspect_Pre |
|
||||
Aspect_Precondition |
|
||||
Aspect_Refined_Depends |
|
||||
Aspect_Refined_Global |
|
||||
Aspect_Refined_Post |
|
||||
Aspect_Refined_Pre |
|
||||
Aspect_SPARK_Mode |
|
||||
|
@ -2056,28 +2056,31 @@ package body Sem_Ch3 is
|
||||
--------------------------
|
||||
|
||||
procedure Analyze_Declarations (L : List_Id) is
|
||||
D : Node_Id;
|
||||
Freeze_From : Entity_Id := Empty;
|
||||
Next_Node : Node_Id;
|
||||
Decl : Node_Id;
|
||||
|
||||
procedure Adjust_D;
|
||||
-- Adjust D not to include implicit label declarations, since these
|
||||
procedure Adjust_Decl;
|
||||
-- Adjust Decl not to include implicit label declarations, since these
|
||||
-- have strange Sloc values that result in elaboration check problems.
|
||||
-- (They have the sloc of the label as found in the source, and that
|
||||
-- is ahead of the current declarative part).
|
||||
|
||||
--------------
|
||||
-- Adjust_D --
|
||||
--------------
|
||||
-----------------
|
||||
-- Adjust_Decl --
|
||||
-----------------
|
||||
|
||||
procedure Adjust_D is
|
||||
procedure Adjust_Decl is
|
||||
begin
|
||||
while Present (Prev (D))
|
||||
and then Nkind (D) = N_Implicit_Label_Declaration
|
||||
while Present (Prev (Decl))
|
||||
and then Nkind (Decl) = N_Implicit_Label_Declaration
|
||||
loop
|
||||
Prev (D);
|
||||
Prev (Decl);
|
||||
end loop;
|
||||
end Adjust_D;
|
||||
end Adjust_Decl;
|
||||
|
||||
-- Local variables
|
||||
|
||||
Freeze_From : Entity_Id := Empty;
|
||||
Next_Decl : Node_Id;
|
||||
|
||||
-- Start of processing for Analyze_Declarations
|
||||
|
||||
@ -2086,23 +2089,23 @@ package body Sem_Ch3 is
|
||||
Check_Later_Vs_Basic_Declarations (L, During_Parsing => False);
|
||||
end if;
|
||||
|
||||
D := First (L);
|
||||
while Present (D) loop
|
||||
Decl := First (L);
|
||||
while Present (Decl) loop
|
||||
|
||||
-- Package spec cannot contain a package declaration in SPARK
|
||||
|
||||
if Nkind (D) = N_Package_Declaration
|
||||
if Nkind (Decl) = N_Package_Declaration
|
||||
and then Nkind (Parent (L)) = N_Package_Specification
|
||||
then
|
||||
Check_SPARK_Restriction
|
||||
("package specification cannot contain a package declaration",
|
||||
D);
|
||||
Decl);
|
||||
end if;
|
||||
|
||||
-- Complete analysis of declaration
|
||||
|
||||
Analyze (D);
|
||||
Next_Node := Next (D);
|
||||
Analyze (Decl);
|
||||
Next_Decl := Next (Decl);
|
||||
|
||||
if No (Freeze_From) then
|
||||
Freeze_From := First_Entity (Current_Scope);
|
||||
@ -2124,7 +2127,7 @@ package body Sem_Ch3 is
|
||||
-- be a freeze point once delayed freezing of bodies is implemented.
|
||||
-- (This is needed in any case for early instantiations ???).
|
||||
|
||||
if No (Next_Node) then
|
||||
if No (Next_Decl) then
|
||||
if Nkind_In (Parent (L), N_Component_List,
|
||||
N_Task_Definition,
|
||||
N_Protected_Definition)
|
||||
@ -2136,8 +2139,8 @@ package body Sem_Ch3 is
|
||||
Freeze_From := First_Entity (Current_Scope);
|
||||
end if;
|
||||
|
||||
Adjust_D;
|
||||
Freeze_All (Freeze_From, D);
|
||||
Adjust_Decl;
|
||||
Freeze_All (Freeze_From, Decl);
|
||||
Freeze_From := Last_Entity (Current_Scope);
|
||||
|
||||
elsif Scope (Current_Scope) /= Standard_Standard
|
||||
@ -2150,8 +2153,8 @@ package body Sem_Ch3 is
|
||||
or else No (Private_Declarations (Parent (L)))
|
||||
or else Is_Empty_List (Private_Declarations (Parent (L)))
|
||||
then
|
||||
Adjust_D;
|
||||
Freeze_All (Freeze_From, D);
|
||||
Adjust_Decl;
|
||||
Freeze_All (Freeze_From, Decl);
|
||||
Freeze_From := Last_Entity (Current_Scope);
|
||||
end if;
|
||||
|
||||
@ -2170,44 +2173,39 @@ package body Sem_Ch3 is
|
||||
-- care to attach the bodies at a proper place in the tree so as to
|
||||
-- not cause unwanted freezing at that point.
|
||||
|
||||
elsif not Analyzed (Next_Node)
|
||||
and then (Nkind_In (Next_Node, N_Subprogram_Body,
|
||||
elsif not Analyzed (Next_Decl)
|
||||
and then (Nkind_In (Next_Decl, N_Subprogram_Body,
|
||||
N_Entry_Body,
|
||||
N_Package_Body,
|
||||
N_Protected_Body,
|
||||
N_Task_Body)
|
||||
or else
|
||||
Nkind (Next_Node) in N_Body_Stub)
|
||||
Nkind (Next_Decl) in N_Body_Stub)
|
||||
then
|
||||
Adjust_D;
|
||||
Freeze_All (Freeze_From, D);
|
||||
Adjust_Decl;
|
||||
Freeze_All (Freeze_From, Decl);
|
||||
Freeze_From := Last_Entity (Current_Scope);
|
||||
end if;
|
||||
|
||||
D := Next_Node;
|
||||
Decl := Next_Decl;
|
||||
end loop;
|
||||
|
||||
-- One more thing to do, we need to scan the declarations to check for
|
||||
-- any precondition/postcondition pragmas (Pre/Post aspects have by this
|
||||
-- stage been converted into corresponding pragmas). It is at this point
|
||||
-- that we analyze the expressions in such pragmas, to implement the
|
||||
-- delayed visibility requirement.
|
||||
-- Analyze the contracts of a subprogram declaration or a body now due
|
||||
-- to delayed visibility requirements of aspects.
|
||||
|
||||
declare
|
||||
Decl : Node_Id;
|
||||
Subp_Id : Entity_Id;
|
||||
Decl := First (L);
|
||||
while Present (Decl) loop
|
||||
if Nkind (Decl) = N_Subprogram_Body then
|
||||
Analyze_Subprogram_Body_Contract
|
||||
(Defining_Unit_Name (Specification (Decl)));
|
||||
|
||||
begin
|
||||
Decl := First (L);
|
||||
while Present (Decl) loop
|
||||
if Nkind (Decl) = N_Subprogram_Declaration then
|
||||
Subp_Id := Defining_Unit_Name (Specification (Decl));
|
||||
Analyze_Subprogram_Contract (Subp_Id);
|
||||
end if;
|
||||
elsif Nkind (Decl) = N_Subprogram_Declaration then
|
||||
Analyze_Subprogram_Contract
|
||||
(Defining_Unit_Name (Specification (Decl)));
|
||||
end if;
|
||||
|
||||
Next (Decl);
|
||||
end loop;
|
||||
end;
|
||||
Next (Decl);
|
||||
end loop;
|
||||
end Analyze_Declarations;
|
||||
|
||||
-----------------------------------
|
||||
|
File diff suppressed because it is too large
Load Diff
@ -46,9 +46,21 @@ package Sem_Ch6 is
|
||||
procedure Analyze_Subprogram_Declaration (N : Node_Id);
|
||||
procedure Analyze_Subprogram_Body (N : Node_Id);
|
||||
|
||||
procedure Analyze_Subprogram_Body_Contract (Subp : Entity_Id);
|
||||
-- Analyze all delayed aspects chained on the contract of subprogram body
|
||||
-- Subp as if they appeared at the end of a declarative region. The aspects
|
||||
-- in question are:
|
||||
-- Refined_Depends
|
||||
-- Refined_Global
|
||||
|
||||
procedure Analyze_Subprogram_Contract (Subp : Entity_Id);
|
||||
-- Analyze all delayed aspects chained on the contract of subprogram Subp
|
||||
-- as if they appeared at the end of a declarative region.
|
||||
-- as if they appeared at the end of a declarative region. The aspects in
|
||||
-- question are:
|
||||
-- Contract_Cases
|
||||
-- Postcondition
|
||||
-- Precondition
|
||||
-- Test_Case
|
||||
|
||||
function Analyze_Subprogram_Specification (N : Node_Id) return Entity_Id;
|
||||
-- Analyze subprogram specification in both subprogram declarations
|
||||
|
@ -404,6 +404,7 @@ package body Sem_Prag is
|
||||
Arg1 : constant Node_Id := First (Pragma_Argument_Associations (N));
|
||||
All_Cases : Node_Id;
|
||||
CCase : Node_Id;
|
||||
Restore : Boolean := False;
|
||||
Subp_Decl : Node_Id;
|
||||
Subp_Id : Entity_Id;
|
||||
|
||||
@ -431,6 +432,7 @@ package body Sem_Prag is
|
||||
-- for subprogram bodies because the formals are already visible.
|
||||
|
||||
if Requires_Profile_Installation (N, Subp_Decl) then
|
||||
Restore := True;
|
||||
Push_Scope (Subp_Id);
|
||||
Install_Formals (Subp_Id);
|
||||
end if;
|
||||
@ -441,7 +443,7 @@ package body Sem_Prag is
|
||||
Next (CCase);
|
||||
end loop;
|
||||
|
||||
if Requires_Profile_Installation (N, Subp_Decl) then
|
||||
if Restore then
|
||||
End_Scope;
|
||||
end if;
|
||||
end if;
|
||||
@ -1234,6 +1236,9 @@ package body Sem_Prag is
|
||||
Last_Clause : Node_Id;
|
||||
Subp_Decl : Node_Id;
|
||||
|
||||
Restore_Scope : Boolean := False;
|
||||
-- Gets set True if we do a Push_Scope needing a Pop_Scope on exit
|
||||
|
||||
-- Start of processing for Analyze_Depends_In_Decl_Part
|
||||
|
||||
begin
|
||||
@ -1287,6 +1292,7 @@ package body Sem_Prag is
|
||||
-- bodies because the formals are already visible.
|
||||
|
||||
if Requires_Profile_Installation (N, Subp_Decl) then
|
||||
Restore_Scope := True;
|
||||
Push_Scope (Subp_Id);
|
||||
Install_Formals (Subp_Id);
|
||||
end if;
|
||||
@ -1317,7 +1323,7 @@ package body Sem_Prag is
|
||||
Next (Clause);
|
||||
end loop;
|
||||
|
||||
if Requires_Profile_Installation (N, Subp_Decl) then
|
||||
if Restore_Scope then
|
||||
End_Scope;
|
||||
end if;
|
||||
|
||||
@ -1690,6 +1696,9 @@ package body Sem_Prag is
|
||||
List : Node_Id;
|
||||
Subp_Decl : Node_Id;
|
||||
|
||||
Restore_Scope : Boolean := False;
|
||||
-- Set True if we do a Push_Scope requiring a Pop_Scope on exit
|
||||
|
||||
-- Start of processing for Analyze_Global_In_Decl_List
|
||||
|
||||
begin
|
||||
@ -1714,171 +1723,19 @@ package body Sem_Prag is
|
||||
-- subprogram declarations.
|
||||
|
||||
if Requires_Profile_Installation (N, Subp_Decl) then
|
||||
Restore_Scope := True;
|
||||
Push_Scope (Subp_Id);
|
||||
Install_Formals (Subp_Id);
|
||||
end if;
|
||||
|
||||
Analyze_Global_List (List);
|
||||
|
||||
if Requires_Profile_Installation (N, Subp_Decl) then
|
||||
if Restore_Scope then
|
||||
End_Scope;
|
||||
end if;
|
||||
end if;
|
||||
end Analyze_Global_In_Decl_Part;
|
||||
|
||||
------------------------------
|
||||
-- Analyze_PPC_In_Decl_Part --
|
||||
------------------------------
|
||||
|
||||
procedure Analyze_PPC_In_Decl_Part (N : Node_Id; S : Entity_Id) is
|
||||
Arg1 : constant Node_Id := First (Pragma_Argument_Associations (N));
|
||||
|
||||
begin
|
||||
-- Install formals and push subprogram spec onto scope stack so that we
|
||||
-- can see the formals from the pragma.
|
||||
|
||||
Install_Formals (S);
|
||||
Push_Scope (S);
|
||||
|
||||
-- Preanalyze the boolean expression, we treat this as a spec expression
|
||||
-- (i.e. similar to a default expression).
|
||||
|
||||
-- In ASIS mode, for a pragma generated from a source aspect, analyze
|
||||
-- directly the the original aspect expression, which is shared with
|
||||
-- the generated pragma.
|
||||
|
||||
if ASIS_Mode and then Present (Corresponding_Aspect (N)) then
|
||||
Preanalyze_Assert_Expression
|
||||
(Expression (Corresponding_Aspect (N)), Standard_Boolean);
|
||||
else
|
||||
Preanalyze_Assert_Expression
|
||||
(Get_Pragma_Arg (Arg1), Standard_Boolean);
|
||||
end if;
|
||||
|
||||
-- For a class-wide condition, a reference to a controlling formal must
|
||||
-- be interpreted as having the class-wide type (or an access to such)
|
||||
-- so that the inherited condition can be properly applied to any
|
||||
-- overriding operation (see ARM12 6.6.1 (7)).
|
||||
|
||||
if Class_Present (N) then
|
||||
Class_Wide_Condition : declare
|
||||
T : constant Entity_Id := Find_Dispatching_Type (S);
|
||||
|
||||
ACW : Entity_Id := Empty;
|
||||
-- Access to T'class, created if there is a controlling formal
|
||||
-- that is an access parameter.
|
||||
|
||||
function Get_ACW return Entity_Id;
|
||||
-- If the expression has a reference to an controlling access
|
||||
-- parameter, create an access to T'class for the necessary
|
||||
-- conversions if one does not exist.
|
||||
|
||||
function Process (N : Node_Id) return Traverse_Result;
|
||||
-- ARM 6.1.1: Within the expression for a Pre'Class or Post'Class
|
||||
-- aspect for a primitive subprogram of a tagged type T, a name
|
||||
-- that denotes a formal parameter of type T is interpreted as
|
||||
-- having type T'Class. Similarly, a name that denotes a formal
|
||||
-- accessparameter of type access-to-T is interpreted as having
|
||||
-- type access-to-T'Class. This ensures the expression is well-
|
||||
-- defined for a primitive subprogram of a type descended from T.
|
||||
-- Note that this replacement is not done for selector names in
|
||||
-- parameter associations. These carry an entity for reference
|
||||
-- purposes, but semantically they are just identifiers.
|
||||
|
||||
-------------
|
||||
-- Get_ACW --
|
||||
-------------
|
||||
|
||||
function Get_ACW return Entity_Id is
|
||||
Loc : constant Source_Ptr := Sloc (N);
|
||||
Decl : Node_Id;
|
||||
|
||||
begin
|
||||
if No (ACW) then
|
||||
Decl := Make_Full_Type_Declaration (Loc,
|
||||
Defining_Identifier => Make_Temporary (Loc, 'T'),
|
||||
Type_Definition =>
|
||||
Make_Access_To_Object_Definition (Loc,
|
||||
Subtype_Indication =>
|
||||
New_Occurrence_Of (Class_Wide_Type (T), Loc),
|
||||
All_Present => True));
|
||||
|
||||
Insert_Before (Unit_Declaration_Node (S), Decl);
|
||||
Analyze (Decl);
|
||||
ACW := Defining_Identifier (Decl);
|
||||
Freeze_Before (Unit_Declaration_Node (S), ACW);
|
||||
end if;
|
||||
|
||||
return ACW;
|
||||
end Get_ACW;
|
||||
|
||||
-------------
|
||||
-- Process --
|
||||
-------------
|
||||
|
||||
function Process (N : Node_Id) return Traverse_Result is
|
||||
Loc : constant Source_Ptr := Sloc (N);
|
||||
Typ : Entity_Id;
|
||||
|
||||
begin
|
||||
if Is_Entity_Name (N)
|
||||
and then Present (Entity (N))
|
||||
and then Is_Formal (Entity (N))
|
||||
and then Nkind (Parent (N)) /= N_Type_Conversion
|
||||
and then
|
||||
(Nkind (Parent (N)) /= N_Parameter_Association
|
||||
or else N /= Selector_Name (Parent (N)))
|
||||
then
|
||||
if Etype (Entity (N)) = T then
|
||||
Typ := Class_Wide_Type (T);
|
||||
|
||||
elsif Is_Access_Type (Etype (Entity (N)))
|
||||
and then Designated_Type (Etype (Entity (N))) = T
|
||||
then
|
||||
Typ := Get_ACW;
|
||||
else
|
||||
Typ := Empty;
|
||||
end if;
|
||||
|
||||
if Present (Typ) then
|
||||
Rewrite (N,
|
||||
Make_Type_Conversion (Loc,
|
||||
Subtype_Mark =>
|
||||
New_Occurrence_Of (Typ, Loc),
|
||||
Expression => New_Occurrence_Of (Entity (N), Loc)));
|
||||
Set_Etype (N, Typ);
|
||||
end if;
|
||||
end if;
|
||||
|
||||
return OK;
|
||||
end Process;
|
||||
|
||||
procedure Replace_Type is new Traverse_Proc (Process);
|
||||
|
||||
-- Start of processing for Class_Wide_Condition
|
||||
|
||||
begin
|
||||
if not Present (T) then
|
||||
Error_Msg_Name_1 :=
|
||||
Chars (Identifier (Corresponding_Aspect (N)));
|
||||
|
||||
Error_Msg_Name_2 := Name_Class;
|
||||
|
||||
Error_Msg_N
|
||||
("aspect `%''%` can only be specified for a primitive "
|
||||
& "operation of a tagged type", Corresponding_Aspect (N));
|
||||
end if;
|
||||
|
||||
Replace_Type (Get_Pragma_Arg (Arg1));
|
||||
end Class_Wide_Condition;
|
||||
end if;
|
||||
|
||||
-- Remove the subprogram from the scope stack now that the pre-analysis
|
||||
-- of the precondition/postcondition is done.
|
||||
|
||||
End_Scope;
|
||||
end Analyze_PPC_In_Decl_Part;
|
||||
|
||||
--------------------
|
||||
-- Analyze_Pragma --
|
||||
--------------------
|
||||
@ -1922,15 +1779,9 @@ package body Sem_Prag is
|
||||
-- In Ada 95 or 05 mode, these are implementation defined pragmas, so
|
||||
-- should be caught by the No_Implementation_Pragmas restriction.
|
||||
|
||||
procedure Analyze_Refined_Pre_Post
|
||||
(Body_Decl : out Node_Id;
|
||||
Spec_Id : out Entity_Id;
|
||||
Legal : out Boolean);
|
||||
procedure Analyze_Refined_Pre_Post_Condition;
|
||||
-- Subsidiary routine to the analysis of pragmas Refined_Pre and
|
||||
-- Refined_Post. Body_Decl is the declaration of the subprogram body
|
||||
-- [stub] subject to the pragma. Spec_Id is the corresponding spec of
|
||||
-- the subprogram body [stub]. Flag Legal denotes whether the pragma
|
||||
-- passes all legality rules.
|
||||
-- Refined_Post.
|
||||
|
||||
procedure Check_Ada_83_Warning;
|
||||
-- Issues a warning message for the current pragma if operating in Ada
|
||||
@ -2458,26 +2309,18 @@ package body Sem_Prag is
|
||||
end if;
|
||||
end Ada_2012_Pragma;
|
||||
|
||||
------------------------------
|
||||
-- Analyze_Refined_Pre_Post --
|
||||
------------------------------
|
||||
----------------------------------------
|
||||
-- Analyze_Refined_Pre_Post_Condition --
|
||||
----------------------------------------
|
||||
|
||||
procedure Analyze_Refined_Pre_Post
|
||||
(Body_Decl : out Node_Id;
|
||||
Spec_Id : out Entity_Id;
|
||||
Legal : out Boolean)
|
||||
is
|
||||
procedure Analyze_Refined_Pre_Post_Condition is
|
||||
Body_Decl : Node_Id := Parent (N);
|
||||
Pack_Spec : Node_Id;
|
||||
Spec_Decl : Node_Id;
|
||||
Spec_Id : Entity_Id;
|
||||
Stmt : Node_Id;
|
||||
|
||||
begin
|
||||
-- Assume that the pragma is illegal
|
||||
|
||||
Body_Decl := Parent (N);
|
||||
Spec_Id := Empty;
|
||||
Legal := False;
|
||||
|
||||
GNAT_Pragma;
|
||||
Check_Arg_Count (1);
|
||||
Check_No_Identifiers;
|
||||
@ -2576,10 +2419,10 @@ package body Sem_Prag is
|
||||
return;
|
||||
end if;
|
||||
|
||||
-- If we get here, the placement and legality of the pragma is OK
|
||||
-- Analyze the boolean expression as a "spec expression"
|
||||
|
||||
Legal := True;
|
||||
end Analyze_Refined_Pre_Post;
|
||||
Analyze_Pre_Post_Condition_In_Decl_Part (N, Spec_Id);
|
||||
end Analyze_Refined_Pre_Post_Condition;
|
||||
|
||||
--------------------------
|
||||
-- Check_Ada_83_Warning --
|
||||
@ -3791,7 +3634,7 @@ package body Sem_Prag is
|
||||
-- analyzed.
|
||||
|
||||
if SPARK_Mode or else ASIS_Mode then
|
||||
Analyze_PPC_In_Decl_Part
|
||||
Analyze_Pre_Post_Condition_In_Decl_Part
|
||||
(N, Defining_Entity (Unit (Parent (PO))));
|
||||
end if;
|
||||
|
||||
@ -16092,32 +15935,35 @@ package body Sem_Prag is
|
||||
when Pragma_Rational =>
|
||||
Set_Rational_Profile;
|
||||
|
||||
---------------------
|
||||
-- Refined_Depends --
|
||||
---------------------
|
||||
|
||||
-- ??? To be implemented
|
||||
|
||||
when Pragma_Refined_Depends =>
|
||||
null;
|
||||
|
||||
--------------------
|
||||
-- Refined_Global --
|
||||
--------------------
|
||||
|
||||
-- ??? To be implemented
|
||||
|
||||
-- Would be better if these generated an error message saying that
|
||||
-- the feature was not yet implemented ???
|
||||
|
||||
when Pragma_Refined_Global =>
|
||||
null;
|
||||
|
||||
------------------
|
||||
-- Refined_Post --
|
||||
------------------
|
||||
|
||||
-- pragma Refined_Post (boolean_EXPRESSION);
|
||||
|
||||
when Pragma_Refined_Post => Refined_Post : declare
|
||||
Body_Decl : Node_Id;
|
||||
Legal : Boolean;
|
||||
Spec_Id : Entity_Id;
|
||||
|
||||
begin
|
||||
-- Verify the legal placement of the pragma. The pragma is left
|
||||
-- intentionally semi-analyzed. Process_PPCs does the remaining
|
||||
-- analysis of the expression when Refined_Post is converted into
|
||||
-- pragma Check.
|
||||
|
||||
Analyze_Refined_Pre_Post (Body_Decl, Spec_Id, Legal);
|
||||
|
||||
-- Analyze the expression when code generation is disabled because
|
||||
-- the contract of the related subprogram will never be processed.
|
||||
|
||||
if Legal and then not Expander_Active then
|
||||
Analyze_And_Resolve (Get_Pragma_Arg (Arg1), Standard_Boolean);
|
||||
end if;
|
||||
end Refined_Post;
|
||||
when Pragma_Refined_Post =>
|
||||
Analyze_Refined_Pre_Post_Condition;
|
||||
|
||||
-----------------
|
||||
-- Refined_Pre --
|
||||
@ -16125,48 +15971,8 @@ package body Sem_Prag is
|
||||
|
||||
-- pragma Refined_Pre (boolean_EXPRESSION);
|
||||
|
||||
when Pragma_Refined_Pre => Refined_Pre : declare
|
||||
Body_Decl : Node_Id;
|
||||
Legal : Boolean;
|
||||
Restore : Boolean := False;
|
||||
Spec_Id : Entity_Id;
|
||||
|
||||
begin
|
||||
Analyze_Refined_Pre_Post (Body_Decl, Spec_Id, Legal);
|
||||
|
||||
if Legal then
|
||||
pragma Assert (Present (Body_Decl));
|
||||
pragma Assert (Present (Spec_Id));
|
||||
|
||||
if Nkind (Body_Decl) = N_Subprogram_Body_Stub
|
||||
and then No (Library_Unit (Body_Decl))
|
||||
and then Current_Scope /= Spec_Id
|
||||
then
|
||||
Restore := True;
|
||||
Push_Scope (Spec_Id);
|
||||
Install_Formals (Spec_Id);
|
||||
end if;
|
||||
|
||||
-- Convert pragma Refined_Pre into pragma Check. The analysis
|
||||
-- of the generated pragma will take care of the expression.
|
||||
|
||||
Rewrite (N,
|
||||
Make_Pragma (Loc,
|
||||
Chars => Name_Check,
|
||||
Pragma_Argument_Associations => New_List (
|
||||
Make_Pragma_Argument_Association (Loc,
|
||||
Expression => Make_Identifier (Loc, Pname)),
|
||||
|
||||
Make_Pragma_Argument_Association (Sloc (Arg1),
|
||||
Expression => Relocate_Node (Get_Pragma_Arg (Arg1))))));
|
||||
|
||||
Analyze (N);
|
||||
|
||||
if Restore then
|
||||
Pop_Scope;
|
||||
end if;
|
||||
end if;
|
||||
end Refined_Pre;
|
||||
when Pragma_Refined_Pre =>
|
||||
Analyze_Refined_Pre_Post_Condition;
|
||||
|
||||
-----------------------
|
||||
-- Relative_Deadline --
|
||||
@ -18499,6 +18305,195 @@ package body Sem_Prag is
|
||||
when Pragma_Exit => null;
|
||||
end Analyze_Pragma;
|
||||
|
||||
---------------------------------------------
|
||||
-- Analyze_Pre_Post_Condition_In_Decl_Part --
|
||||
---------------------------------------------
|
||||
|
||||
procedure Analyze_Pre_Post_Condition_In_Decl_Part
|
||||
(Prag : Node_Id;
|
||||
Subp_Id : Entity_Id)
|
||||
is
|
||||
Arg1 : constant Node_Id :=
|
||||
First (Pragma_Argument_Associations (Prag));
|
||||
Expr : Node_Id;
|
||||
Restore : Boolean := False;
|
||||
|
||||
begin
|
||||
-- Ensure that the subprogram and its formals are visible when analyzing
|
||||
-- the expression of the pragma.
|
||||
|
||||
if Current_Scope /= Subp_Id then
|
||||
Restore := True;
|
||||
Push_Scope (Subp_Id);
|
||||
Install_Formals (Subp_Id);
|
||||
end if;
|
||||
|
||||
-- Preanalyze the boolean expression, we treat this as a spec expression
|
||||
-- (i.e. similar to a default expression).
|
||||
|
||||
Expr := Get_Pragma_Arg (Arg1);
|
||||
|
||||
-- In ASIS mode, for a pragma generated from a source aspect, analyze
|
||||
-- the original aspect expression, which is shared with the generated
|
||||
-- pragma.
|
||||
|
||||
if ASIS_Mode and then Present (Corresponding_Aspect (Prag)) then
|
||||
Expr := Expression (Corresponding_Aspect (Prag));
|
||||
end if;
|
||||
|
||||
Preanalyze_Assert_Expression (Expr, Standard_Boolean);
|
||||
|
||||
-- For a class-wide condition, a reference to a controlling formal must
|
||||
-- be interpreted as having the class-wide type (or an access to such)
|
||||
-- so that the inherited condition can be properly applied to any
|
||||
-- overriding operation (see ARM12 6.6.1 (7)).
|
||||
|
||||
if Class_Present (Prag) then
|
||||
Class_Wide_Condition : declare
|
||||
T : constant Entity_Id := Find_Dispatching_Type (Subp_Id);
|
||||
|
||||
ACW : Entity_Id := Empty;
|
||||
-- Access to T'class, created if there is a controlling formal
|
||||
-- that is an access parameter.
|
||||
|
||||
function Get_ACW return Entity_Id;
|
||||
-- If the expression has a reference to an controlling access
|
||||
-- parameter, create an access to T'class for the necessary
|
||||
-- conversions if one does not exist.
|
||||
|
||||
function Process (N : Node_Id) return Traverse_Result;
|
||||
-- ARM 6.1.1: Within the expression for a Pre'Class or Post'Class
|
||||
-- aspect for a primitive subprogram of a tagged type T, a name
|
||||
-- that denotes a formal parameter of type T is interpreted as
|
||||
-- having type T'Class. Similarly, a name that denotes a formal
|
||||
-- accessparameter of type access-to-T is interpreted as having
|
||||
-- type access-to-T'Class. This ensures the expression is well-
|
||||
-- defined for a primitive subprogram of a type descended from T.
|
||||
-- Note that this replacement is not done for selector names in
|
||||
-- parameter associations. These carry an entity for reference
|
||||
-- purposes, but semantically they are just identifiers.
|
||||
|
||||
-------------
|
||||
-- Get_ACW --
|
||||
-------------
|
||||
|
||||
function Get_ACW return Entity_Id is
|
||||
Loc : constant Source_Ptr := Sloc (Prag);
|
||||
Decl : Node_Id;
|
||||
|
||||
begin
|
||||
if No (ACW) then
|
||||
Decl :=
|
||||
Make_Full_Type_Declaration (Loc,
|
||||
Defining_Identifier => Make_Temporary (Loc, 'T'),
|
||||
Type_Definition =>
|
||||
Make_Access_To_Object_Definition (Loc,
|
||||
Subtype_Indication =>
|
||||
New_Occurrence_Of (Class_Wide_Type (T), Loc),
|
||||
All_Present => True));
|
||||
|
||||
Insert_Before (Unit_Declaration_Node (Subp_Id), Decl);
|
||||
Analyze (Decl);
|
||||
ACW := Defining_Identifier (Decl);
|
||||
Freeze_Before (Unit_Declaration_Node (Subp_Id), ACW);
|
||||
end if;
|
||||
|
||||
return ACW;
|
||||
end Get_ACW;
|
||||
|
||||
-------------
|
||||
-- Process --
|
||||
-------------
|
||||
|
||||
function Process (N : Node_Id) return Traverse_Result is
|
||||
Loc : constant Source_Ptr := Sloc (N);
|
||||
Typ : Entity_Id;
|
||||
|
||||
begin
|
||||
if Is_Entity_Name (N)
|
||||
and then Present (Entity (N))
|
||||
and then Is_Formal (Entity (N))
|
||||
and then Nkind (Parent (N)) /= N_Type_Conversion
|
||||
and then
|
||||
(Nkind (Parent (N)) /= N_Parameter_Association
|
||||
or else N /= Selector_Name (Parent (N)))
|
||||
then
|
||||
if Etype (Entity (N)) = T then
|
||||
Typ := Class_Wide_Type (T);
|
||||
|
||||
elsif Is_Access_Type (Etype (Entity (N)))
|
||||
and then Designated_Type (Etype (Entity (N))) = T
|
||||
then
|
||||
Typ := Get_ACW;
|
||||
else
|
||||
Typ := Empty;
|
||||
end if;
|
||||
|
||||
if Present (Typ) then
|
||||
Rewrite (N,
|
||||
Make_Type_Conversion (Loc,
|
||||
Subtype_Mark =>
|
||||
New_Occurrence_Of (Typ, Loc),
|
||||
Expression => New_Occurrence_Of (Entity (N), Loc)));
|
||||
Set_Etype (N, Typ);
|
||||
end if;
|
||||
end if;
|
||||
|
||||
return OK;
|
||||
end Process;
|
||||
|
||||
procedure Replace_Type is new Traverse_Proc (Process);
|
||||
|
||||
-- Start of processing for Class_Wide_Condition
|
||||
|
||||
begin
|
||||
if not Present (T) then
|
||||
Error_Msg_Name_1 :=
|
||||
Chars (Identifier (Corresponding_Aspect (Prag)));
|
||||
|
||||
Error_Msg_Name_2 := Name_Class;
|
||||
|
||||
Error_Msg_N
|
||||
("aspect `%''%` can only be specified for a primitive "
|
||||
& "operation of a tagged type", Corresponding_Aspect (Prag));
|
||||
end if;
|
||||
|
||||
Replace_Type (Get_Pragma_Arg (Arg1));
|
||||
end Class_Wide_Condition;
|
||||
end if;
|
||||
|
||||
-- Remove the subprogram from the scope stack now that the pre-analysis
|
||||
-- of the precondition/postcondition is done.
|
||||
|
||||
if Restore then
|
||||
End_Scope;
|
||||
end if;
|
||||
end Analyze_Pre_Post_Condition_In_Decl_Part;
|
||||
|
||||
------------------------------------------
|
||||
-- Analyze_Refined_Depends_In_Decl_Part --
|
||||
------------------------------------------
|
||||
|
||||
-- ??? To be implemented
|
||||
|
||||
procedure Analyze_Refined_Depends_In_Decl_Part (N : Node_Id) is
|
||||
pragma Unreferenced (N);
|
||||
begin
|
||||
null;
|
||||
end Analyze_Refined_Depends_In_Decl_Part;
|
||||
|
||||
-----------------------------------------
|
||||
-- Analyze_Refined_Global_In_Decl_Part --
|
||||
-----------------------------------------
|
||||
|
||||
-- ??? To be implemented
|
||||
|
||||
procedure Analyze_Refined_Global_In_Decl_Part (N : Node_Id) is
|
||||
pragma Unreferenced (N);
|
||||
begin
|
||||
null;
|
||||
end Analyze_Refined_Global_In_Decl_Part;
|
||||
|
||||
------------------------------------
|
||||
-- Analyze_Test_Case_In_Decl_Part --
|
||||
------------------------------------
|
||||
@ -19251,6 +19246,8 @@ package body Sem_Prag is
|
||||
Pragma_Queuing_Policy => -1,
|
||||
Pragma_Rational => -1,
|
||||
Pragma_Ravenscar => -1,
|
||||
Pragma_Refined_Depends => -1,
|
||||
Pragma_Refined_Global => -1,
|
||||
Pragma_Refined_Post => -1,
|
||||
Pragma_Refined_Pre => -1,
|
||||
Pragma_Relative_Deadline => -1,
|
||||
|
@ -38,11 +38,13 @@ package Sem_Prag is
|
||||
-- the pragmas below implement an aspect.
|
||||
|
||||
Pragma_On_Body_Or_Stub_OK : constant array (Pragma_Id) of Boolean :=
|
||||
(Pragma_Refined_Post => True,
|
||||
Pragma_Refined_Pre => True,
|
||||
Pragma_SPARK_Mode => True,
|
||||
Pragma_Warnings => True,
|
||||
others => False);
|
||||
(Pragma_Refined_Depends => True,
|
||||
Pragma_Refined_Global => True,
|
||||
Pragma_Refined_Post => True,
|
||||
Pragma_Refined_Pre => True,
|
||||
Pragma_SPARK_Mode => True,
|
||||
Pragma_Warnings => True,
|
||||
others => False);
|
||||
|
||||
-----------------
|
||||
-- Subprograms --
|
||||
@ -60,21 +62,27 @@ package Sem_Prag is
|
||||
procedure Analyze_Global_In_Decl_Part (N : Node_Id);
|
||||
-- Perform full analysis of delayed pragma Global
|
||||
|
||||
procedure Analyze_PPC_In_Decl_Part (N : Node_Id; S : Entity_Id);
|
||||
-- Special analyze routine for precondition/postcondition pragma that
|
||||
-- appears within a declarative part where the pragma is associated
|
||||
-- with a subprogram specification. N is the pragma node, and S is the
|
||||
-- entity for the related subprogram. This procedure does a preanalysis
|
||||
-- of the expressions in the pragma as "spec expressions" (see section
|
||||
-- in Sem "Handling of Default and Per-Object Expressions...").
|
||||
procedure Analyze_Pre_Post_Condition_In_Decl_Part
|
||||
(Prag : Node_Id;
|
||||
Subp_Id : Entity_Id);
|
||||
-- Perform preanalysis of a [refined] precondition or postcondition that
|
||||
-- appears on a subprogram declaration or body [stub]. Prag denotes the
|
||||
-- pragma, Subp_Id is the entity of the related subprogram. The preanalysis
|
||||
-- of the expression is done as "spec expression" (see section "Handling
|
||||
-- of Default and Per-Object Expressions in Sem).
|
||||
|
||||
procedure Analyze_Refined_Depends_In_Decl_Part (N : Node_Id);
|
||||
-- Preform full analysis of delayed pragma Refined_Depends
|
||||
|
||||
procedure Analyze_Refined_Global_In_Decl_Part (N : Node_Id);
|
||||
-- Perform full analysis of delayed pragma Refined_Global
|
||||
|
||||
procedure Analyze_Test_Case_In_Decl_Part (N : Node_Id; S : Entity_Id);
|
||||
-- Special analyze routine for contract-case and test-case pragmas that
|
||||
-- appears within a declarative part where the pragma is associated with
|
||||
-- a subprogram specification. N is the pragma node, and S is the entity
|
||||
-- for the related subprogram. This procedure does a preanalysis of the
|
||||
-- expressions in the pragma as "spec expressions" (see section in Sem
|
||||
-- "Handling of Default and Per-Object Expressions...").
|
||||
-- Perform preanalysis of pragma Test_Case that applies to a subprogram
|
||||
-- declaration. Parameter N denotes the pragma, S is the entity of the
|
||||
-- related subprogram. The preanalysis of the expression is done as "spec
|
||||
-- expression" (see section "Handling of Default and Per-Object Expressions
|
||||
-- in Sem).
|
||||
|
||||
procedure Check_Applicable_Policy (N : Node_Id);
|
||||
-- N is either an N_Aspect or an N_Pragma node. There are two cases. If
|
||||
|
@ -212,25 +212,25 @@ package body Sem_Util is
|
||||
-- Add_Contract_Item --
|
||||
-----------------------
|
||||
|
||||
procedure Add_Contract_Item (Item : Node_Id; Subp_Id : Entity_Id) is
|
||||
procedure Add_Contract_Item (Prag : Node_Id; Subp_Id : Entity_Id) is
|
||||
Items : constant Node_Id := Contract (Subp_Id);
|
||||
Nam : Name_Id;
|
||||
|
||||
begin
|
||||
if Present (Items) and then Nkind (Item) = N_Pragma then
|
||||
Nam := Pragma_Name (Item);
|
||||
-- The related subprogram [body] must have a contract and the item to be
|
||||
-- added must be a pragma.
|
||||
|
||||
if Nam_In (Nam, Name_Precondition, Name_Postcondition) then
|
||||
Set_Next_Pragma (Item, Pre_Post_Conditions (Items));
|
||||
Set_Pre_Post_Conditions (Items, Item);
|
||||
pragma Assert (Present (Items));
|
||||
pragma Assert (Nkind (Prag) = N_Pragma);
|
||||
|
||||
elsif Nam_In (Nam, Name_Contract_Cases, Name_Test_Case) then
|
||||
Set_Next_Pragma (Item, Contract_Test_Cases (Items));
|
||||
Set_Contract_Test_Cases (Items, Item);
|
||||
Nam := Pragma_Name (Prag);
|
||||
|
||||
elsif Nam_In (Nam, Name_Depends, Name_Global) then
|
||||
Set_Next_Pragma (Item, Classifications (Items));
|
||||
Set_Classifications (Items, Item);
|
||||
-- Contract items related to subprogram bodies
|
||||
|
||||
if Ekind (Subp_Id) = E_Subprogram_Body then
|
||||
if Nam_In (Nam, Name_Refined_Depends, Name_Refined_Global) then
|
||||
Set_Next_Pragma (Prag, Classifications (Items));
|
||||
Set_Classifications (Items, Prag);
|
||||
|
||||
-- The pragma is not a proper contract item
|
||||
|
||||
@ -238,10 +238,26 @@ package body Sem_Util is
|
||||
raise Program_Error;
|
||||
end if;
|
||||
|
||||
-- The subprogram has not been properly decorated or the item is illegal
|
||||
-- Contract items related to subprogram declarations
|
||||
|
||||
else
|
||||
raise Program_Error;
|
||||
if Nam_In (Nam, Name_Precondition, Name_Postcondition) then
|
||||
Set_Next_Pragma (Prag, Pre_Post_Conditions (Items));
|
||||
Set_Pre_Post_Conditions (Items, Prag);
|
||||
|
||||
elsif Nam_In (Nam, Name_Contract_Cases, Name_Test_Case) then
|
||||
Set_Next_Pragma (Prag, Contract_Test_Cases (Items));
|
||||
Set_Contract_Test_Cases (Items, Prag);
|
||||
|
||||
elsif Nam_In (Nam, Name_Depends, Name_Global) then
|
||||
Set_Next_Pragma (Prag, Classifications (Items));
|
||||
Set_Classifications (Items, Prag);
|
||||
|
||||
-- The pragma is not a proper contract item
|
||||
|
||||
else
|
||||
raise Program_Error;
|
||||
end if;
|
||||
end if;
|
||||
end Add_Contract_Item;
|
||||
|
||||
|
@ -43,10 +43,17 @@ package Sem_Util is
|
||||
-- Add A to the list of access types to process when expanding the
|
||||
-- freeze node of E.
|
||||
|
||||
procedure Add_Contract_Item (Item : Node_Id; Subp_Id : Entity_Id);
|
||||
-- Add a contract item (pragma Precondition, Postcondition, Test_Case,
|
||||
-- Contract_Cases, Global, Depends) to the contract of a subprogram. Item
|
||||
-- denotes a pragma and Subp_Id is the related subprogram.
|
||||
procedure Add_Contract_Item (Prag : Node_Id; Subp_Id : Entity_Id);
|
||||
-- Add one of the following contract item to the contract of a subprogram.
|
||||
-- Prag denotes a pragma and Subp_Id is the related subprogram [body].
|
||||
-- Contract_Cases
|
||||
-- Depends
|
||||
-- Global
|
||||
-- Postcondition
|
||||
-- Precondition
|
||||
-- Refined_Depends
|
||||
-- Refined_Global
|
||||
-- Test_Case
|
||||
|
||||
procedure Add_Global_Declaration (N : Node_Id);
|
||||
-- These procedures adds a declaration N at the library level, to be
|
||||
|
@ -7143,11 +7143,10 @@ package Sinfo is
|
||||
--------------
|
||||
|
||||
-- This node is used to hold the various parts of an entry or subprogram
|
||||
-- contract, consisting in pre- and postconditions on the one hand, and
|
||||
-- test-cases on the other hand.
|
||||
-- [body] contract, consisting of precondition, postconditions, contract
|
||||
-- cases, test cases and global dependencies.
|
||||
|
||||
-- It is referenced from an entry, a subprogram or a generic subprogram
|
||||
-- entity.
|
||||
-- The node appears in an entry and [generic] subprogram [body] entity.
|
||||
|
||||
-- Sprint syntax: <none> as the node should not appear in the tree, but
|
||||
-- only attached to an entry or [generic] subprogram
|
||||
@ -7160,9 +7159,10 @@ package Sinfo is
|
||||
-- Classifications (Node3) (set to Empty if none)
|
||||
|
||||
-- Pre_Post_Conditions contains a collection of pragmas that correspond
|
||||
-- to pre- and postconditions associated with an entry or a subprogram.
|
||||
-- The pragmas can either come from source or be the byproduct of aspect
|
||||
-- expansion. The ordering in the list is in LIFO fashion.
|
||||
-- to pre- and postconditions associated with an entry or a subprogram
|
||||
-- [body or stub]. The pragmas can either come from source or be the
|
||||
-- byproduct of aspect expansion. The ordering in the list is in LIFO
|
||||
-- fashion.
|
||||
|
||||
-- Note that there might be multiple preconditions or postconditions
|
||||
-- in this list, either because they come from separate pragmas in the
|
||||
@ -7175,8 +7175,8 @@ package Sinfo is
|
||||
|
||||
-- Classifications contains pragmas that either categorize subprogram
|
||||
-- inputs and outputs or establish dependencies between them. Currently
|
||||
-- pragmas Depends and Global are stored in this list. The ordering is
|
||||
-- in LIFO fashion.
|
||||
-- pragmas Depends, Global, Refined_Depends and Refined_Global are
|
||||
-- stored in this list. The ordering is in LIFO fashion.
|
||||
|
||||
-------------------
|
||||
-- Expanded_Name --
|
||||
|
@ -580,6 +580,8 @@ package Snames is
|
||||
Name_Pure_05 : constant Name_Id := N + $; -- GNAT
|
||||
Name_Pure_12 : constant Name_Id := N + $; -- GNAT
|
||||
Name_Pure_Function : constant Name_Id := N + $; -- GNAT
|
||||
Name_Refined_Depends : constant Name_Id := N + $; -- GNAT
|
||||
Name_Refined_Global : constant Name_Id := N + $; -- GNAT
|
||||
Name_Refined_Post : constant Name_Id := N + $; -- GNAT
|
||||
Name_Refined_Pre : constant Name_Id := N + $; -- GNAT
|
||||
Name_Relative_Deadline : constant Name_Id := N + $; -- Ada 05
|
||||
@ -1865,6 +1867,8 @@ package Snames is
|
||||
Pragma_Pure_05,
|
||||
Pragma_Pure_12,
|
||||
Pragma_Pure_Function,
|
||||
Pragma_Refined_Depends,
|
||||
Pragma_Refined_Global,
|
||||
Pragma_Refined_Post,
|
||||
Pragma_Refined_Pre,
|
||||
Pragma_Relative_Deadline,
|
||||
|
@ -172,7 +172,7 @@ package Types is
|
||||
for Physical_Line_Number'Size use 32;
|
||||
-- Line number type, used for storing physical line numbers (i.e. line
|
||||
-- numbers in the physical file being compiled, unaffected by the presence
|
||||
-- of source reference pragmas.
|
||||
-- of source reference pragmas).
|
||||
|
||||
type Column_Number is range 0 .. 32767;
|
||||
for Column_Number'Size use 16;
|
||||
|
Loading…
x
Reference in New Issue
Block a user