Patchwork [Ada] Reject illegal uses of Static_Predicate

login
register
mail settings
Submitter Arnaud Charlet
Date April 23, 2013, 2:57 p.m.
Message ID <20130423145747.GA9591@adacore.com>
Download mbox | patch
Permalink /patch/238937/
State New
Headers show

Comments

Arnaud Charlet - April 23, 2013, 2:57 p.m.
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  <moy@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.

Patch

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;