In Ada 2012, static matching of subtypes requires that the static predicates
that apply to the subtypes come from the same declaration.
Compiling predmatch.ads in Ada 2012 mode must yield:
predmatch.ads:5:21: object subtype must statically match designated subtype
predmatch.ads:12:22: object subtype must statically match designated subtype
predmatch.ads:15:22: object subtype must statically match designated subtype
---
package Predmatch is
type Int_Ref is access all Integer;
subtype Even is Integer with Dynamic_predicate => Even mod 2 = 0;
X1 : aliased Even;
Ptr : Int_Ref := X1'access; -- Illegal in Ada 2012
subtype Little_Even is Integer
with
Static_Predicate => Little_Even in 2 | 4 | 8 | 16;
X2 : aliased Little_Even;
Ptr2 : Int_Ref := X2'Access; -- illegal in Ada 2012
type Pos_Ref is access all Positive;
Ptr3 : Pos_Ref := X1'access; -- Illegal in Ada 2005
subtype Mult2 is Even;
type Mult_Ref is access all Mult2;
Ptr4 : Mult_Ref := X1'Access; -- OK, same predicate
end Predmatch;
Tested on x86_64-pc-linux-gnu, committed on trunk
2012-05-15 Ed Schonberg <[email protected]>
* sem_eval.adb (Subtypes_Statically_Match): In Ada 2012, static
matching requires matching of static subtype predicates as well.
Index: sem_eval.adb
===================================================================
--- sem_eval.adb (revision 187504)
+++ sem_eval.adb (working copy)
@@ -4664,6 +4664,41 @@
-- values match (RM 4.9.1(1)).
function Subtypes_Statically_Match (T1, T2 : Entity_Id) return Boolean is
+
+ function Predicates_Match return Boolean;
+ -- In Ada 2012, subtypes statically match if their static predicates
+ -- match as well.
+
+ function Predicates_Match return Boolean is
+ Pred1 : Node_Id;
+ Pred2 : Node_Id;
+
+ begin
+ if Ada_Version < Ada_2012 then
+ return True;
+
+ elsif Has_Predicates (T1) /= Has_Predicates (T2) then
+ return False;
+
+ else
+ Pred1 := Get_Rep_Item_For_Entity (T1, Name_Static_Predicate);
+ Pred2 := Get_Rep_Item_For_Entity (T2, Name_Static_Predicate);
+
+ -- Subtypes statically match if the predicate comes from the
+ -- same declaration, which can only happen if one is a subtype
+ -- of the other and has no explicit predicate.
+
+ -- Suppress warnings on order of actuals, which is otherwise
+ -- triggered by one of the two calls below.
+
+ pragma Warnings (Off);
+ return Pred1 = Pred2
+ or else (No (Pred1) and then Is_Subtype_Of (T1, T2))
+ or else (No (Pred2) and then Is_Subtype_Of (T2, T1));
+ pragma Warnings (On);
+ end if;
+ end Predicates_Match;
+
begin
-- A type always statically matches itself
@@ -4736,7 +4771,7 @@
-- If the bounds are the same tree node, then match
if LB1 = LB2 and then HB1 = HB2 then
- return True;
+ return Predicates_Match;
-- Otherwise bounds must be static and identical value
