From 622599c6d2359ad2f43445754be185b0b177430a Mon Sep 17 00:00:00 2001 From: Robert Dewar Date: Fri, 30 Jan 2015 15:31:01 +0000 Subject: [PATCH] a-assert.adb: Minor reformatting. 2015-01-30 Robert Dewar * 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 | 9 +++++++++ gcc/ada/a-assert.adb | 1 - gcc/ada/sem_ch13.adb | 11 +++++++---- gcc/ada/sem_eval.adb | 27 +++++++++++++++++++-------- gcc/ada/types.ads | 4 ++-- 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 + + * 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 * 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; - -- If no inherited predicate, copy whole expression + -- Otherwise inherited predicate is static, check for match + + else + return Real_Or_String_Static_Predicate_Matches (Val, Typ); + end if; + end; + + -- 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;