Skip to content

R
riscv-gcc-1
Commit 4e6768ab by Arnaud Charlet
Options

[multiple changes] 

2014-07-30  Hristian Kirtchev  <kirtchev@adacore.com>

	* aspects.ads Add a comment explaining why SPARK 2014 aspects are
	not delayed. Update the delay status of most SPARK 2014 aspects.
	* sem_ch13.adb (Analyze_Aspect_Specifications): Update all calls
	to Decorate_Aspect_And_Pragma and Insert_Delayed_Pragma to refert
	to Decorate and Insert_Pragma. Add various comments concerning
	the delay status of several SPARK 2014 aspects. The insertion
	of Refined_State now uses routine Insert_After_SPARK_Mode.
	(Decorate): New routine.
	(Decorate_Aspect_And_Pragma): Removed.
	(Insert_Delayed_Pragma): Removed.
	(Insert_Pragma): New routine.

2014-07-30  Ed Schonberg  <schonberg@adacore.com>

	* inline.adb (Expand_Inlined_Call): In GNATprove mode, emit
	only a warning, not an error on an attempt to inline a recursive
	subprogram.

From-SVN: r213243
parent b6c8e5be
Showing with 170 additions and 132 deletions
gcc/ada/ChangeLog
2014-07-30 Hristian Kirtchev <kirtchev@adacore.com>
* aspects.ads Add a comment explaining why SPARK 2014 aspects are
not delayed. Update the delay status of most SPARK 2014 aspects.
* sem_ch13.adb (Analyze_Aspect_Specifications): Update all calls
to Decorate_Aspect_And_Pragma and Insert_Delayed_Pragma to refert
to Decorate and Insert_Pragma. Add various comments concerning
the delay status of several SPARK 2014 aspects. The insertion
of Refined_State now uses routine Insert_After_SPARK_Mode.
(Decorate): New routine.
(Decorate_Aspect_And_Pragma): Removed.
(Insert_Delayed_Pragma): Removed.
(Insert_Pragma): New routine.
2014-07-30 Ed Schonberg <schonberg@adacore.com>
* inline.adb (Expand_Inlined_Call): In GNATprove mode, emit
only a warning, not an error on an attempt to inline a recursive
subprogram.
2014-07-30 Robert Dewar <dewar@adacore.com> 2014-07-30 Robert Dewar <dewar@adacore.com>
* g-forstr.adb: Minor code reorganization (use J rather than I * g-forstr.adb: Minor code reorganization (use J rather than I
......
gcc/ada/aspects.ads
...@@ -543,6 +543,14 @@ package Aspects is ...@@ -543,6 +543,14 @@ package Aspects is
-- information from the parent type, which must be frozen at that point -- information from the parent type, which must be frozen at that point
-- (since freezing the derived type first freezes the parent type). -- (since freezing the derived type first freezes the parent type).
-- SPARK 2014 aspects do not follow the general delay mechanism as they
-- act as annotations and cannot modify the attributes of their related
-- constructs. To handle forward references in such aspects, the compiler
-- delays the analysis of their respective pragmas by collecting them in
-- N_Contract nodes. The pragmas are then analyzed at the end of the
-- declarative region which contains the related construct. For details,
-- see routines Analyze_xxx_In_Decl_Part.
-- The following shows which aspects are delayed. There are three cases: -- The following shows which aspects are delayed. There are three cases:
type Delay_Type is type Delay_Type is
...@@ -593,12 +601,10 @@ package Aspects is ...@@ -593,12 +601,10 @@ package Aspects is
Aspect_Asynchronous => Always_Delay, Aspect_Asynchronous => Always_Delay,
Aspect_Attach_Handler => Always_Delay, Aspect_Attach_Handler => Always_Delay,
Aspect_Constant_Indexing => Always_Delay, Aspect_Constant_Indexing => Always_Delay,
Aspect_Contract_Cases => Always_Delay,
Aspect_CPU => Always_Delay, Aspect_CPU => Always_Delay,
Aspect_Default_Iterator => Always_Delay, Aspect_Default_Iterator => Always_Delay,
Aspect_Default_Value => Always_Delay, Aspect_Default_Value => Always_Delay,
Aspect_Default_Component_Value => Always_Delay, Aspect_Default_Component_Value => Always_Delay,
Aspect_Depends => Always_Delay,
Aspect_Discard_Names => Always_Delay, Aspect_Discard_Names => Always_Delay,
Aspect_Dispatching_Domain => Always_Delay, Aspect_Dispatching_Domain => Always_Delay,
Aspect_Dynamic_Predicate => Always_Delay, Aspect_Dynamic_Predicate => Always_Delay,
...@@ -607,15 +613,12 @@ package Aspects is ...@@ -607,15 +613,12 @@ package Aspects is
Aspect_External_Tag => Always_Delay, Aspect_External_Tag => Always_Delay,
Aspect_Export => Always_Delay, Aspect_Export => Always_Delay,
Aspect_Favor_Top_Level => Always_Delay, Aspect_Favor_Top_Level => Always_Delay,
Aspect_Global => Always_Delay,
Aspect_Implicit_Dereference => Always_Delay, Aspect_Implicit_Dereference => Always_Delay,
Aspect_Import => Always_Delay, Aspect_Import => Always_Delay,
Aspect_Independent => Always_Delay, Aspect_Independent => Always_Delay,
Aspect_Independent_Components => Always_Delay, Aspect_Independent_Components => Always_Delay,
Aspect_Inline => Always_Delay, Aspect_Inline => Always_Delay,
Aspect_Inline_Always => Always_Delay, Aspect_Inline_Always => Always_Delay,
Aspect_Initial_Condition => Always_Delay,
Aspect_Initializes => Always_Delay,
Aspect_Input => Always_Delay, Aspect_Input => Always_Delay,
Aspect_Interrupt_Handler => Always_Delay, Aspect_Interrupt_Handler => Always_Delay,
Aspect_Interrupt_Priority => Always_Delay, Aspect_Interrupt_Priority => Always_Delay,
...@@ -639,9 +642,6 @@ package Aspects is ...@@ -639,9 +642,6 @@ package Aspects is
Aspect_Pure => Always_Delay, Aspect_Pure => Always_Delay,
Aspect_Pure_Function => Always_Delay, Aspect_Pure_Function => Always_Delay,
Aspect_Read => Always_Delay, Aspect_Read => Always_Delay,
Aspect_Refined_Depends => Always_Delay,
Aspect_Refined_Global => Always_Delay,
Aspect_Refined_State => Always_Delay,
Aspect_Relative_Deadline => Always_Delay, Aspect_Relative_Deadline => Always_Delay,
Aspect_Remote_Access_Type => Always_Delay, Aspect_Remote_Access_Type => Always_Delay,
Aspect_Remote_Call_Interface => Always_Delay, Aspect_Remote_Call_Interface => Always_Delay,
...@@ -671,13 +671,21 @@ package Aspects is ...@@ -671,13 +671,21 @@ package Aspects is
Aspect_Annotate => Never_Delay, Aspect_Annotate => Never_Delay,
Aspect_Async_Readers => Never_Delay, Aspect_Async_Readers => Never_Delay,
Aspect_Async_Writers => Never_Delay, Aspect_Async_Writers => Never_Delay,
Aspect_Contract_Cases => Never_Delay,
Aspect_Convention => Never_Delay, Aspect_Convention => Never_Delay,
Aspect_Depends => Never_Delay,
Aspect_Dimension => Never_Delay, Aspect_Dimension => Never_Delay,
Aspect_Dimension_System => Never_Delay, Aspect_Dimension_System => Never_Delay,
Aspect_Effective_Reads => Never_Delay, Aspect_Effective_Reads => Never_Delay,
Aspect_Effective_Writes => Never_Delay, Aspect_Effective_Writes => Never_Delay,
Aspect_Global => Never_Delay,
Aspect_Initial_Condition => Never_Delay,
Aspect_Initializes => Never_Delay,
Aspect_Part_Of => Never_Delay, Aspect_Part_Of => Never_Delay,
Aspect_Refined_Depends => Never_Delay,
Aspect_Refined_Global => Never_Delay,
Aspect_Refined_Post => Never_Delay, Aspect_Refined_Post => Never_Delay,
Aspect_Refined_State => Never_Delay,
Aspect_SPARK_Mode => Never_Delay, Aspect_SPARK_Mode => Never_Delay,
Aspect_Synchronization => Never_Delay, Aspect_Synchronization => Never_Delay,
Aspect_Test_Case => Never_Delay, Aspect_Test_Case => Never_Delay,
......
gcc/ada/inline.adb
...@@ -3619,7 +3619,19 @@ package body Inline is ...@@ -3619,7 +3619,19 @@ package body Inline is
A := First_Actual (N); A := First_Actual (N);
while Present (F) loop while Present (F) loop
if Present (Renamed_Object (F)) then if Present (Renamed_Object (F)) then
-- If expander is active, it's an error to try to inline a
-- recursive program. In GNATprove mode, just indicate that
-- the inlining will not happen.
if Expander_Active then
Error_Msg_N ("cannot inline call to recursive subprogram", N); Error_Msg_N ("cannot inline call to recursive subprogram", N);
else
Cannot_Inline
("cannot inline call to recursive subprogram?", N, Subp);
end if;
return; return;
end if; end if;
......
gcc/ada/sem_ch13.adb
...@@ -1185,45 +1185,42 @@ package body Sem_Ch13 is ...@@ -1185,45 +1185,42 @@ package body Sem_Ch13 is
----------------------------------- -----------------------------------
procedure Analyze_Aspect_Specifications (N : Node_Id; E : Entity_Id) is procedure Analyze_Aspect_Specifications (N : Node_Id; E : Entity_Id) is
procedure Decorate_Aspect_And_Pragma procedure Decorate (Asp : Node_Id; Prag : Node_Id);
(Asp : Node_Id;
Prag : Node_Id;
Delayed : Boolean := False);
-- Establish the linkages between an aspect and its corresponding -- Establish the linkages between an aspect and its corresponding
-- pragma. Flag Delayed should be set when both constructs are delayed. -- pragma.
procedure Insert_After_SPARK_Mode procedure Insert_After_SPARK_Mode
(Prag : Node_Id; (Prag : Node_Id;
Ins_Nod : Node_Id; Ins_Nod : Node_Id;
Decls : List_Id); Decls : List_Id);
-- Subsidiary to the analysis of aspects Abstract_State, Initializes and -- Subsidiary to the analysis of aspects Abstract_State, Initializes,
-- Initial_Condition. Insert node Prag before node Ins_Nod. If Ins_Nod -- Initial_Condition and Refined_State. Insert node Prag before node
-- denotes pragma SPARK_Mode, then SPARK_Mode is skipped. Decls is the -- Ins_Nod. If Ins_Nod denotes pragma SPARK_Mode, then SPARK_Mode is
-- associated declarative list where Prag is to reside. -- skipped. Decls is the associated declarative list where Prag is to
-- reside.
procedure Insert_Delayed_Pragma (Prag : Node_Id);
-- Insert a postcondition-like pragma into the tree depending on the procedure Insert_Pragma (Prag : Node_Id);
-- context. Prag must denote one of the following: Pre, Post, Depends, -- Subsidiary to the analysis of aspects Attach_Handler, Contract_Cases,
-- Global or Contract_Cases. This procedure is also used for the case -- Depends, Global, Post, Pre, Refined_Depends and Refined_Global.
-- of Attach_Handler which has similar requirements for placement. -- Insert pragma Prag such that it mimics the placement of a source
-- pragma of the same kind.
--
-- procedure Proc (Formal : ...) with Global => ...;
--
-- procedure Proc (Formal : ...);
-- pragma Global (...);
-------------------------------- --------------
-- Decorate_Aspect_And_Pragma -- -- Decorate --
-------------------------------- --------------
procedure Decorate_Aspect_And_Pragma procedure Decorate (Asp : Node_Id; Prag : Node_Id) is
(Asp : Node_Id;
Prag : Node_Id;
Delayed : Boolean := False)
is
begin begin
Set_Aspect_Rep_Item (Asp, Prag); Set_Aspect_Rep_Item (Asp, Prag);
Set_Corresponding_Aspect (Prag, Asp); Set_Corresponding_Aspect (Prag, Asp);
Set_From_Aspect_Specification (Prag); Set_From_Aspect_Specification (Prag);
Set_Is_Delayed_Aspect (Prag, Delayed);
Set_Is_Delayed_Aspect (Asp, Delayed);
Set_Parent (Prag, Asp); Set_Parent (Prag, Asp);
end Decorate_Aspect_And_Pragma; end Decorate;
----------------------------- -----------------------------
-- Insert_After_SPARK_Mode -- -- Insert_After_SPARK_Mode --
...@@ -1256,12 +1253,13 @@ package body Sem_Ch13 is ...@@ -1256,12 +1253,13 @@ package body Sem_Ch13 is
end if; end if;
end Insert_After_SPARK_Mode; end Insert_After_SPARK_Mode;
--------------------------- -------------------
-- Insert_Delayed_Pragma -- -- Insert_Pragma --
--------------------------- -------------------
procedure Insert_Delayed_Pragma (Prag : Node_Id) is procedure Insert_Pragma (Prag : Node_Id) is
Aux : Node_Id; Aux : Node_Id;
Decl : Node_Id;
begin begin
-- When the context is a library unit, the pragma is added to the -- When the context is a library unit, the pragma is added to the
...@@ -1280,29 +1278,30 @@ package body Sem_Ch13 is ...@@ -1280,29 +1278,30 @@ package body Sem_Ch13 is
-- declarative part. -- declarative part.
elsif Nkind (N) = N_Subprogram_Body then elsif Nkind (N) = N_Subprogram_Body then
if No (Declarations (N)) then if Present (Declarations (N)) then
Set_Declarations (N, New_List (Prag));
else
declare
D : Node_Id;
begin
-- There may be several aspects associated with the body; -- Skip other internally generated pragmas from aspects to find
-- preserve the ordering of the corresponding pragmas. -- the proper insertion point. As a result the order of pragmas
-- is the same as the order of aspects.
D := First (Declarations (N)); Decl := First (Declarations (N));
while Present (D) loop while Present (Decl) loop
exit when Nkind (D) /= N_Pragma if Nkind (Decl) = N_Pragma
or else not From_Aspect_Specification (D); and then From_Aspect_Specification (Decl)
Next (D); then
Next (Decl);
else
exit;
end if;
end loop; end loop;
if No (D) then if Present (Decl) then
Append (Prag, Declarations (N)); Insert_Before (Decl, Prag);
else else
Insert_Before (D, Prag); Append (Prag, Declarations (N));
end if; end if;
end; else
Set_Declarations (N, New_List (Prag));
end if; end if;
-- Default -- Default
...@@ -1310,7 +1309,7 @@ package body Sem_Ch13 is ...@@ -1310,7 +1309,7 @@ package body Sem_Ch13 is
else else
Insert_After (N, Prag); Insert_After (N, Prag);
end if; end if;
end Insert_Delayed_Pragma; end Insert_Pragma;
-- Local variables -- Local variables
...@@ -1757,7 +1756,7 @@ package body Sem_Ch13 is ...@@ -1757,7 +1756,7 @@ package body Sem_Ch13 is
Expression => Relocate_Node (Expr))), Expression => Relocate_Node (Expr))),
Pragma_Name => Name_Implemented); Pragma_Name => Name_Implemented);
-- Attach Handler -- Attach_Handler
when Aspect_Attach_Handler => when Aspect_Attach_Handler =>
Make_Aitem_Pragma Make_Aitem_Pragma
...@@ -1771,7 +1770,7 @@ package body Sem_Ch13 is ...@@ -1771,7 +1770,7 @@ package body Sem_Ch13 is
-- We need to insert this pragma into the tree to get proper -- We need to insert this pragma into the tree to get proper
-- processing and to look valid from a placement viewpoint. -- processing and to look valid from a placement viewpoint.
Insert_Delayed_Pragma (Aitem); Insert_Pragma (Aitem);
goto Continue; goto Continue;
-- Dynamic_Predicate, Predicate, Static_Predicate -- Dynamic_Predicate, Predicate, Static_Predicate
...@@ -2117,7 +2116,7 @@ package body Sem_Ch13 is ...@@ -2117,7 +2116,7 @@ package body Sem_Ch13 is
Make_Pragma_Argument_Association (Loc, Make_Pragma_Argument_Association (Loc,
Expression => Relocate_Node (Expr))), Expression => Relocate_Node (Expr))),
Pragma_Name => Name_Abstract_State); Pragma_Name => Name_Abstract_State);
Decorate_Aspect_And_Pragma (Aspect, Aitem); Decorate (Aspect, Aitem);
Decls := Visible_Declarations (Specification (Context)); Decls := Visible_Declarations (Specification (Context));
...@@ -2176,10 +2175,12 @@ package body Sem_Ch13 is ...@@ -2176,10 +2175,12 @@ package body Sem_Ch13 is
-- Depends -- Depends
-- Aspect Depends must be delayed because it mentions names -- Aspect Depends is never delayed because it is equivalent to
-- of inputs and output that are classified by aspect Global. -- a source pragma which appears after the related subprogram.
-- The aspect and pragma are treated the same way as a post -- To deal with forward references, the generated pragma is
-- condition. -- stored in the contract of the related subprogram and later
-- analyzed at the end of the declarative region. See routine
-- Analyze_Depends_In_Decl_Part for details.
when Aspect_Depends => when Aspect_Depends =>
Make_Aitem_Pragma Make_Aitem_Pragma
...@@ -2188,17 +2189,18 @@ package body Sem_Ch13 is ...@@ -2188,17 +2189,18 @@ package body Sem_Ch13 is
Expression => Relocate_Node (Expr))), Expression => Relocate_Node (Expr))),
Pragma_Name => Name_Depends); Pragma_Name => Name_Depends);
Decorate_Aspect_And_Pragma Decorate (Aspect, Aitem);
(Aspect, Aitem, Delayed => True); Insert_Pragma (Aitem);
Insert_Delayed_Pragma (Aitem);
goto Continue; goto Continue;
-- Global -- Global
-- Aspect Global must be delayed because it can mention names -- Aspect Global is never delayed because it is equivalent to
-- and benefit from the forward visibility rules applicable to -- a source pragma which appears after the related subprogram.
-- aspects of subprograms. The aspect and pragma are treated -- To deal with forward references, the generated pragma is
-- the same way as a post condition. -- stored in the contract of the related subprogram and later
-- analyzed at the end of the declarative region. See routine
-- Analyze_Global_In_Decl_Part for details.
when Aspect_Global => when Aspect_Global =>
Make_Aitem_Pragma Make_Aitem_Pragma
...@@ -2207,25 +2209,28 @@ package body Sem_Ch13 is ...@@ -2207,25 +2209,28 @@ package body Sem_Ch13 is
Expression => Relocate_Node (Expr))), Expression => Relocate_Node (Expr))),
Pragma_Name => Name_Global); Pragma_Name => Name_Global);
Decorate_Aspect_And_Pragma Decorate (Aspect, Aitem);
(Aspect, Aitem, Delayed => True); Insert_Pragma (Aitem);
Insert_Delayed_Pragma (Aitem);
goto Continue; goto Continue;
-- Initial_Condition -- Initial_Condition
-- Aspect Initial_Condition covers the visible declarations of -- Aspect Initial_Condition is never delayed because it is
-- a package and all hidden states through functions. As such, -- equivalent to a source pragma which appears after the
-- it must be evaluated at the end of the said declarations. -- related package. To deal with forward references, the
-- generated pragma is stored in the contract of the related
-- package and later analyzed at the end of the declarative
-- region. See routine Analyze_Initial_Condition_In_Decl_Part
-- for details.
when Aspect_Initial_Condition => Initial_Condition : declare when Aspect_Initial_Condition => Initial_Condition : declare
Context : Node_Id := N; Context : Node_Id := N;
Decls : List_Id; Decls : List_Id;
begin begin
-- When aspect Abstract_State appears on a generic package, -- When aspect Initial_Condition appears on a generic
-- it is propageted to the package instance. The context in -- package, it is propageted to the package instance. The
-- this case is the instance spec. -- context in this case is the instance spec.
if Nkind (Context) = N_Package_Instantiation then if Nkind (Context) = N_Package_Instantiation then
Context := Instance_Spec (Context); Context := Instance_Spec (Context);
...@@ -2242,9 +2247,7 @@ package body Sem_Ch13 is ...@@ -2242,9 +2247,7 @@ package body Sem_Ch13 is
Expression => Relocate_Node (Expr))), Expression => Relocate_Node (Expr))),
Pragma_Name => Pragma_Name =>
Name_Initial_Condition); Name_Initial_Condition);
Decorate (Aspect, Aitem);
Decorate_Aspect_And_Pragma
(Aspect, Aitem, Delayed => True);
if No (Decls) then if No (Decls) then
Decls := New_List; Decls := New_List;
...@@ -2272,9 +2275,12 @@ package body Sem_Ch13 is ...@@ -2272,9 +2275,12 @@ package body Sem_Ch13 is
-- Initializes -- Initializes
-- Aspect Initializes coverts the visible declarations of a -- Aspect Initializes is never delayed because it is equivalent
-- package. As such, it must be evaluated at the end of the -- to a source pragma appearing after the related package. To
-- said declarations. -- deal with forward references, the generated pragma is stored
-- in the contract of the related package and later analyzed at
-- the end of the declarative region. For details, see routine
-- Analyze_Initializes_In_Decl_Part.
when Aspect_Initializes => Initializes : declare when Aspect_Initializes => Initializes : declare
Context : Node_Id := N; Context : Node_Id := N;
...@@ -2299,9 +2305,7 @@ package body Sem_Ch13 is ...@@ -2299,9 +2305,7 @@ package body Sem_Ch13 is
Make_Pragma_Argument_Association (Loc, Make_Pragma_Argument_Association (Loc,
Expression => Relocate_Node (Expr))), Expression => Relocate_Node (Expr))),
Pragma_Name => Name_Initializes); Pragma_Name => Name_Initializes);
Decorate (Aspect, Aitem);
Decorate_Aspect_And_Pragma
(Aspect, Aitem, Delayed => True);
if No (Decls) then if No (Decls) then
Decls := New_List; Decls := New_List;
...@@ -2362,7 +2366,7 @@ package body Sem_Ch13 is ...@@ -2362,7 +2366,7 @@ package body Sem_Ch13 is
-- emulate the behavior of a source pragma. -- emulate the behavior of a source pragma.
if Nkind (N) = N_Package_Body then if Nkind (N) = N_Package_Body then
Decorate_Aspect_And_Pragma (Aspect, Aitem); Decorate (Aspect, Aitem);
Decls := Declarations (N); Decls := Declarations (N);
...@@ -2379,7 +2383,7 @@ package body Sem_Ch13 is ...@@ -2379,7 +2383,7 @@ package body Sem_Ch13 is
-- declarations to emulate the behavior of a source pragma. -- declarations to emulate the behavior of a source pragma.
elsif Nkind (N) = N_Package_Declaration then elsif Nkind (N) = N_Package_Declaration then
Decorate_Aspect_And_Pragma (Aspect, Aitem); Decorate (Aspect, Aitem);
Decls := Visible_Declarations (Specification (N)); Decls := Visible_Declarations (Specification (N));
...@@ -2395,10 +2399,13 @@ package body Sem_Ch13 is ...@@ -2395,10 +2399,13 @@ package body Sem_Ch13 is
-- Refined_Depends -- Refined_Depends
-- Aspect Refined_Depends must be delayed because it can -- Aspect Refined_Depends is never delayed because it is
-- mention state refinements introduced by aspect Refined_State -- equivalent to a source pragma which appears in the
-- and further classified by aspect Refined_Global. Since both -- declarations of the related subprogram body. To deal with
-- those aspects are delayed, so is Refined_Depends. -- forward references, the generated pragma is stored in the
-- contract of the related subprogram body and later analyzed
-- at the end of the declarative region. For details, see
-- routine Analyze_Refined_Depends_In_Decl_Part.
when Aspect_Refined_Depends => when Aspect_Refined_Depends =>
Make_Aitem_Pragma Make_Aitem_Pragma
...@@ -2407,17 +2414,19 @@ package body Sem_Ch13 is ...@@ -2407,17 +2414,19 @@ package body Sem_Ch13 is
Expression => Relocate_Node (Expr))), Expression => Relocate_Node (Expr))),
Pragma_Name => Name_Refined_Depends); Pragma_Name => Name_Refined_Depends);
Decorate_Aspect_And_Pragma Decorate (Aspect, Aitem);
(Aspect, Aitem, Delayed => True); Insert_Pragma (Aitem);
Insert_Delayed_Pragma (Aitem);
goto Continue; goto Continue;
-- Refined_Global -- Refined_Global
-- Aspect Refined_Global must be delayed because it can mention -- Aspect Refined_Global is never delayed because it is
-- state refinements introduced by aspect Refined_State. Since -- equivalent to a source pragma which appears in the
-- Refined_State is already delayed due to forward references, -- declarations of the related subprogram body. To deal with
-- so is Refined_Global. -- forward references, the generated pragma is stored in the
-- contract of the related subprogram body and later analyzed
-- at the end of the declarative region. For details, see
-- routine Analyze_Refined_Global_In_Decl_Part.
when Aspect_Refined_Global => when Aspect_Refined_Global =>
Make_Aitem_Pragma Make_Aitem_Pragma
...@@ -2426,8 +2435,8 @@ package body Sem_Ch13 is ...@@ -2426,8 +2435,8 @@ package body Sem_Ch13 is
Expression => Relocate_Node (Expr))), Expression => Relocate_Node (Expr))),
Pragma_Name => Name_Refined_Global); Pragma_Name => Name_Refined_Global);
Decorate_Aspect_And_Pragma (Aspect, Aitem, Delayed => True); Decorate (Aspect, Aitem);
Insert_Delayed_Pragma (Aitem); Insert_Pragma (Aitem);
goto Continue; goto Continue;
-- Refined_Post -- Refined_Post
...@@ -2442,7 +2451,6 @@ package body Sem_Ch13 is ...@@ -2442,7 +2451,6 @@ package body Sem_Ch13 is
-- Refined_State -- Refined_State
when Aspect_Refined_State => Refined_State : declare when Aspect_Refined_State => Refined_State : declare
Decl : Node_Id;
Decls : List_Id; Decls : List_Id;
begin begin
...@@ -2452,38 +2460,29 @@ package body Sem_Ch13 is ...@@ -2452,38 +2460,29 @@ package body Sem_Ch13 is
-- the pragma. -- the pragma.
if Nkind (N) = N_Package_Body then if Nkind (N) = N_Package_Body then
Decls := Declarations (N);
Make_Aitem_Pragma Make_Aitem_Pragma
(Pragma_Argument_Associations => New_List ( (Pragma_Argument_Associations => New_List (
Make_Pragma_Argument_Association (Loc, Make_Pragma_Argument_Association (Loc,
Expression => Relocate_Node (Expr))), Expression => Relocate_Node (Expr))),
Pragma_Name => Name_Refined_State); Pragma_Name => Name_Refined_State);
Decorate_Aspect_And_Pragma (Aspect, Aitem); Decorate (Aspect, Aitem);
Decls := Declarations (N);
-- When the package body is subject to pragma SPARK_Mode,
-- insert pragma Refined_State after SPARK_Mode.
if Present (Decls) then
Decl := First (Decls);
if Nkind (Decl) = N_Pragma
and then Pragma_Name (Decl) = Name_SPARK_Mode
then
Insert_After (Decl, Aitem);
-- The related package body lacks SPARK_Mode, the if No (Decls) then
-- corresponding pragma must be the first declaration. Decls := New_List;
Set_Declarations (N, Decls);
else
Prepend_To (Decls, Aitem);
end if; end if;
-- Otherwise the pragma forms a new declarative list -- Pragma Refined_State must be inserted after pragma
-- SPARK_Mode in the tree. This ensures that any error
-- messages dependent on SPARK_Mode will be properly
-- enabled/suppressed.
else Insert_After_SPARK_Mode
Set_Declarations (N, New_List (Aitem)); (Prag => Aitem,
end if; Ins_Nod => First (Decls),
Decls => Decls);
else else
Error_Msg_NE Error_Msg_NE
...@@ -2741,7 +2740,7 @@ package body Sem_Ch13 is ...@@ -2741,7 +2740,7 @@ package body Sem_Ch13 is
-- about delay issues, since the pragmas themselves deal -- about delay issues, since the pragmas themselves deal
-- with delay of visibility for the expression analysis. -- with delay of visibility for the expression analysis.
Insert_Delayed_Pragma (Aitem); Insert_Pragma (Aitem);
goto Continue; goto Continue;
end Pre_Post; end Pre_Post;
...@@ -2821,9 +2820,8 @@ package body Sem_Ch13 is ...@@ -2821,9 +2820,8 @@ package body Sem_Ch13 is
Expression => Relocate_Node (Expr))), Expression => Relocate_Node (Expr))),
Pragma_Name => Nam); Pragma_Name => Nam);
Decorate_Aspect_And_Pragma Decorate (Aspect, Aitem);
(Aspect, Aitem, Delayed => True); Insert_Pragma (Aitem);
Insert_Delayed_Pragma (Aitem);
goto Continue; goto Continue;
-- Case 5: Special handling for aspects with an optional -- Case 5: Special handling for aspects with an optional
...@@ -3022,7 +3020,7 @@ package body Sem_Ch13 is ...@@ -3022,7 +3020,7 @@ package body Sem_Ch13 is
-- the aspect specification node. -- the aspect specification node.
if Present (Aitem) then if Present (Aitem) then
Set_From_Aspect_Specification (Aitem, True); Set_From_Aspect_Specification (Aitem);
end if; end if;
-- In the context of a compilation unit, we directly put the -- In the context of a compilation unit, we directly put the
......
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