Patchwork [Ada] Change error messages on duplicated Contract_Cases

login
register
mail settings
Submitter Arnaud Charlet
Date Dec. 5, 2012, 11:06 a.m.
Message ID <20121205110642.GA22390@adacore.com>
Download mbox | patch
Permalink /patch/203851/
State New
Headers show

Comments

Arnaud Charlet - Dec. 5, 2012, 11:06 a.m.
Issue more precise error messages when Contract_Cases aspects or pragmas are
given more than once on a given subprogram.

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

2012-12-05  Yannick Moy  <moy@adacore.com>

	* aspects.ads (No_Duplicates_Allowed): Forbid use of duplicate
	Contract_Cases aspects.
	* sem_prag.adb (Analyze_Pragma/Pragma_Contract_Case): Rename
	POST_CASE into CONTRACT_CASE in both grammar and code, to be
	consistent with current language definition.  Issue a more precise
	error message when the pragma duplicates another pragma or aspect.

Patch

Index: sem_prag.adb
===================================================================
--- sem_prag.adb	(revision 194203)
+++ sem_prag.adb	(working copy)
@@ -7761,11 +7761,11 @@ 
          -- Contract_Cases --
          --------------------
 
-         --  pragma Contract_Cases (POST_CASE_LIST);
+         --  pragma Contract_Cases (CONTRACT_CASE_LIST);
 
-         --  POST_CASE_LIST ::= POST_CASE {, POST_CASE}
+         --  CONTRACT_CASE_LIST ::= CONTRACT_CASE {, CONTRACT_CASE}
 
-         --  POST_CASE ::= CASE_GUARD => CONSEQUENCE
+         --  CONTRACT_CASE ::= CASE_GUARD => CONSEQUENCE
 
          --  CASE_GUARD ::= boolean_EXPRESSION | others
 
@@ -7786,11 +7786,22 @@ 
                CTC  : Node_Id;
 
             begin
+               Check_Duplicate_Pragma (Subp);
                CTC := Spec_CTC_List (Contract (Subp));
                while Present (CTC) loop
                   if Chars (Pragma_Identifier (CTC)) = Pname then
-                     Error_Pragma ("pragma % already in use");
-                     return;
+                     Error_Msg_Name_1 := Pname;
+                     Error_Msg_Sloc := Sloc (CTC);
+
+                     if From_Aspect_Specification (CTC) then
+                        Error_Msg_NE
+                          ("aspect% for & previously given#", N, Subp);
+                     else
+                        Error_Msg_NE
+                          ("pragma% for & duplicates pragma#", N, Subp);
+                     end if;
+
+                     raise Pragma_Exit;
                   end if;
 
                   CTC := Next_Pragma (CTC);
@@ -7804,12 +7815,12 @@ 
 
             --  Local variables
 
-            Case_Guard  : Node_Id;
-            Decl        : Node_Id;
-            Extra       : Node_Id;
-            Others_Seen : Boolean := False;
-            Post_Case   : Node_Id;
-            Subp_Decl   : Node_Id;
+            Case_Guard    : Node_Id;
+            Decl          : Node_Id;
+            Extra         : Node_Id;
+            Others_Seen   : Boolean := False;
+            Contract_Case : Node_Id;
+            Subp_Decl     : Node_Id;
 
          --  Start of processing for Contract_Cases
 
@@ -7866,30 +7877,32 @@ 
                end if;
             end loop;
 
-            --  All post cases must appear as an aggregate
+            --  All contract cases must appear as an aggregate
 
             if Nkind (Expression (Arg1)) /= N_Aggregate then
                Error_Pragma ("wrong syntax for pragma %");
                return;
             end if;
 
-            --  Verify the legality of individual post cases
+            --  Verify the legality of individual contract cases
 
-            Post_Case := First (Component_Associations (Expression (Arg1)));
-            while Present (Post_Case) loop
-               if Nkind (Post_Case) /= N_Component_Association then
-                  Error_Pragma_Arg ("wrong syntax in post case", Post_Case);
+            Contract_Case :=
+              First (Component_Associations (Expression (Arg1)));
+            while Present (Contract_Case) loop
+               if Nkind (Contract_Case) /= N_Component_Association then
+                  Error_Pragma_Arg
+                    ("wrong syntax in contract case", Contract_Case);
                   return;
                end if;
 
-               Case_Guard := First (Choices (Post_Case));
+               Case_Guard := First (Choices (Contract_Case));
 
-               --  Each post case must have exactly on case guard
+               --  Each contract case must have exactly on case guard
 
                Extra := Next (Case_Guard);
                if Present (Extra) then
                   Error_Pragma_Arg
-                    ("post case may have only one case guard", Extra);
+                    ("contract case may have only one case guard", Extra);
                   return;
                end if;
 
@@ -7911,7 +7924,7 @@ 
                   return;
                end if;
 
-               Next (Post_Case);
+               Next (Contract_Case);
             end loop;
 
             Chain_Contract_Cases (Subp_Decl);
@@ -11517,10 +11530,12 @@ 
 
             Preanalyze_And_Resolve (Expression (Arg1), Any_Boolean);
 
-            --  Transform pagma Loop_Invariant into an equivalent pragma Check.
+            --  Transform pragma Loop_Invariant into equivalent pragma Check
             --  Generate:
             --    pragma Check (Loop_Invaraint, Arg1);
 
+            --  Seems completely wrong to hijack pragma Check this way ???
+
             Rewrite (N,
               Make_Pragma (Loc,
                 Chars                        => Name_Check,
Index: aspects.ads
===================================================================
--- aspects.ads	(revision 194199)
+++ aspects.ads	(working copy)
@@ -257,7 +257,6 @@ 
 
    No_Duplicates_Allowed : constant array (Aspect_Id) of Boolean :=
                              (Aspect_Contract_Case  => False,
-                              Aspect_Contract_Cases => False,
                               Aspect_Test_Case      => False,
                               others                => True);