Patchwork [Ada] Control over error message details for Contract_Cases

login
register
mail settings
Submitter Arnaud Charlet
Date April 25, 2013, 10:35 a.m.
Message ID <20130425103545.GA12697@adacore.com>
Download mbox | patch
Permalink /patch/239480/
State New
Headers show

Comments

Arnaud Charlet - April 25, 2013, 10:35 a.m.
This patch conditions the error message generation part of the Contract_Cases
mechanism to produce a short default message or a longer, more elaborate one
when switch -gnateE is in effect.

------------
-- Source --
------------

--  main.adb

procedure Main is
   X : Integer;

   procedure Proc
     with Contract_Cases =>
            (X <= 5 => X = 3,
             X >= 5 => X = 20);

   procedure Proc is
   begin
      X := X + 1;
   end Proc;

begin
   X := 5;
   Proc;
end Main;

----------------------------
-- Compilation and output --
----------------------------

$ gnatmake -f -q -gnat12 -gnata -gnatd.V main.adb
$ ./main
$ gnatmake -f -q -gnat12 -gnataa-gnatd.V -gnateE main.adb
$ ./main
raised SYSTEM.ASSERTIONS.ASSERT_FAILURE : contract cases overlap for subprogram
  proc
raised SYSTEM.ASSERTIONS.ASSERT_FAILURE : contract cases overlap for subprogram
  proc
  case guard at main.adb:6 evaluates to True
  case guard at main.adb:7 evaluates to True

Tested on x86_64-pc-linux-gnu, committed on trunk

2013-04-25  Hristian Kirtchev  <kirtchev@adacore.com>

	* sem_ch6.adb (Expand_Contract_Cases): Generate
	detailed error messages only when switch -gnateE is in effect.

Patch

Index: sem_ch6.adb
===================================================================
--- sem_ch6.adb	(revision 198286)
+++ sem_ch6.adb	(working copy)
@@ -11655,7 +11655,7 @@ 
 
                --  Check possible overlap between a case guard and "others"
 
-               if Multiple_PCs then
+               if Multiple_PCs and then Exception_Extra_Info then
                   Case_Guard_Error
                     (Decls     => Error_Decls,
                      Flag      => Others_Flag,
@@ -11695,7 +11695,7 @@ 
                --  Check whether this case guard overlaps with another case
                --  guard.
 
-               if Multiple_PCs then
+               if Multiple_PCs and then Exception_Extra_Info then
                   Case_Guard_Error
                     (Decls     => Error_Decls,
                      Flag      => Flag,