This patch fixes an omission in the inheritance of predicate aspects in type
derivations. The parent type may be a subtype declaration or a type declaration
with a dynamic predicate aspect, and the aspect applies to a first subtype, not
to its anonymous parent type.
Eecuting:
gnatmake -q -gnata test_it
test_it
must yield:
2 in Even is TRUE
3 in Even is FALSE
2 in New_Even is TRUE
3 in New_Even is FALSE
2 in Newer_Even is TRUE
3 in Newer_Even is FALSE
OK
---
with Text_IO; use Text_IO;
procedure Test_It is
type Even is new Integer with
Dynamic_Predicate => Even mod 2 = 0;
subtype Other_Even is Integer with
Dynamic_Predicate => Other_Even mod 2 = 0;
type New_Even is new Even;
type Newer_Even is new Other_Even;
B : Boolean;
subtype Small is Integer range -5 .. 5;
type New_Small is new Small;
begin
B := 2 in Even;
Put_Line ("2 in Even is " & B'Img);
B := 3 in Even;
Put_Line ("3 in Even is " & B'Img);
B := 2 in New_Even;
Put_Line ("2 in New_Even is " & B'Img);
B := 3 in New_Even;
Put_Line ("3 in New_Even is " & B'Img);
B := 2 in Newer_Even;
Put_Line ("2 in Newer_Even is " & B'Img);
B := 3 in Newer_Even;
Put_Line ("3 in Newer_Even is " & B'Img);
declare
X : New_Even;
begin
X := 13;
exception
when Others => Put_Line ("OK");
end;
end;
Tested on x86_64-pc-linux-gnu, committed on trunk
2017-01-12 Ed Schonberg <schonb...@adacore.com>
* sem_ch3.adb (Build_Derived_Type): For a scalar derived type,
inherit predicates if any from the first_subtype of the parent,
not from the anonymous parent type.
* sem_eval.adb (Is_Static_Subtype): A type that inherits a dynamic
predicate is not a static subtype.
Index: sem_ch3.adb
===================================================================
--- sem_ch3.adb (revision 244366)
+++ sem_ch3.adb (working copy)
@@ -9127,9 +9127,13 @@
end if;
end if;
- -- We similarly inherit predicates
+ -- We similarly inherit predicates. Note that for scalar derived types
+ -- the predicate is inherited from the first subtype, and not from its
+ -- (anonymous) base type.
- if Has_Predicates (Parent_Type) then
+ if Has_Predicates (Parent_Type)
+ or else Has_Predicates (First_Subtype (Parent_Type))
+ then
Set_Has_Predicates (Derived_Type);
end if;
Index: sem_eval.adb
===================================================================
--- sem_eval.adb (revision 244350)
+++ sem_eval.adb (working copy)
@@ -23,6 +23,7 @@
-- --
------------------------------------------------------------------------------
+with Aspects; use Aspects;
with Atree; use Atree;
with Checks; use Checks;
with Debug; use Debug;
@@ -4989,7 +4990,13 @@
then
return False;
- elsif Has_Dynamic_Predicate_Aspect (Typ) then
+ -- If there is a dynamic predicate for the type (declared or inherited)
+ -- the expression is not static.
+
+ elsif Has_Dynamic_Predicate_Aspect (Typ)
+ or else (Is_Derived_Type (Typ)
+ and then Has_Aspect (Typ, Aspect_Dynamic_Predicate))
+ then
return False;
-- String types
