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.



git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@220290 138bc75d-0d04-0410-961f-82ee72b054a4

5 files changed, 37 insertions, 15 deletions

diff --git a/gcc/ada/ChangeLog b/gcc/ada/ChangeLog
index 74279b19742..2668fcc4066 100644
--- a/gcc/ada/ChangeLog
+++ b/gcc/ada/ChangeLog
@@ -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
diff --git a/gcc/ada/a-assert.adb b/gcc/ada/a-assert.adb
index 54b84b4e750..bfdcd157245 100644
--- a/gcc/ada/a-assert.adb
+++ b/gcc/ada/a-assert.adb
@@ -32,7 +32,6 @@
 package body Ada.Assertions with
   SPARK_Mode
 is
-
    ------------
    -- Assert --
    ------------
diff --git a/gcc/ada/sem_ch13.adb b/gcc/ada/sem_ch13.adb
index f489cb8d814..10b0062f3b3 100644
--- a/gcc/ada/sem_ch13.adb
+++ b/gcc/ada/sem_ch13.adb
@@ -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)))
diff --git a/gcc/ada/sem_eval.adb b/gcc/ada/sem_eval.adb
index 5d8aa4f53be..d01d458b2c7 100644
--- a/gcc/ada/sem_eval.adb
+++ b/gcc/ada/sem_eval.adb
@@ -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);
diff --git a/gcc/ada/types.ads b/gcc/ada/types.ads
index 29caf1f851d..ed3eac1d43c 100644
--- a/gcc/ada/types.ads
+++ b/gcc/ada/types.ads
@@ -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;