Static_Predicate should not be applied on non-scalar types. The example below
is now rejected by GNAT:
$ gcc -c -gnat12 t.ads
1. package T is
2. type R is tagged record
|
>>> static predicate not allowed for non-scalar type "R"
3. A, B : Integer;
4. end record with Static_Predicate => R.A = 0 and R.B = 0;
5. end T;
Tested on x86_64-pc-linux-gnu, committed on trunk
2013-04-23 Yannick Moy <m...@adacore.com>
* einfo.ads: Minor typo fix.
* sem_ch13.adb (Build_Predicate_Functions): Reject cases where
Static_Predicate is applied to a non-scalar or non-static type.
* sem_prag.adb: Minor typo fix.
Index: einfo.ads
===================================================================
--- einfo.ads (revision 198194)
+++ einfo.ads (working copy)
@@ -2544,7 +2544,7 @@
-- entirely synthesized, by looking at the bounds, and the immediate
-- subtype parent. However, this method does not work for some Itypes
-- that have no parent set (and the only way to find the immediate
--- subtype parent is to go through the tree). For now, this flay is set
+-- subtype parent is to go through the tree). For now, this flag is set
-- conservatively, i.e. if it is set then for sure the subtype is non-
-- static, but if it is not set, then the type may or may not be static.
-- Thus the test for a static subtype is that this flag is clear AND that
Index: sem_prag.adb
===================================================================
--- sem_prag.adb (revision 198195)
+++ sem_prag.adb (working copy)
@@ -8121,8 +8121,8 @@
-- Set Check_On to indicate check status
-- If this comes from an aspect, we have already taken care of
- -- the policy active when the aspect was analyzed, and Is_Ignore
- -- is set appriately already.
+ -- the policy active when the aspect was analyzed, and Is_Ignored
+ -- is set appropriately already.
if From_Aspect_Specification (N) then
Check_On := not Is_Ignored (N);
Index: sem_ch13.adb
===================================================================
--- sem_ch13.adb (revision 198184)
+++ sem_ch13.adb (working copy)
@@ -980,7 +980,7 @@
-- Perform analysis of the External_Name or Link_Name aspects
procedure Analyze_Aspect_Implicit_Dereference;
- -- Perform analysis of the Implicit_Dereference aspects
+ -- Perform analysis of the Implicit_Dereference aspects
procedure Make_Aitem_Pragma
(Pragma_Argument_Associations : List_Id;
@@ -1082,8 +1082,8 @@
Pragma_Argument_Associations,
Pragma_Identifier =>
Make_Identifier (Sloc (Id), Pragma_Name),
- Class_Present => Class_Present (Aspect),
- Split_PPC => Split_PPC (Aspect));
+ Class_Present => Class_Present (Aspect),
+ Split_PPC => Split_PPC (Aspect));
-- Set additional semantic fields
@@ -5707,7 +5707,7 @@
-- Build_Predicate_Functions --
-------------------------------
- -- The procedures that are constructed here has the form:
+ -- The procedures that are constructed here have the form:
-- function typPredicate (Ixxx : typ) return Boolean is
-- begin
@@ -5725,8 +5725,8 @@
-- use this function even if checks are off, e.g. for membership tests.
-- If the expression has at least one Raise_Expression, then we also build
- -- the typPredicateM version of the function, in which any occurence of a
- -- Raise_Expressioon is converted to "return False".
+ -- the typPredicateM version of the function, in which any occurrence of a
+ -- Raise_Expression is converted to "return False".
procedure Build_Predicate_Functions (Typ : Entity_Id; N : Node_Id) is
Loc : constant Source_Ptr := Sloc (Typ);
@@ -6216,23 +6216,49 @@
-- Deal with static predicate case
- if Ekind_In (Typ, E_Enumeration_Subtype,
- E_Modular_Integer_Subtype,
- E_Signed_Integer_Subtype)
+ -- ??? We don't currently deal with real types
+ -- ??? Why requiring that Typ is static?
+
+ if Ekind (Typ) in Discrete_Kind
and then Is_Static_Subtype (Typ)
and then not Dynamic_Predicate_Present
then
- Build_Static_Predicate (Typ, Expr, Object_Name);
+ -- Only build the predicate for subtypes
- if Present (Static_Predicate_Present)
- and No (Static_Predicate (Typ))
+ if Ekind_In (Typ, E_Enumeration_Subtype,
+ E_Modular_Integer_Subtype,
+ E_Signed_Integer_Subtype)
then
- Error_Msg_F
- ("expression does not have required form for "
- & "static predicate",
- Next (First (Pragma_Argument_Associations
- (Static_Predicate_Present))));
+ Build_Static_Predicate (Typ, Expr, Object_Name);
+
+ if Present (Static_Predicate_Present)
+ and No (Static_Predicate (Typ))
+ then
+ Error_Msg_F
+ ("expression does not have required form for "
+ & "static predicate",
+ Next (First (Pragma_Argument_Associations
+ (Static_Predicate_Present))));
+ end if;
end if;
+
+ -- If a Static_Predicate applies on other types, that's an error:
+ -- either the type is scalar but non-static, or it's not even a
+ -- scalar type. We do not issue an error on generated types, as these
+ -- would be duplicates of the same error on a source type.
+
+ elsif Present (Static_Predicate_Present)
+ and then Comes_From_Source (Typ)
+ then
+ if Is_Scalar_Type (Typ) then
+ Error_Msg_FE
+ ("static predicate not allowed for non-static type&",
+ Typ, Typ);
+ else
+ Error_Msg_FE
+ ("static predicate not allowed for non-scalar type&",
+ Typ, Typ);
+ end if;
end if;
end if;
end Build_Predicate_Functions;
