diff options
author | Ed Schonberg <schonberg@adacore.com> | 2018-12-11 11:09:46 +0000 |
---|---|---|
committer | Pierre-Marie de Rodat <pmderodat@gcc.gnu.org> | 2018-12-11 11:09:46 +0000 |
commit | f5d4b6ab396f6d92ead4a356fe0b4dfdd15c332e (patch) | |
tree | 36ab5bc9403781912d80f9cfc9047349baa85409 | |
parent | 56bad7dbfb28ef984d23ff9f69de5db431d02a15 (diff) | |
download | gcc-f5d4b6ab396f6d92ead4a356fe0b4dfdd15c332e.zip gcc-f5d4b6ab396f6d92ead4a356fe0b4dfdd15c332e.tar.gz gcc-f5d4b6ab396f6d92ead4a356fe0b4dfdd15c332e.tar.bz2 |
[Ada] Spurious visibility error on aspect Predicate
The GNAT-defined aspect Predicate has the same semantics as the Ada
aspect Dynamic_Predicate, including direct visibility to the components
of a record type to which the aspect applies.
The following must compile quietly:
gcc -c integer_stacks.ads
----
pragma SPARK_Mode (On);
with Bounded_Stacks;
package Integer_Stacks is
new Bounded_Stacks (Element => Integer, Default_Element => 0);
----
generic
type Element is private;
Default_Element : Element;
package Bounded_Stacks is
type Stack (Capacity : Positive) is tagged private
with Default_Initial_Condition => Empty (Stack);
function "=" (Left, Right : Stack) return Boolean;
function Extent (This : Stack) return Natural;
function Empty (This : Stack) return Boolean;
function Full (This : Stack) return Boolean;
procedure Reset (This : out Stack) with
Post'Class => Empty (This) and
not Full (This),
Global => null,
Depends => (This =>+ null);
procedure Push (This : in out Stack; Item : Element) with
Pre'Class => not Full (This) and
Extent (This) < This.Capacity,
Post'Class => not Empty (This) and
Extent (This) = Extent (This'Old) + 1,
Global => null,
Depends => (This =>+ Item);
procedure Pop (This : in out Stack; Item : out Element) with
Pre'Class => not Empty (This),
Post'Class => not Full (This) and
Extent (This) = Extent (This'Old) - 1,
Global => null,
Depends => (This =>+ null, Item => This);
function Peek (This : Stack) return Element with
Pre'Class => not Empty (This),
Global => null,
Depends => (Peek'Result => This);
private
type Contents is array (Positive range <>) of Element;
type Stack (Capacity : Positive) is tagged record
Values : Contents (1 .. Capacity); -- := (others => Default_Element);
-- Top : Natural;
Top : Natural := 0;
end record with Predicate => Top <= Capacity,
Annotate => (GNATprove,
Intentional,
"type ""Stack"" is not fully initialized",
"Because zeroing Top is sufficient");
end Bounded_Stacks;
----
package body Bounded_Stacks is
------------
-- Extent --
------------
function Extent (This : Stack) return Natural is
(This.Top);
-----------
-- Empty --
-----------
function Empty (This : Stack) return Boolean is
(This.Top = 0);
----------
-- Full --
----------
function Full (This : Stack) return Boolean is
(This.Top = This.Capacity);
-----------
-- Reset --
-----------
procedure Reset (This : out Stack) is
begin
This := (This.Capacity, Top => 0, others => <>);
-- This.Top := 0;
end Reset;
----------
-- Push --
----------
procedure Push (This : in out Stack; Item : Element) is
begin
This.Top := This.Top + 1;
This.Values (This.Top) := Item;
end Push;
---------
-- Pop --
---------
procedure Pop (This : in out Stack; Item : out Element) is
begin
Item := This.Values (This.Top);
This.Top := This.Top - 1;
end Pop;
----------
-- Peek --
----------
function Peek (This : Stack) return Element is
(This.Values (This.Top));
---------
-- "=" --
---------
function "=" (Left, Right : Stack) return Boolean is
begin
if Left.Top /= Right.Top then
return False;
else
for K in 1 .. Left.Top loop
if Left.Values (K) /= Right.Values (K) then
return False;
end if;
end loop;
return True;
end if;
end "=";
end Bounded_Stacks;
----
2018-12-11 Ed Schonberg <schonberg@adacore.com>
gcc/ada/
* sem_ch13.adb (Check_Aspect_At_End_Of_Declarations,
Freeze_Entity_Checks): Process aspect Predicate in the same
fashion as aspect Dynamic_Predicate.
From-SVN: r266985
-rw-r--r-- | gcc/ada/ChangeLog | 6 | ||||
-rw-r--r-- | gcc/ada/sem_ch13.adb | 2 |
2 files changed, 8 insertions, 0 deletions
diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog index 5169d0a..50f53b8 100644 --- a/gcc/ada/ChangeLog +++ b/gcc/ada/ChangeLog @@ -1,3 +1,9 @@ +2018-12-11 Ed Schonberg <schonberg@adacore.com> + + * sem_ch13.adb (Check_Aspect_At_End_Of_Declarations, + Freeze_Entity_Checks): Process aspect Predicate in the same + fashion as aspect Dynamic_Predicate. + 2018-12-11 Eric Botcazou <ebotcazou@adacore.com> * gcc-interface/trans.c (elaborate_all_entities_for_package): diff --git a/gcc/ada/sem_ch13.adb b/gcc/ada/sem_ch13.adb index e1bc6bc..fb8dff0 100644 --- a/gcc/ada/sem_ch13.adb +++ b/gcc/ada/sem_ch13.adb @@ -9364,6 +9364,7 @@ package body Sem_Ch13 is -- components and discriminants of the type. elsif A_Id = Aspect_Dynamic_Predicate + or else A_Id = Aspect_Predicate or else A_Id = Aspect_Priority then Push_Type (Ent); @@ -11252,6 +11253,7 @@ package body Sem_Ch13 is then A_Id := Get_Aspect_Id (Ritem); if A_Id = Aspect_Dynamic_Predicate + or else A_Id = Aspect_Predicate or else A_Id = Aspect_Priority then -- Retrieve the visibility to components and discriminants |