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 <pu...@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.
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).
