diff mbox

[Ada] Output of errors related to Pre'Class, Pre_Class, Post'Class, Post_Class

Message ID 20150302092900.GA15452@adacore.com
State New
Headers show

Commit Message

Arnaud Charlet March 2, 2015, 9:29 a.m. UTC
This patch takes advantage of the recently introduced mechanism that outputs
special names _Pre and _Post to emit errors related to pre/postconditions. No
change in behavior, no test.

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

2015-03-02  Hristian Kirtchev  <kirtchev@adacore.com>

	* sem_prag.adb (Duplication_Error): Remove the special handling
	of 'Class or _Class in the context of pre/postconditions.
	(Process_Class_Wide_Condition): Remove the special handling of
	'Class or _Class in the context of pre/postconditions.
	* sem_util.adb (Original_Aspect_Pragma_Name): Names Pre_Class
	and Post_Class no longer need to be converted to _Pre and _Post.
	* sem_util.ads (Original_Aspect_Pragma_Name): Update the comment
	on usage.
diff mbox

Patch

Index: sem_prag.adb
===================================================================
--- sem_prag.adb	(revision 221101)
+++ sem_prag.adb	(working copy)
@@ -21445,10 +21445,6 @@ 
 
          procedure Replace_Types is new Traverse_Proc (Replace_Type);
 
-         --  Local variables
-
-         Prag_Nam : constant Name_Id := Original_Aspect_Pragma_Name (N);
-
       --  Start of processing for Process_Class_Wide_Condition
 
       begin
@@ -21456,8 +21452,9 @@ 
          --  dispatching type, therefore the aspect/pragma is illegal.
 
          if No (Disp_Typ) then
+            Error_Msg_Name_1 := Original_Aspect_Pragma_Name (N);
+
             if From_Aspect_Specification (N) then
-               Error_Msg_Name_1 := Prag_Nam;
                Error_Msg_N
                  ("aspect % can only be specified for a primitive operation "
                   & "of a tagged type", Corresponding_Aspect (N));
@@ -21465,12 +21462,6 @@ 
             --  The pragma is a source construct
 
             else
-               if Prag_Nam = Name_Precondition then
-                  Error_Msg_Name_1 := Name_Pre_Class;
-               else
-                  Error_Msg_Name_1 := Name_Post_Class;
-               end if;
-
                Error_Msg_N
                  ("pragma % can only be specified for a primitive operation "
                   & "of a tagged type", N);
@@ -24973,11 +24964,11 @@ 
 
    procedure Duplication_Error (Prag : Node_Id; Prev : Node_Id) is
       Prag_From_Asp : constant Boolean := From_Aspect_Specification (Prag);
-      Prag_Nam      : constant Name_Id := Original_Aspect_Pragma_Name (Prag);
       Prev_From_Asp : constant Boolean := From_Aspect_Specification (Prev);
 
    begin
-      Error_Msg_Sloc := Sloc (Prev);
+      Error_Msg_Sloc   := Sloc (Prev);
+      Error_Msg_Name_1 := Original_Aspect_Pragma_Name (Prag);
 
       --  Emit a precise message to distinguish between source pragmas and
       --  pragmas generated from aspects. The ordering of the two pragmas is
@@ -24989,43 +24980,15 @@ 
       --  No error is emitted when both pragmas come from aspects because this
       --  is already detected by the general aspect analysis mechanism.
 
-      if Prag_Nam = Name_uPre then
-         Error_Msg_Name_1 := Name_Pre;
-      elsif Prag_Nam = Name_uPost then
-         Error_Msg_Name_1 := Name_Post;
+      if Prag_From_Asp and Prev_From_Asp then
+         null;
+      elsif Prag_From_Asp then
+         Error_Msg_N ("aspect % duplicates pragma declared #", Prag);
+      elsif Prev_From_Asp then
+         Error_Msg_N ("pragma % duplicates aspect declared #", Prag);
       else
-         Error_Msg_Name_1 := Prag_Nam;
+         Error_Msg_N ("pragma % duplicates pragma declared #", Prag);
       end if;
-
-      --  The item appears as aspect XXX'Class or pragma XXX_Class
-
-      if Class_Present (Prag) then
-         if Prag_From_Asp and Prev_From_Asp then
-            null;
-         elsif Prag_From_Asp then
-            Error_Msg_N
-              ("aspect `%'Class` duplicates pragma declared #", Prag);
-         elsif Prev_From_Asp then
-            Error_Msg_N
-              ("pragma `%_Class` duplicates aspect declared #", Prag);
-         else
-            Error_Msg_N
-              ("pragma `%_Class` duplicates pragma declared #", Prag);
-         end if;
-
-      --  Otherwise the pragma appears in its normal form
-
-      else
-         if Prag_From_Asp and Prev_From_Asp then
-            null;
-         elsif Prag_From_Asp then
-            Error_Msg_N ("aspect % duplicates pragma declared #", Prag);
-         elsif Prev_From_Asp then
-            Error_Msg_N ("pragma % duplicates aspect declared #", Prag);
-         else
-            Error_Msg_N ("pragma % duplicates pragma declared #", Prag);
-         end if;
-      end if;
    end Duplication_Error;
 
    ----------------------------------
Index: sem_util.adb
===================================================================
--- sem_util.adb	(revision 221101)
+++ sem_util.adb	(working copy)
@@ -15538,15 +15538,12 @@ 
          if Item_Nam = Name_Invariant then
             Item_Nam := Name_uInvariant;
 
-         elsif Nam_In (Item_Nam, Name_Post, Name_Post_Class) then
+         elsif Item_Nam = Name_Post then
             Item_Nam := Name_uPost;
 
-         elsif Nam_In (Item_Nam, Name_Pre, Name_Pre_Class) then
+         elsif Item_Nam = Name_Pre then
             Item_Nam := Name_uPre;
 
-         elsif Item_Nam = Name_Invariant then
-            Item_Nam := Name_uInvariant;
-
          elsif Nam_In (Item_Nam, Name_Type_Invariant,
                                  Name_Type_Invariant_Class)
          then
Index: sem_util.ads
===================================================================
--- sem_util.ads	(revision 221101)
+++ sem_util.ads	(working copy)
@@ -1683,9 +1683,7 @@ 
    --  returns the following values:
    --
    --    Invariant            -> Name_uInvariant
-   --    Post                 -> Name_uPost
    --    Post'Class           -> Name_uPost
-   --    Pre                  -> Name_uPre
    --    Pre'Class            -> Name_uPre
    --    Type_Invariant       -> Name_uType_Invariant
    --    Type_Invariant'Class -> Name_uType_Invariant