===================================================================
@@ -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;
===================================================================
@@ -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
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 <schonberg@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.