From: Piotr Trojanek <troja...@adacore.com>
Use existing machinery for internal attributes to handle attributes
related to Ada 2012 iterators. All these attributes exist exclusively
as a mean to delay processing.
Code cleanup. The only change in behavior is the wording of error
emitted when one of the internal attributes appears in source code:
from "illegal attribute" (which used to be emitted in the analysis)
to "unrecognized attribute (which is emitted by the parser).
gcc/ada/ChangeLog:
* exp_attr.adb (Expand_N_Attribute_Reference): Remove explicit
handling of attributes related to Ada 2012 iterators.
* sem_attr.adb (Analyze_Attribute, Eval_Attribute): Likewise;
move attribute Reduce according to alphabetic order.
* snames.adb-tmpl (Get_Attribute_Id): Add support for new internal
attributes.
* snames.ads-tmpl: Recognize names of new internal attributes.
(Attribute_Id): Recognize new internal attributes.
(Internal_Attribute_Id): Likewise.
(Is_Internal_Attribute_Name): Avoid duplication in comment.
Tested on x86_64-pc-linux-gnu, committed on master.
---
gcc/ada/exp_attr.adb | 12 ------------
gcc/ada/sem_attr.adb | 32 +++++++-------------------------
gcc/ada/snames.adb-tmpl | 33 ++++++++++++++++++++++++---------
gcc/ada/snames.ads-tmpl | 32 +++++++++++++++-----------------
4 files changed, 46 insertions(+), 63 deletions(-)
diff --git a/gcc/ada/exp_attr.adb b/gcc/ada/exp_attr.adb
index 904293bbd1d..911b9dcf807 100644
--- a/gcc/ada/exp_attr.adb
+++ b/gcc/ada/exp_attr.adb
@@ -2266,18 +2266,6 @@ package body Exp_Attr is
case Id is
- -- Attributes related to Ada 2012 iterators. They are only allowed in
- -- attribute definition clauses and should never be expanded.
-
- when Attribute_Constant_Indexing
- | Attribute_Default_Iterator
- | Attribute_Implicit_Dereference
- | Attribute_Iterable
- | Attribute_Iterator_Element
- | Attribute_Variable_Indexing
- =>
- raise Program_Error;
-
-- Internal attributes used to deal with Ada 2012 delayed aspects. These
-- were already rejected by the parser. Thus they shouldn't appear here.
diff --git a/gcc/ada/sem_attr.adb b/gcc/ada/sem_attr.adb
index 7295784704f..53b96501d78 100644
--- a/gcc/ada/sem_attr.adb
+++ b/gcc/ada/sem_attr.adb
@@ -3423,18 +3423,6 @@ package body Sem_Attr is
case Attr_Id is
- -- Attributes related to Ada 2012 iterators. Attribute specifications
- -- exist for these, but they cannot be queried.
-
- when Attribute_Constant_Indexing
- | Attribute_Default_Iterator
- | Attribute_Implicit_Dereference
- | Attribute_Iterator_Element
- | Attribute_Iterable
- | Attribute_Variable_Indexing
- =>
- Error_Msg_N ("illegal attribute", N);
-
-- Internal attributes used to deal with Ada 2012 delayed aspects. These
-- were already rejected by the parser. Thus they shouldn't appear here.
@@ -9015,19 +9003,6 @@ package body Sem_Attr is
case Id is
- -- Attributes related to Ada 2012 iterators; nothing to evaluate for
- -- these.
-
- when Attribute_Constant_Indexing
- | Attribute_Default_Iterator
- | Attribute_Implicit_Dereference
- | Attribute_Iterator_Element
- | Attribute_Iterable
- | Attribute_Reduce
- | Attribute_Variable_Indexing
- =>
- null;
-
-- Internal attributes used to deal with Ada 2012 delayed aspects.
-- These were already rejected by the parser. Thus they shouldn't
-- appear here.
@@ -10208,6 +10183,13 @@ package body Sem_Attr is
end case;
end Range_Length;
+ ------------
+ -- Reduce --
+ ------------
+
+ when Attribute_Reduce =>
+ null;
+
---------
-- Ref --
---------
diff --git a/gcc/ada/snames.adb-tmpl b/gcc/ada/snames.adb-tmpl
index d49fdf4d74a..62ca4de4866 100644
--- a/gcc/ada/snames.adb-tmpl
+++ b/gcc/ada/snames.adb-tmpl
@@ -125,15 +125,30 @@ package body Snames is
function Get_Attribute_Id (N : Name_Id) return Attribute_Id is
begin
- if N = Name_CPU then
- return Attribute_CPU;
- elsif N = Name_Dispatching_Domain then
- return Attribute_Dispatching_Domain;
- elsif N = Name_Interrupt_Priority then
- return Attribute_Interrupt_Priority;
- else
- return Attribute_Id'Val (N - First_Attribute_Name);
- end if;
+ case N is
+ when Name_Constant_Indexing =>
+ return Attribute_Constant_Indexing;
+ when Name_CPU =>
+ return Attribute_CPU;
+ when Name_Default_Iterator =>
+ return Attribute_Default_Iterator;
+ when Name_Dispatching_Domain =>
+ return Attribute_Dispatching_Domain;
+ when Name_Implicit_Dereference =>
+ return Attribute_Implicit_Dereference;
+ when Name_Interrupt_Priority =>
+ return Attribute_Interrupt_Priority;
+ when Name_Iterable =>
+ return Attribute_Iterable;
+ when Name_Iterator_Element =>
+ return Attribute_Iterator_Element;
+ when Name_Variable_Indexing =>
+ return Attribute_Variable_Indexing;
+ when First_Attribute_Name .. Last_Attribute_Name =>
+ return Attribute_Id'Val (N - First_Attribute_Name);
+ when others =>
+ raise Program_Error;
+ end case;
end Get_Attribute_Id;
-----------------------
diff --git a/gcc/ada/snames.ads-tmpl b/gcc/ada/snames.ads-tmpl
index 59637940bee..4e0d94f5113 100644
--- a/gcc/ada/snames.ads-tmpl
+++ b/gcc/ada/snames.ads-tmpl
@@ -943,12 +943,10 @@ package Snames is
Name_Compiler_Version : constant Name_Id := N + $; -- GNAT
Name_Component_Size : constant Name_Id := N + $;
Name_Compose : constant Name_Id := N + $;
- Name_Constant_Indexing : constant Name_Id := N + $; -- GNAT
Name_Constrained : constant Name_Id := N + $;
Name_Count : constant Name_Id := N + $;
Name_Default_Bit_Order : constant Name_Id := N + $; -- GNAT
Name_Default_Scalar_Storage_Order : constant Name_Id := N + $; -- GNAT
- Name_Default_Iterator : constant Name_Id := N + $; -- GNAT
Name_Definite : constant Name_Id := N + $;
Name_Delta : constant Name_Id := N + $;
Name_Denorm : constant Name_Id := N + $;
@@ -975,13 +973,10 @@ package Snames is
Name_Has_Same_Storage : constant Name_Id := N + $; -- Ada 12
Name_Has_Tagged_Values : constant Name_Id := N + $; -- GNAT
Name_Identity : constant Name_Id := N + $;
- Name_Implicit_Dereference : constant Name_Id := N + $; -- GNAT
Name_Index : constant Name_Id := N + $; -- Ada 22
Name_Initialized : constant Name_Id := N + $; -- GNAT
Name_Integer_Value : constant Name_Id := N + $; -- GNAT
Name_Invalid_Value : constant Name_Id := N + $; -- GNAT
- Name_Iterator_Element : constant Name_Id := N + $; -- GNAT
- Name_Iterable : constant Name_Id := N + $; -- GNAT
Name_Large : constant Name_Id := N + $; -- Ada 83
Name_Last : constant Name_Id := N + $;
Name_Last_Bit : constant Name_Id := N + $;
@@ -1063,7 +1058,6 @@ package Snames is
Name_Valid : constant Name_Id := N + $;
Name_Valid_Scalars : constant Name_Id := N + $; -- GNAT
Name_Value_Size : constant Name_Id := N + $; -- GNAT
- Name_Variable_Indexing : constant Name_Id := N + $; -- GNAT
Name_Version : constant Name_Id := N + $;
Name_Wchar_T_Size : constant Name_Id := N + $; -- GNAT
Name_Wide_Wide_Width : constant Name_Id := N + $; -- Ada 05
@@ -1152,10 +1146,16 @@ package Snames is
-- internal attributes is not permitted).
First_Internal_Attribute_Name : constant Name_Id := N + $;
+ Name_Constant_Indexing : constant Name_Id := N + $; -- GNAT
Name_CPU : constant Name_Id := N + $;
+ Name_Default_Iterator : constant Name_Id := N + $; -- GNAT
Name_Dispatching_Domain : constant Name_Id := N + $;
+ Name_Implicit_Dereference : constant Name_Id := N + $; -- GNAT
Name_Interrupt_Priority : constant Name_Id := N + $;
+ Name_Iterable : constant Name_Id := N + $; -- GNAT
+ Name_Iterator_Element : constant Name_Id := N + $; -- GNAT
Name_Secondary_Stack_Size : constant Name_Id := N + $; -- GNAT
+ Name_Variable_Indexing : constant Name_Id := N + $; -- GNAT
Last_Internal_Attribute_Name : constant Name_Id := N + $;
-- Names of recognized locking policy identifiers
@@ -1480,12 +1480,10 @@ package Snames is
Attribute_Compiler_Version,
Attribute_Component_Size,
Attribute_Compose,
- Attribute_Constant_Indexing,
Attribute_Constrained,
Attribute_Count,
Attribute_Default_Bit_Order,
Attribute_Default_Scalar_Storage_Order,
- Attribute_Default_Iterator,
Attribute_Definite,
Attribute_Delta,
Attribute_Denorm,
@@ -1512,13 +1510,10 @@ package Snames is
Attribute_Has_Same_Storage,
Attribute_Has_Tagged_Values,
Attribute_Identity,
- Attribute_Implicit_Dereference,
Attribute_Index,
Attribute_Initialized,
Attribute_Integer_Value,
Attribute_Invalid_Value,
- Attribute_Iterator_Element,
- Attribute_Iterable,
Attribute_Large,
Attribute_Last,
Attribute_Last_Bit,
@@ -1600,7 +1595,6 @@ package Snames is
Attribute_Valid,
Attribute_Valid_Scalars,
Attribute_Value_Size,
- Attribute_Variable_Indexing,
Attribute_Version,
Attribute_Wchar_T_Size,
Attribute_Wide_Wide_Width,
@@ -1662,12 +1656,18 @@ package Snames is
-- the special processing required to deal with the fact that their
-- names are not attribute names.
+ Attribute_Constant_Indexing,
Attribute_CPU,
+ Attribute_Default_Iterator,
Attribute_Dispatching_Domain,
- Attribute_Interrupt_Priority);
+ Attribute_Implicit_Dereference,
+ Attribute_Interrupt_Priority,
+ Attribute_Iterable,
+ Attribute_Iterator_Element,
+ Attribute_Variable_Indexing);
subtype Internal_Attribute_Id is Attribute_Id
- range Attribute_CPU .. Attribute_Interrupt_Priority;
+ range Attribute_Constant_Indexing .. Attribute_Variable_Indexing;
type Attribute_Set is array (Attribute_Id) of Boolean;
-- Type used to build attribute classification flag arrays
@@ -2058,9 +2058,7 @@ package Snames is
-- 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,
- -- Name_Secondary_Stack_Size).
+ -- Test to see if the name N is the name of an internal attribute
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
--
2.43.0
