From 622599c6d2359ad2f43445754be185b0b177430a Mon Sep 17 00:00:00 2001 From: Robert Dewar Date: Fri, 30 Jan 2015 15:31:01 +0000 Subject: 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/sem_eval.adb | 27 +++++++++++++++++++-------- 1 file changed, 19 insertions(+), 8 deletions(-) (limited to 'gcc/ada/sem_eval.adb') diff --git a/gcc/ada/sem_eval.adb b/gcc/ada/sem_eval.adb index 5d8aa4f..d01d458 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); -- cgit v1.1