a-assert.adb: Minor reformatting.
authorRobert Dewar <dewar@adacore.com>
Fri, 30 Jan 2015 15:31:01 +0000 (15:31 +0000)
committerArnaud Charlet <charlet@gcc.gnu.org>
Fri, 30 Jan 2015 15:31:01 +0000 (16:31 +0100)
2015-01-30  Robert Dewar  <dewar@adacore.com>

* a-assert.adb: Minor reformatting.
* sem_ch13.adb: Minor comment clarification.
* types.ads: Minor comment update.
* sem_eval.adb (Real_Or_String_Static_Predicate_Matches): Avoid blow up
when we have a predicate that is nothing but an inherited dynamic
predicate.

From-SVN: r220290

gcc/ada/ChangeLog
gcc/ada/a-assert.adb
gcc/ada/sem_ch13.adb
gcc/ada/sem_eval.adb
gcc/ada/types.ads

index 74279b19742ecda3184b48cf1756f38e87f940b3..2668fcc4066e9b852813f2c1beacaac3be299e2f 100644 (file)
@@ -1,3 +1,12 @@
+2015-01-30  Robert Dewar  <dewar@adacore.com>
+
+       * a-assert.adb: Minor reformatting.
+       * sem_ch13.adb: Minor comment clarification.
+       * types.ads: Minor comment update.
+       * sem_eval.adb (Real_Or_String_Static_Predicate_Matches): Avoid blow up
+       when we have a predicate that is nothing but an inherited dynamic
+       predicate.
+
 2015-01-30  Jerome Guitton  <guitton@adacore.com>
 
        * gcc-interface/Makefile.in (x86-vxworks): Update GCC_SPEC_FILES to
index 54b84b4e75050a749ebe5eedf193c13f183edfcf..bfdcd157245a4a32984e2ff501ba074f64920573 100644 (file)
@@ -32,7 +32,6 @@
 package body Ada.Assertions with
   SPARK_Mode
 is
-
    ------------
    -- Assert --
    ------------
index f489cb8d814b71d57e95ac8f821e28664d8b7864..10b0062f3b3b5819d072271908ef056fc95db09a 100644 (file)
@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 B o d y                                  --
 --                                                                          --
---          Copyright (C) 1992-2014, Free Software Foundation, Inc.         --
+--          Copyright (C) 1992-2015, Free Software Foundation, Inc.         --
 --                                                                          --
 -- GNAT is free software;  you can  redistribute it  and/or modify it under --
 -- terms of the  GNU General Public License as published  by the Free Soft- --
@@ -11281,9 +11281,12 @@ package body Sem_Ch13 is
       --    expression and then xxPredicate (typ (Inns))
 
       --  Where the call is to a Predicate function for an inherited predicate.
-      --  We simply ignore such a call (which could be to either a dynamic or
-      --  a static predicate, but remember that we can have a Static_Predicate
-      --  for a non-static subtype).
+      --  We simply ignore such a call, which could be to either a dynamic or
+      --  a static predicate. Note that if the parent predicate is dynamic then
+      --  eventually this type will be marked as dynamic, but you are allowed
+      --  to specify a static predicate for a subtype which is inheriting a
+      --  dynamic predicate, so the static predicate validation here ignores
+      --  the inherited predicate even if it is dynamic.
 
       elsif Nkind (Expr) = N_Function_Call
         and then Is_Predicate_Function (Entity (Name (Expr)))
index 5d8aa4f53be323950d997e9fd3345b1bf05a4e7a..d01d458b2c728f2df0763fcb51607554508132a5 100644 (file)
@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 B o d y                                  --
 --                                                                          --
---          Copyright (C) 1992-2014, Free Software Foundation, Inc.         --
+--          Copyright (C) 1992-2015, Free Software Foundation, Inc.         --
 --                                                                          --
 -- GNAT is free software;  you can  redistribute it  and/or modify it under --
 -- terms of the  GNU General Public License as published  by the Free Soft- --
@@ -5432,18 +5432,29 @@ package body Sem_Eval is
 
          Copy := Copy_Separate_Tree (Left_Opnd (Expr));
 
-      --  Case where call to predicate function appears on its own
+      --  Case where call to predicate function appears on its own (this means
+      --  that the predicate at this level is just inherited from the parent).
 
       elsif Nkind (Expr) =  N_Function_Call then
+         declare
+            Typ : constant Entity_Id :=
+                    Etype (First_Formal (Entity (Name (Expr))));
 
-         --  Here the result is just the result of calling the inner predicate
+         begin
+            --  If the inherited predicate is dynamic, just ignore it. We can't
+            --  go trying to evaluate a dynamic predicate as a static one!
 
-         return
-           Real_Or_String_Static_Predicate_Matches
-             (Val => Val,
-              Typ => Etype (First_Formal (Entity (Name (Expr)))));
+            if Has_Dynamic_Predicate_Aspect (Typ) then
+               return True;
+
+            --  Otherwise inherited predicate is static, check for match
+
+            else
+               return Real_Or_String_Static_Predicate_Matches (Val, Typ);
+            end if;
+         end;
 
-      --  If no inherited predicate, copy whole expression
+      --  If not just an inherited predicate, copy whole expression
 
       else
          Copy := Copy_Separate_Tree (Expr);
index 29caf1f851d727e0c39dc8fbcae8240a9d6b6e57..ed3eac1d43ca116077a0b8b2c206fa9d5f6a66eb 100644 (file)
@@ -6,7 +6,7 @@
 --                                                                          --
 --                                 S p e c                                  --
 --                                                                          --
---          Copyright (C) 1992-2014, Free Software Foundation, Inc.         --
+--          Copyright (C) 1992-2015, Free Software Foundation, Inc.         --
 --                                                                          --
 -- GNAT is free software;  you can  redistribute it  and/or modify it under --
 -- terms of the  GNU General Public License as published  by the Free Soft- --
@@ -107,7 +107,7 @@ package Types is
 
    subtype Upper_Half_Character is
      Character range Character'Val (16#80#) .. Character'Val (16#FF#);
-   --  Characters with the upper bit set
+   --  8-bit Characters with the upper bit set
 
    type Character_Ptr is access all Character;
    type String_Ptr    is access all String;