[Ada] Do not force Part_Of on generic units
This fixes the code checking SPARK RM 7.2.6(3) so that generic child units are not forced to use Part_Of to relate their abstract state to the state of their parent. 2018-06-11 Yannick Moy <moy@adacore.com> gcc/ada/ * sem_prag.adb (Analyze_Part_Of): Only allow Part_Of on non-generic unit. (Check_Missing_Part_Of): Do not force Part_Of on generic unit. gcc/testsuite/ * gnat.dg/part_of1-instantiation.adb, gnat.dg/part_of1-instantiation.ads, gnat.dg/part_of1-private_generic.adb, gnat.dg/part_of1-private_generic.ads, gnat.dg/part_of1.ads: New testcase. From-SVN: r261412
This commit is contained in:
parent
270c6b4d6f
commit
d05bdd90e6
8 changed files with 73 additions and 12 deletions
|
@ -1,3 +1,9 @@
|
|||
2018-06-11 Yannick Moy <moy@adacore.com>
|
||||
|
||||
* sem_prag.adb (Analyze_Part_Of): Only allow Part_Of on non-generic
|
||||
unit.
|
||||
(Check_Missing_Part_Of): Do not force Part_Of on generic unit.
|
||||
|
||||
2018-06-11 Piotr Trojanek <trojanek@adacore.com>
|
||||
|
||||
* sem_ch13.adb (Analyze_Aspect_Specifications): Don't split AND THEN
|
||||
|
|
|
@ -3200,20 +3200,21 @@ package body Sem_Prag is
|
|||
|
||||
-- The item appears in the visible state space of some package. In
|
||||
-- general this scenario does not warrant Part_Of except when the
|
||||
-- package is a private child unit and the encapsulating state is
|
||||
-- declared in a parent unit or a public descendant of that parent
|
||||
-- unit.
|
||||
-- package is a non-generic private child unit and the encapsulating
|
||||
-- state is declared in a parent unit or a public descendant of that
|
||||
-- parent unit.
|
||||
|
||||
elsif Placement = Visible_State_Space then
|
||||
if Is_Child_Unit (Pack_Id)
|
||||
and then not Is_Generic_Unit (Pack_Id)
|
||||
and then Is_Private_Descendant (Pack_Id)
|
||||
then
|
||||
-- A variable or state abstraction which is part of the visible
|
||||
-- state of a private child unit or its public descendants must
|
||||
-- have its Part_Of indicator specified. The Part_Of indicator
|
||||
-- must denote a state declared by either the parent unit of
|
||||
-- the private unit or by a public descendant of that parent
|
||||
-- unit.
|
||||
-- state of a non-generic private child unit or its public
|
||||
-- descendants must have its Part_Of indicator specified. The
|
||||
-- Part_Of indicator must denote a state declared by either the
|
||||
-- parent unit of the private unit or by a public descendant of
|
||||
-- that parent unit.
|
||||
|
||||
-- Find the nearest private ancestor (which can be the current
|
||||
-- unit itself).
|
||||
|
@ -3250,8 +3251,9 @@ package body Sem_Prag is
|
|||
return;
|
||||
end if;
|
||||
|
||||
-- Indicator Part_Of is not needed when the related package is not
|
||||
-- a private child unit or a public descendant thereof.
|
||||
-- Indicator Part_Of is not needed when the related package is
|
||||
-- not a non-generic private child unit or a public descendant
|
||||
-- thereof.
|
||||
|
||||
else
|
||||
SPARK_Msg_N
|
||||
|
@ -28831,11 +28833,13 @@ package body Sem_Prag is
|
|||
|
||||
-- In general an item declared in the visible state space of a package
|
||||
-- does not require a Part_Of indicator. The only exception is when the
|
||||
-- related package is a private child unit in which case Part_Of must
|
||||
-- denote a state in the parent unit or in one of its descendants.
|
||||
-- related package is a non-generic private child unit in which case
|
||||
-- Part_Of must denote a state in the parent unit or in one of its
|
||||
-- descendants.
|
||||
|
||||
elsif Placement = Visible_State_Space then
|
||||
if Is_Child_Unit (Pack_Id)
|
||||
and then not Is_Generic_Unit (Pack_Id)
|
||||
and then Is_Private_Descendant (Pack_Id)
|
||||
then
|
||||
-- A package instantiation does not need a Part_Of indicator when
|
||||
|
|
|
@ -1,3 +1,11 @@
|
|||
2018-06-11 Yannick Moy <moy@adacore.com>
|
||||
|
||||
* gnat.dg/part_of1-instantiation.adb,
|
||||
gnat.dg/part_of1-instantiation.ads,
|
||||
gnat.dg/part_of1-private_generic.adb,
|
||||
gnat.dg/part_of1-private_generic.ads, gnat.dg/part_of1.ads: New
|
||||
testcase.
|
||||
|
||||
2018-06-11 Piotr Trojanek <trojanek@adacore.com>
|
||||
|
||||
* gnat.dg/contract1.adb: New testcase.
|
||||
|
|
10
gcc/testsuite/gnat.dg/part_of1-instantiation.adb
Normal file
10
gcc/testsuite/gnat.dg/part_of1-instantiation.adb
Normal file
|
@ -0,0 +1,10 @@
|
|||
-- { dg-do compile }
|
||||
|
||||
with Part_Of1.Private_Generic;
|
||||
|
||||
package body Part_Of1.Instantiation
|
||||
with
|
||||
Refined_State => (State => Inst.State)
|
||||
is
|
||||
package Inst is new Part_Of1.Private_Generic;
|
||||
end Part_Of1.Instantiation;
|
6
gcc/testsuite/gnat.dg/part_of1-instantiation.ads
Normal file
6
gcc/testsuite/gnat.dg/part_of1-instantiation.ads
Normal file
|
@ -0,0 +1,6 @@
|
|||
package Part_Of1.Instantiation
|
||||
with
|
||||
Abstract_State => State
|
||||
is
|
||||
pragma Elaborate_Body;
|
||||
end Part_Of1.Instantiation;
|
13
gcc/testsuite/gnat.dg/part_of1-private_generic.adb
Normal file
13
gcc/testsuite/gnat.dg/part_of1-private_generic.adb
Normal file
|
@ -0,0 +1,13 @@
|
|||
package body Part_Of1.Private_Generic
|
||||
with
|
||||
Refined_State => (State => Numbers)
|
||||
is
|
||||
Numbers : array (Range_Type) of Integer := (others => 0);
|
||||
|
||||
function Get (I : Range_Type) return Integer
|
||||
is
|
||||
begin
|
||||
return Numbers (I);
|
||||
end Get;
|
||||
|
||||
end Part_Of1.Private_Generic;
|
12
gcc/testsuite/gnat.dg/part_of1-private_generic.ads
Normal file
12
gcc/testsuite/gnat.dg/part_of1-private_generic.ads
Normal file
|
@ -0,0 +1,12 @@
|
|||
private generic
|
||||
Count : Integer := 4;
|
||||
package Part_Of1.Private_Generic
|
||||
with
|
||||
Abstract_State => State
|
||||
is
|
||||
|
||||
subtype Range_Type is Integer range 1 .. Count;
|
||||
|
||||
function Get (I : Range_Type) return Integer;
|
||||
|
||||
end Part_Of1.Private_Generic;
|
2
gcc/testsuite/gnat.dg/part_of1.ads
Normal file
2
gcc/testsuite/gnat.dg/part_of1.ads
Normal file
|
@ -0,0 +1,2 @@
|
|||
package Part_Of1 is
|
||||
end Part_Of1;
|
Loading…
Add table
Reference in a new issue