Patchwork [Ada] Prevent mispelling error messages

login
register
mail settings
Submitter Arnaud Charlet
Date July 9, 2012, 1:20 p.m.
Message ID <20120709132016.GA30406@adacore.com>
Download mbox | patch
Permalink /patch/169835/
State New
Headers show

Comments

Arnaud Charlet - July 9, 2012, 1:20 p.m.
Prevent mispelling error messages with internal attribute names
CPU, Dispatching_Domain and Interrupt_Priority.

For example:

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

pragma Ada_2012;
procedure P is
   X : Integer;
   for X'CPU use 3;   --  unrecognized attribute (internal to GNAT)
   for X'CPUX use 3;  --  unrecognized attribute (and not a mispelling of CPU)
begin
   if X'CPU = 3 then  --  unrecognized attribute
      null;
   end if;
end P;

-----------------
-- Compilation --
-----------------

gnatmake -q p.adb

---------------------
-- Expected output --
---------------------

p.adb:4:10: unrecognized attribute "CPU"
p.adb:5:10: unrecognized attribute "CPUX"
p.adb:7:09: unrecognized attribute "CPU"
gnatmake: "p.adb" compilation error

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

2012-07-09  Vincent Pucci  <pucci@adacore.com>

	* exp_attr.adb (Signal_Bad_Attribute): Raise Program_Error in
	case of internal attribute names (already rejected by the parser).
	* par-ch13.adb (P_Representation_Clause): Complain if an internal
	attribute name that comes from source occurs.
	* par-ch4.adb (P_Name): Complain if an internal attribute name
	occurs in the context of an attribute reference.
	* par-util.adb (Signal_Bad_Attribute): Don't complain about
	mispelling attribute with internal attributes.
	* sem_attr.adb (Analyze_Attribute): Raise Program_Error in case
	of internal attribute names (already rejected by the parser).
	* snames.adb-tmpl (Is_Internal_Attribute_Name): New routine.
	* snames.ads-tmpl: Attributes CPU, Dispatching_Domain and
	Interrupt_Priority are marked as INT attributes since they
	don't denote real attribute and are only used internally in
	the compiler.
	(Is_Internal_Attribute_Name): New routine.

Patch

Index: exp_attr.adb
===================================================================
--- exp_attr.adb	(revision 189367)
+++ exp_attr.adb	(working copy)
@@ -835,13 +835,16 @@ 
            Attribute_Default_Iterator     |
            Attribute_Implicit_Dereference |
            Attribute_Iterator_Element     |
-           Attribute_Variable_Indexing    => null;
+           Attribute_Variable_Indexing    =>
+         null;
 
-      --  Attributes related to Ada 2012 aspects
+      --  Internal attributes used to deal with Ada 2012 delayed aspects
+      --  (already diagnosed by parser, thus nothing more to do here).
 
       when Attribute_CPU                |
            Attribute_Dispatching_Domain |
-           Attribute_Interrupt_Priority => null;
+           Attribute_Interrupt_Priority =>
+         raise Program_Error;
 
       ------------
       -- Access --
Index: par-ch13.adb
===================================================================
--- par-ch13.adb	(revision 189366)
+++ par-ch13.adb	(working copy)
@@ -221,7 +221,14 @@ 
             if Token = Tok_Identifier then
                Attr_Name := Token_Name;
 
-               if not Is_Attribute_Name (Attr_Name) then
+               --  Note that the parser must complain in case of an internal
+               --  attribute names that comes from source since internal names
+               --  are meant to be used only by the compiler.
+
+               if not Is_Attribute_Name (Attr_Name)
+                 or else (Is_Internal_Attribute_Name (Attr_Name)
+                           and then Comes_From_Source (Token_Node))
+               then
                   Signal_Bad_Attribute;
                end if;
 
Index: par-ch4.adb
===================================================================
--- par-ch4.adb	(revision 189366)
+++ par-ch4.adb	(working copy)
@@ -434,7 +434,12 @@ 
             elsif Token = Tok_Identifier then
                Attr_Name := Token_Name;
 
-               if not Is_Attribute_Name (Attr_Name) then
+               --  Note that internal attributes names don't denote real
+               --  attribute.
+
+               if not Is_Attribute_Name (Attr_Name)
+                 or else Is_Internal_Attribute_Name (Attr_Name)
+               then
                   if Apostrophe_Should_Be_Semicolon then
                      Expr_Form := EF_Name;
                      return Name_Node;
Index: sem_attr.adb
===================================================================
--- sem_attr.adb	(revision 189376)
+++ sem_attr.adb	(working copy)
@@ -2215,13 +2215,13 @@ 
            Attribute_Variable_Indexing    =>
          Error_Msg_N ("illegal attribute", N);
 
-      --  Attributes related to Ada 2012 aspects. Attribute definition clause
-      --  exists for these, but they cannot be queried.
+      --  Internal attributes used to deal with Ada 2012 delayed aspects
+      --  (already diagnosed by parser, thus nothing more to do here).
 
       when Attribute_CPU                |
            Attribute_Dispatching_Domain |
            Attribute_Interrupt_Priority =>
-         Error_Msg_N ("illegal attribute", N);
+         raise Program_Error;
 
       ------------------
       -- Abort_Signal --
Index: snames.adb-tmpl
===================================================================
--- snames.adb-tmpl	(revision 189366)
+++ snames.adb-tmpl	(working copy)
@@ -392,6 +392,17 @@ 
                    or else N not in Ada_2012_Reserved_Words);
    end Is_Keyword_Name;
 
+   --------------------------------
+   -- Is_Internal_Attribute_Name --
+   --------------------------------
+
+   function Is_Internal_Attribute_Name (N : Name_Id) return Boolean is
+   begin
+      return N = Name_CPU
+        or N = Name_Interrupt_Priority
+        or N = Name_Dispatching_Domain;
+   end Is_Internal_Attribute_Name;
+
    ----------------------------
    -- Is_Locking_Policy_Name --
    ----------------------------
Index: par-util.adb
===================================================================
--- par-util.adb	(revision 189366)
+++ par-util.adb	(working copy)
@@ -6,7 +6,7 @@ 
 --                                                                          --
 --                                 B o d y                                  --
 --                                                                          --
---          Copyright (C) 1992-2011, Free Software Foundation, Inc.         --
+--          Copyright (C) 1992-2012, 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- --
@@ -721,7 +721,12 @@ 
 
       Error_Msg_Name_1 := First_Attribute_Name;
       while Error_Msg_Name_1 <= Last_Attribute_Name loop
-         if Is_Bad_Spelling_Of (Token_Name, Error_Msg_Name_1) then
+         --  No mispelling possible with internal attribute names since they
+         --  don't denote real attribute.
+
+         if not Is_Internal_Attribute_Name (Error_Msg_Name_1)
+           and then Is_Bad_Spelling_Of (Token_Name, Error_Msg_Name_1)
+         then
             Error_Msg_N -- CODEFIX
               ("\possible misspelling of %", Token_Node);
             exit;
Index: snames.ads-tmpl
===================================================================
--- snames.ads-tmpl	(revision 189366)
+++ snames.ads-tmpl	(working copy)
@@ -753,6 +753,11 @@ 
    --  implementation dependent attributes may be found in the appropriate
    --  section in Sem_Attr.
 
+   --  The entries marked INT are not real attributes. They are special names
+   --  used internally by GNAT in order to deal with delayed aspects
+   --  (Aspect_CPU, Aspect_Dispatching_Domain, Aspect_Interrupt_Priority) that
+   --  don't have corresponding pragma or attribute.
+
    --  The entries marked VMS are recognized only in OpenVMS implementations
    --  of GNAT, and are treated as illegal in all other contexts.
 
@@ -779,7 +784,7 @@ 
    Name_Constant_Indexing              : constant Name_Id := N + $; -- GNAT
    Name_Constrained                    : constant Name_Id := N + $;
    Name_Count                          : constant Name_Id := N + $;
-   Name_CPU                            : constant Name_Id := N + $; -- Ada 12
+   Name_CPU                            : constant Name_Id := N + $; -- INT
    Name_Default_Bit_Order              : constant Name_Id := N + $; -- GNAT
    Name_Default_Iterator               : constant Name_Id := N + $; -- GNAT
    Name_Definite                       : constant Name_Id := N + $;
@@ -787,7 +792,7 @@ 
    Name_Denorm                         : constant Name_Id := N + $;
    Name_Descriptor_Size                : constant Name_Id := N + $;
    Name_Digits                         : constant Name_Id := N + $;
-   Name_Dispatching_Domain             : constant Name_Id := N + $; -- Ada 12
+   Name_Dispatching_Domain             : constant Name_Id := N + $; -- INT
    Name_Elaborated                     : constant Name_Id := N + $; -- GNAT
    Name_Emax                           : constant Name_Id := N + $; -- Ada 83
    Name_Enabled                        : constant Name_Id := N + $; -- GNAT
@@ -809,7 +814,7 @@ 
    Name_Img                            : constant Name_Id := N + $; -- GNAT
    Name_Implicit_Dereference           : constant Name_Id := N + $; -- GNAT
    Name_Integer_Value                  : constant Name_Id := N + $; -- GNAT
-   Name_Interrupt_Priority             : constant Name_Id := N + $; -- Ada 12
+   Name_Interrupt_Priority             : constant Name_Id := N + $; -- INT
    Name_Invalid_Value                  : constant Name_Id := N + $; -- GNAT
    Name_Iterator_Element               : constant Name_Id := N + $; -- GNAT
    Name_Large                          : constant Name_Id := N + $; -- Ada 83
@@ -1826,6 +1831,10 @@ 
    --  Test to see if the name N is the name of a recognized entity attribute,
    --  i.e. an attribute reference that returns an entity.
 
+   function Is_Internal_Attribute_Name (N : Name_Id) return Boolean;
+   --  Test to see if the name N is the name of an INT attribute (Name_CPU,
+   --  Name_Dispatching_Domain, Name_Interrupt_Priority).
+
    function Is_Procedure_Attribute_Name (N : Name_Id) return Boolean;
    --  Test to see if the name N is the name of a recognized attribute that
    --  designates a procedure (and can therefore appear as a statement).