OpenE2K
/
gcc
2
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity

[multiple changes] 

2016-10-12  Yannick Moy  <moy@adacore.com>

	* einfo.adb, einfo.ads (Partial_Refinement_Constituents): Take
	into account constituents that are themselves abstract states
	with full or partial refinement visible.
	* sem_prag.adb (Find_Encapsulating_State): Move function
	to library-level, to share between subprograms.
	(Analyze_Refined_Global_In_Decl_Part): Use
	Find_Encapsulating_State to get relevant encapsulating state.

2016-10-12  Arnaud Charlet  <charlet@adacore.com>

	* gnat1drv.adb: Fix minor typo.

From-SVN: r241052
This commit is contained in:
Arnaud Charlet 2016-10-12 16:37:35 +02:00
parent c8dc49fb03
commit 05f1a54316
5 changed files with 169 additions and 92 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

14
gcc/ada/ChangeLog
View File

@ -1,3 +1,17 @@
2016-10-12 Yannick Moy <moy@adacore.com>
* einfo.adb, einfo.ads (Partial_Refinement_Constituents): Take
into account constituents that are themselves abstract states
with full or partial refinement visible.
* sem_prag.adb (Find_Encapsulating_State): Move function
to library-level, to share between subprograms.
(Analyze_Refined_Global_In_Decl_Part): Use
Find_Encapsulating_State to get relevant encapsulating state.
2016-10-12 Arnaud Charlet <charlet@adacore.com>
* gnat1drv.adb: Fix minor typo.
2016-10-12 Yannick Moy <moy@adacore.com> 2016-10-12 Yannick Moy <moy@adacore.com>
* sem_prag.adb (Analyze_Refined_Depends_In_Decl_Part): Adapt checking * sem_prag.adb (Analyze_Refined_Depends_In_Decl_Part): Adapt checking

68
gcc/ada/einfo.adb
View File

@ -8407,19 +8407,79 @@ package body Einfo is
------------------------------------- -------------------------------------
function Partial_Refinement_Constituents (Id : E) return L is function Partial_Refinement_Constituents (Id : E) return L is
Constits : Elist_Id; Constits : Elist_Id := No_Elist;
procedure Add_Usable_Constituents (Item : E);
-- Add global item Item and/or its constituents to list Constits when
-- they can be used in a global refinement within the current scope. The
-- criteria are:
-- 1) If Item is an abstract state with full refinement visible, add
-- its constituents.
-- 2) If Item is an abstract state with only partial refinement
-- visible, add both Item and its constituents.
-- 3) If Item is an abstract state without a visible refinement, add
-- it.
-- 4) If Id is not an abstract state, add it.
procedure Add_Usable_Constituents (List : Elist_Id);
-- Apply Add_Usable_Constituents to every constituent in List
-----------------------------
-- Add_Usable_Constituents --
-----------------------------
procedure Add_Usable_Constituents (Item : E) is
begin
if Ekind (Item) = E_Abstract_State then
if Has_Visible_Refinement (Item) then
Add_Usable_Constituents (Refinement_Constituents (Item));
elsif Has_Partial_Visible_Refinement (Item) then
Append_New_Elmt (Item, Constits);
Add_Usable_Constituents (Part_Of_Constituents (Item));
else
Append_New_Elmt (Item, Constits);
end if;
else
Append_New_Elmt (Item, Constits);
end if;
end Add_Usable_Constituents;
procedure Add_Usable_Constituents (List : Elist_Id) is
Constit_Elmt : Elmt_Id;
begin
if Present (List) then
Constit_Elmt := First_Elmt (List);
while Present (Constit_Elmt) loop
Add_Usable_Constituents (Node (Constit_Elmt));
Next_Elmt (Constit_Elmt);
end loop;
end if;
end Add_Usable_Constituents;
-- Start of processing for Partial_Refinement_Constituents
begin begin
-- "Refinement" is a concept applicable only to abstract states -- "Refinement" is a concept applicable only to abstract states
pragma Assert (Ekind (Id) = E_Abstract_State); pragma Assert (Ekind (Id) = E_Abstract_State);
Constits := Refinement_Constituents (Id);
if Has_Visible_Refinement (Id) then
Constits := Refinement_Constituents (Id);
-- A refinement may be partially visible when objects declared in the -- A refinement may be partially visible when objects declared in the
-- private part of a package are subject to a Part_Of indicator. -- private part of a package are subject to a Part_Of indicator.
if No (Constits) then elsif Has_Partial_Visible_Refinement (Id) then
Constits := Part_Of_Constituents (Id); Add_Usable_Constituents (Part_Of_Constituents (Id));
-- Function should only be called when full or partial refinement is
-- visible.
else
raise Program_Error;
end if; end if;
return Constits; return Constits;

8
gcc/ada/einfo.ads
View File

@ -3793,9 +3793,11 @@ package Einfo is
-- way this is stored is as an element of the Subprograms_For_Type field. -- way this is stored is as an element of the Subprograms_For_Type field.
-- Partial_Refinement_Constituents (synthesized) -- Partial_Refinement_Constituents (synthesized)
-- Present in abstract state entities. Contains the constituents that -- Defined in abstract state entities. Returns the constituents that
-- refine the state in its private part, in other words, all the hidden -- refine the state in the current scope, which are allowed in a global
-- states that indicate this abstract state in a Part_Of aspect/pragma. -- refinement in this scope. These consist in those constituents that are
-- abstract states with no or only partial refinement visible, and those
-- that are not themselves abstract states.
-- Partial_View_Has_Unknown_Discr (Flag280) -- Partial_View_Has_Unknown_Discr (Flag280)
-- Present in all types. Set to Indicate that the partial view of a type -- Present in all types. Set to Indicate that the partial view of a type

2
gcc/ada/gnat1drv.adb
View File

@ -343,7 +343,7 @@ procedure Gnat1drv is
-- of compiler warnings, but these are being turned off by default, -- of compiler warnings, but these are being turned off by default,
-- and CodePeer generates better messages (referencing original -- and CodePeer generates better messages (referencing original
-- variables) this way. -- variables) this way.
-- Do this only is -gnatws is set (the default with -gnatcC), so that -- Do this only if -gnatws is set (the default with -gnatcC), so that
-- if warnings are enabled, we'll get better messages from GNAT. -- if warnings are enabled, we'll get better messages from GNAT.
if Warning_Mode = Suppress then if Warning_Mode = Suppress then

169
gcc/ada/sem_prag.adb
View File

@ -258,6 +258,13 @@ package body Sem_Prag is
-- Subsidiary to all Find_Related_xxx routines. Emit an error on pragma -- Subsidiary to all Find_Related_xxx routines. Emit an error on pragma
-- Prag that duplicates previous pragma Prev. -- Prag that duplicates previous pragma Prev.
function Find_Encapsulating_State
(States : Elist_Id;
Constit_Id : Entity_Id) return Entity_Id;
-- Given the entity of a constituent Constit_Id, find the corresponding
-- encapsulating state which appears in States. The routine returns Empty
-- is no such state is found.
function Find_Related_Context function Find_Related_Context
(Prag : Node_Id; (Prag : Node_Id;
Do_Checks : Boolean := False) return Node_Id; Do_Checks : Boolean := False) return Node_Id;
@ -24545,6 +24552,12 @@ package body Sem_Prag is
-- These list contain the entities of all Input, In_Out, Output and -- These list contain the entities of all Input, In_Out, Output and
-- Proof_In items defined in the corresponding Global pragma. -- Proof_In items defined in the corresponding Global pragma.
Repeat_Items : Elist_Id := No_Elist;
-- A list of all global items without full visible refinement found
-- in pragma Global. These states should be repeated in the global
-- refinement (SPARK RM 7.2.4(3c)) unless they have a partial visible
-- refinement, in which case they may be repeated (SPARK RM 7.2.4(3d)).
Spec_Id : Entity_Id; Spec_Id : Entity_Id;
-- The entity of the subprogram subject to pragma Refined_Global -- The entity of the subprogram subject to pragma Refined_Global
@ -24552,12 +24565,6 @@ package body Sem_Prag is
-- A list of all states with full or partial visible refinement found in -- A list of all states with full or partial visible refinement found in
-- pragma Global. -- pragma Global.
Repeat_Items : Elist_Id := No_Elist;
-- A list of all global items without full visible refinement found
-- in pragma Global. These states should be repeated in the global
-- refinement (SPARK RM 7.2.4(3c)) unless they have a partial visible
-- refinement, in which case they may be repeated (SPARK RM 7.2.4(3d)).
procedure Check_In_Out_States; procedure Check_In_Out_States;
-- Determine whether the corresponding Global pragma mentions In_Out -- Determine whether the corresponding Global pragma mentions In_Out
-- states with visible refinement and if so, ensure that one of the -- states with visible refinement and if so, ensure that one of the
@ -24616,8 +24623,8 @@ package body Sem_Prag is
-- In_Out_Constits and Out_Constits of valid constituents. -- In_Out_Constits and Out_Constits of valid constituents.
procedure Present_Then_Remove (List : Elist_Id; Item : Entity_Id); procedure Present_Then_Remove (List : Elist_Id; Item : Entity_Id);
-- Same as function Present_Then_Remove, but do not report presence of -- Same as function Present_Then_Remove, but do not report the presence
-- Item in List. -- of Item in List.
procedure Report_Extra_Constituents; procedure Report_Extra_Constituents;
-- Emit an error for each constituent found in lists In_Constits, -- Emit an error for each constituent found in lists In_Constits,
@ -24715,12 +24722,12 @@ package body Sem_Prag is
N, State_Id); N, State_Id);
end if; end if;
-- The state lacks a completion. When full refinement is -- The state lacks a completion. When full refinement is visible,
-- visible, always emit an error (SPARK RM 7.2.4(3a)). When only -- always emit an error (SPARK RM 7.2.4(3a)). When only partial
-- partial refinement is visible, emit an error if the abstract -- refinement is visible, emit an error if the abstract state
-- state itself is not utilized (SPARK RM 7.2.4(3d)). In the -- itself is not utilized (SPARK RM 7.2.4(3d)). In the case where
-- case where both are utilized, an error will be issued in -- both are utilized, Check_State_And_Constituent_Use. will issue
-- Check_State_And_Constituent_Use. -- the error.
elsif not Input_Seen elsif not Input_Seen
and then not In_Out_Seen and then not In_Out_Seen
@ -24836,17 +24843,16 @@ package body Sem_Prag is
end loop; end loop;
end if; end if;
-- Not one of the constituents appeared as Input. When full -- Not one of the constituents appeared as Input. Always emit an
-- refinement is visible, always emit an error (SPARK RM -- error when the full refinement is visible (SPARK RM 7.2.4(3a)).
-- 7.2.4(3a)). When only partial refinement is visible, emit an -- When only partial refinement is visible, emit an
-- error if the abstract state itself is not utilized (SPARK RM -- error if the abstract state itself is not utilized (SPARK RM
-- 7.2.4(3d)). In the case where both are utilized, an error will -- 7.2.4(3d)). In the case where both are utilized, an error will
-- be issued in Check_State_And_Constituent_Use. -- be issued in Check_State_And_Constituent_Use.
if not In_Seen if not In_Seen
and then (Has_Visible_Refinement (State_Id) and then (Has_Visible_Refinement (State_Id)
or else or else Contains (Repeat_Items, State_Id))
Contains (Repeat_Items, State_Id))
then then
SPARK_Msg_NE SPARK_Msg_NE
("global refinement of state & must include at least one " ("global refinement of state & must include at least one "
@ -24910,10 +24916,10 @@ package body Sem_Prag is
procedure Check_Constituent_Usage (State_Id : Entity_Id) is procedure Check_Constituent_Usage (State_Id : Entity_Id) is
Constits : constant Elist_Id := Constits : constant Elist_Id :=
Partial_Refinement_Constituents (State_Id); Partial_Refinement_Constituents (State_Id);
Constit_Elmt : Elmt_Id;
Constit_Id : Entity_Id;
Only_Partial : constant Boolean := Only_Partial : constant Boolean :=
not Has_Visible_Refinement (State_Id); not Has_Visible_Refinement (State_Id);
Constit_Elmt : Elmt_Id;
Constit_Id : Entity_Id;
Posted : Boolean := False; Posted : Boolean := False;
begin begin
@ -24922,9 +24928,9 @@ package body Sem_Prag is
while Present (Constit_Elmt) loop while Present (Constit_Elmt) loop
Constit_Id := Node (Constit_Elmt); Constit_Id := Node (Constit_Elmt);
-- Issue an error when a constituent of State_Id is -- Issue an error when a constituent of State_Id is utilized
-- utilized, and State_Id has only partial visible -- and State_Id has only partial visible refinement
-- refinement (SPARK RM 7.2.4(3d)). -- (SPARK RM 7.2.4(3d)).
if Only_Partial then if Only_Partial then
if Present_Then_Remove (Out_Constits, Constit_Id) if Present_Then_Remove (Out_Constits, Constit_Id)
@ -24936,8 +24942,8 @@ package body Sem_Prag is
then then
Error_Msg_Name_1 := Chars (State_Id); Error_Msg_Name_1 := Chars (State_Id);
SPARK_Msg_NE SPARK_Msg_NE
("constituent & of state % cannot be used in " ("constituent & of state % cannot be used in global "
& "global refinement", N, Constit_Id); & "refinement", N, Constit_Id);
Error_Msg_Name_1 := Chars (State_Id); Error_Msg_Name_1 := Chars (State_Id);
SPARK_Msg_N ("\use state % instead", N); SPARK_Msg_N ("\use state % instead", N);
end if; end if;
@ -25000,9 +25006,9 @@ package body Sem_Prag is
Item_Id := Node (Item_Elmt); Item_Id := Node (Item_Elmt);
-- When full refinement is visible, ensure that all of the -- When full refinement is visible, ensure that all of the
-- constituents are utilized and they have mode Output. -- constituents are utilized and they have mode Output. When
-- When only partial refinement is visible, ensure that -- only partial refinement is visible, ensure that no
-- no constituent is utilized. -- constituent is utilized.
if Ekind (Item_Id) = E_Abstract_State if Ekind (Item_Id) = E_Abstract_State
and then Has_Non_Null_Visible_Refinement (Item_Id) and then Has_Non_Null_Visible_Refinement (Item_Id)
@ -25066,17 +25072,16 @@ package body Sem_Prag is
end loop; end loop;
end if; end if;
-- Not one of the constituents appeared as Proof_In. When -- Not one of the constituents appeared as Proof_In. Always emit
-- full refinement is visible, always emit an error (SPARK RM -- an error when full refinement is visible (SPARK RM 7.2.4(3a)).
-- 7.2.4(3a)). When only partial refinement is visible, emit an -- When only partial refinement is visible, emit an error if the
-- error if the abstract state itself is not utilized (SPARK RM -- abstract state itself is not utilized (SPARK RM 7.2.4(3d)). In
-- 7.2.4(3d)). In the case where both are utilized, an error will -- the case where both are utilized, an error will be issued by
-- be issued in Check_State_And_Constituent_Use. -- Check_State_And_Constituent_Use.
if not Proof_In_Seen if not Proof_In_Seen
and then (Has_Visible_Refinement (State_Id) and then (Has_Visible_Refinement (State_Id)
or else or else Contains (Repeat_Items, State_Id))
Contains (Repeat_Items, State_Id))
then then
SPARK_Msg_NE SPARK_Msg_NE
("global refinement of state & must include at least one " ("global refinement of state & must include at least one "
@ -25165,15 +25170,19 @@ package body Sem_Prag is
SPARK_Msg_N ("\expected mode %, found mode %", Item); SPARK_Msg_N ("\expected mode %, found mode %", Item);
end Inconsistent_Mode_Error; end Inconsistent_Mode_Error;
-- Local variables
Enc_State : Entity_Id := Empty; Enc_State : Entity_Id := Empty;
-- Encapsulating state for constituent, Empty otherwise -- Encapsulating state for constituent, Empty otherwise
-- Start of processing for Check_Refined_Global_Item -- Start of processing for Check_Refined_Global_Item
begin begin
if Ekind_In (Item_Id, E_Abstract_State, E_Constant, E_Variable) if Ekind_In (Item_Id, E_Abstract_State,
E_Constant,
E_Variable)
then then
Enc_State := Encapsulating_State (Item_Id); Enc_State := Find_Encapsulating_State (States, Item_Id);
end if; end if;
-- When the state or object acts as a constituent of another -- When the state or object acts as a constituent of another
@ -25184,8 +25193,7 @@ package body Sem_Prag is
if Present (Enc_State) if Present (Enc_State)
and then (Has_Visible_Refinement (Enc_State) and then (Has_Visible_Refinement (Enc_State)
or else or else Has_Partial_Visible_Refinement (Enc_State))
Has_Partial_Visible_Refinement (Enc_State))
and then Contains (States, Enc_State) and then Contains (States, Enc_State)
then then
-- If the state has only partial visible refinement, remove it -- If the state has only partial visible refinement, remove it
@ -25360,8 +25368,8 @@ package body Sem_Prag is
end if; end if;
-- Record global items without full visible refinement found in -- Record global items without full visible refinement found in
-- pragma Global, which should (SPARK RM 7.2.4(3c)) or may (SPARK -- pragma Global which should be repeated in the global refinement
-- RM 7.2.4(3d)) be repeated in the global refinement. -- (SPARK RM 7.2.4(3c), SPARK RM 7.2.4(3d)).
if Ekind (Item_Id) /= E_Abstract_State if Ekind (Item_Id) /= E_Abstract_State
or else not Has_Visible_Refinement (Item_Id) or else not Has_Visible_Refinement (Item_Id)
@ -25523,6 +25531,7 @@ package body Sem_Prag is
procedure Report_Missing_Items is procedure Report_Missing_Items is
Item_Elmt : Elmt_Id; Item_Elmt : Elmt_Id;
Item_Id : Entity_Id; Item_Id : Entity_Id;
begin begin
-- Do not perform this check in an instance because it was already -- Do not perform this check in an instance because it was already
-- performed successfully in the generic template. -- performed successfully in the generic template.
@ -25650,10 +25659,11 @@ package body Sem_Prag is
-- refinement, prior to calling checking procedures which remove items -- refinement, prior to calling checking procedures which remove items
-- from the list of constituents. -- from the list of constituents.
No_Constit := No (In_Constits) No_Constit :=
and then No (In_Out_Constits) No (In_Constits)
and then No (Out_Constits) and then No (In_Out_Constits)
and then No (Proof_In_Constits); and then No (Out_Constits)
and then No (Proof_In_Constits);
-- For Input states with visible refinement, at least one constituent -- For Input states with visible refinement, at least one constituent
-- must be used as an Input in the global refinement. -- must be used as an Input in the global refinement.
@ -27267,46 +27277,10 @@ package body Sem_Prag is
Constits : Elist_Id; Constits : Elist_Id;
Context : Node_Id) Context : Node_Id)
is is
function Find_Encapsulating_State
(Constit_Id : Entity_Id) return Entity_Id;
-- Given the entity of a constituent, try to find a corresponding
-- encapsulating state that appears in the same context. The routine
-- returns Empty is no such state is found.
------------------------------
-- Find_Encapsulating_State --
------------------------------
function Find_Encapsulating_State
(Constit_Id : Entity_Id) return Entity_Id
is
State_Id : Entity_Id;
begin
-- Since a constituent may be part of a larger constituent set, climb
-- the encapsulating state chain looking for a state that appears in
-- the same context.
State_Id := Encapsulating_State (Constit_Id);
while Present (State_Id) loop
if Contains (States, State_Id) then
return State_Id;
end if;
State_Id := Encapsulating_State (State_Id);
end loop;
return Empty;
end Find_Encapsulating_State;
-- Local variables
Constit_Elmt : Elmt_Id; Constit_Elmt : Elmt_Id;
Constit_Id : Entity_Id; Constit_Id : Entity_Id;
State_Id : Entity_Id; State_Id : Entity_Id;
-- Start of processing for Check_State_And_Constituent_Use
begin begin
-- Nothing to do if there are no states or constituents -- Nothing to do if there are no states or constituents
@ -27325,7 +27299,7 @@ package body Sem_Prag is
-- state that appears in the same context and if this is the case, -- state that appears in the same context and if this is the case,
-- emit an error (SPARK RM 7.2.6(7)). -- emit an error (SPARK RM 7.2.6(7)).
State_Id := Find_Encapsulating_State (Constit_Id); State_Id := Find_Encapsulating_State (States, Constit_Id);
if Present (State_Id) then if Present (State_Id) then
Error_Msg_Name_1 := Chars (Constit_Id); Error_Msg_Name_1 := Chars (Constit_Id);
@ -27801,6 +27775,33 @@ package body Sem_Prag is
return Num_Primitives (E mod 511); return Num_Primitives (E mod 511);
end Entity_Hash; end Entity_Hash;
------------------------------
-- Find_Encapsulating_State --
------------------------------
function Find_Encapsulating_State
(States : Elist_Id;
Constit_Id : Entity_Id) return Entity_Id
is
State_Id : Entity_Id;
begin
-- Since a constituent may be part of a larger constituent set, climb
-- the encapsulating state chain looking for a state that appears in
-- States.
State_Id := Encapsulating_State (Constit_Id);
while Present (State_Id) loop
if Contains (States, State_Id) then
return State_Id;
end if;
State_Id := Encapsulating_State (State_Id);
end loop;
return Empty;
end Find_Encapsulating_State;
-------------------------- --------------------------
-- Find_Related_Context -- -- Find_Related_Context --
-------------------------- --------------------------