From 2e1295ade52283a56984222331d603c85ae6d19a Mon Sep 17 00:00:00 2001 From: Arnaud Charlet Date: Mon, 4 Aug 2014 12:43:41 +0200 Subject: [multiple changes] 2014-08-04 Robert Dewar * inline.adb, einfo.ads, s-tassta.adb, s-tarest.adb: Minor comment fixes. 2014-08-04 Ed Schonberg * sem_prag.adb (Process_Import_Or_Interface): Handle properly an aspect Import that specifies a False value. 2014-08-04 Robert Dewar * gnat_rm.texi: Add section on aspect Invariant'Class. 2014-08-04 Ed Schonberg * sem_case.adb (Check_Choice_Set): New flag Predicate_Error, for better control of cascaded error messages when some choice in a case statement over a predicated type violates the given static predicate. 2014-08-04 Hristian Kirtchev * sem_ch3.adb (Build_Derived_Type): Modify the inheritance of the rep chain to ensure that a non-tagged type's items are not clobbered during the inheritance. From-SVN: r213566 --- gcc/ada/sem_case.adb | 25 +++++++++++++++++++++++-- 1 file changed, 23 insertions(+), 2 deletions(-) (limited to 'gcc/ada/sem_case.adb') diff --git a/gcc/ada/sem_case.adb b/gcc/ada/sem_case.adb index 1009bb0..b14f047 100644 --- a/gcc/ada/sem_case.adb +++ b/gcc/ada/sem_case.adb @@ -113,7 +113,12 @@ package body Sem_Case is Subtyp : Entity_Id; Others_Present : Boolean; Case_Node : Node_Id) + is + Predicate_Error : Boolean; + -- Flag to prevent cascaded errors when a static predicate is known to + -- be violated by one choice. + procedure Check_Against_Predicate (Pred : in out Node_Id; Choice : Choice_Bounds; @@ -626,6 +631,12 @@ package body Sem_Case is elsif Value1 > Value2 then return; + + -- If predicate is already known to be violated, do no check for + -- coverage error, to prevent cascaded messages. + + elsif Predicate_Error then + return; end if; -- Case of only one value that is missing @@ -748,6 +759,8 @@ package body Sem_Case is -- expression is static, independently of whether the aspect mentions -- Static explicitly. + Predicate_Error := False; + if Has_Predicate then Pred := First (Static_Discrete_Predicate (Bounds_Type)); Prev_Lo := Uint_Minus_1; @@ -763,13 +776,21 @@ package body Sem_Case is Error => Error); -- The analysis detected an illegal intersection between a choice - -- and a static predicate set. + -- and a static predicate set. Do not examine other choices unless + -- all errors are requested. if Error then - return; + Predicate_Error := True; + if not All_Errors_Mode then + return; + end if; end if; end loop; + if Predicate_Error then + return; + end if; + -- The choices may legally cover some of the static predicate sets, -- but not all. Emit an error for each non-covered set. -- cgit v1.1