* [COMMITTED] ada: Implement Aspects as fields under nodes
@ 2023-11-07 9:20 Marc Poulhiès
0 siblings, 0 replies; only message in thread
From: Marc Poulhiès @ 2023-11-07 9:20 UTC (permalink / raw)
To: gcc-patches; +Cc: Viljar Indus
From: Viljar Indus <indus@adacore.com>
In the previous implementation Aspect Specifications were
stored in a separate table and not directly under each node.
This implementation included a lot of extra code that needed
to be maintained manually.
The new implementation stores Aspect_Specfications as a syntactic
field under each node. This removes the extra code that was needed
to store, traverse and clone aspects for nodes.
gcc/ada/
* aspects.adb (Exchange_Aspects): Removed. This method was
typically called after a Rewrite method. Now since the Rewrite
switches the aspects between the new and the old node it is no
longer needed.
(Has_Aspects): Converted to a utility method that performs the same
before as the previous Has_Aspects field did. Meaning it shows whether
a node actually has aspects or not.
(Copy_Aspects): New utility method that performs a deep copy of the
From nodes aspects.
(Aspect_Specfications): Removed. No longer needed. Replaced
by the primitive operation for the Aspect_Specification fields.
(Set_Aspect_Specifications): Likewise.
(Aspect_Specifications_Hash_Table): Remove the table and all the
utility methods for storing the old aspects.
* aspects.ads: Likewise.
* atree.adb (Copy_Separate_Tree): Remove custom code for aspects.
(New_Copy): Likewise.
(Replace): Likewise.
(Rewrite): Likewise.
* exp_ch3.adb (Expand_N_Object_Declaration): Keep the aspects from the old node.
* exp_ch6.adb (Validate_Subprogram_Calls): Previously aspects were ignored
because they were not on the tree. Explicitly ignore them here
when traversing the tree.
* exp_unst.adb (Build_Tables): Likewise
* gen_il-fields.ads: Remove Has_Aspects and add
Aspect_Specifications fields.
* gen_il-gen-gen_nodes.adb: Add Aspect_Specification fields
for all nodes that can have aspects. Additionally add
Expression_Copy for Aspect_Speficiations to avoid reusing
the Associated_Node for generic instantiation and aspect
analysis.
* ghost.adb (Remove_Ignored_Ghost_Node): Remove call to Remove_Aspects.
The rewritten node is a Null_Statement that cannot have aspects
and there is not anything to gain from removing them from the
Orignal_Node of N since it technically is not part of the active
tree.
* inline.adb (Process_Formals_In_Aspects): Simplify code for node traversal.
* par-ch13.adb: Avoid setting the parent explicitly for the
Aspect_Specifications list. This is done explicitly in the setter.
* par-ch6.adb: Likewise.
* par_sco.adb (Traverse_Aspects): Handle early return.
* sem_ch10.adb: Simplify code for Analyze_Aspect_Specifications.
* sem_ch11.adb: Likewise.
* sem_ch12.adb (Analyze_Formal_Derived_Interface_Type): Keep the aspects from
the orignal node after rewrite.
(Analyze_Formal_Derived_Type): Likewise.
(Analyze_Formal_Interface_Type): Likewise.
(Analyze_Formal_Object_Declaration): Simplify code for
Analyze_Aspect_Specifications.
(Analyze_Formal_Package_Declaration): Likewise.
(Analyze_Formal_Subprogram_Declaration): Likewise.
(Analyze_Formal_Type_Declaration): Likewise.
(Analyze_Generic_Package_Declaration): Remove Exchange_Aspects.
The new node already has the correct aspects after the rewrite.
Also simplify code for Analyze_Aspect_Specifications.
(Analyze_Generic_Subprogram_Declaration): Likewise.
(Analyze_Package_Instantiation): Simplify code for
Analyze_Aspect_Specifications.
(Build_Instance_Compilation_Unit_Nodes): Remove explicit copy of
aspects that is no longer needed.
(Save_References): Update the traversal code to handle
Aspect_Specifications in the tree.
(Copy_Generic_Node): Remove explicit copy for aspects. New_Copy
took care of that already.
* sem_ch13.adb (Analyze_Aspect_Specifications): Add early return to simplify
code for its calls. Avoid reusing the Entity(Associated_Node)
field for storing the original expression. Instead use the
new Expression_Copy field since Entity(Associated_Node) is
also used in generic instantiation.
(Analyze_Aspects_On_Subprogram_Body_Or_Stub): Simlify call
to Analyze_Aspect_Specifications.
(Check_Aspect_At_End_Of_Declarations): Use Expression_Copy
instead of Entity.
(Check_Aspect_At_Freeze_Point): Likewise.
* sem_ch3.adb: Simplify calls to Analyze_Aspect_Specifications.
* sem_ch6.adb (Analyze_Abstract_Subprogram_Declaration): Simplify call to
Analyze_Aspect_Specifications.
(Analyze_Expression_Function): Keep the aspects from the
original node after a rewrite.
(Analyze_Generic_Subprogram_Body): Remove Exchange aspects
that is no longer needed. Simplify call to
Analyze_Aspect_Specifications.
(Analyze_Null_Procedure): Keep the aspects from the
original node after a rewrite.
(Analyze_Subprogram_Body_Helper): Simplify calls to
Analyze_Aspect_Specifications.
(Analyze_Subprogram_Declaration): Likewise.
* sem_ch7.adb (Analyze_Package_Body_Helper): Remove Exchange aspects
that is no longer needed. Simplify call to
Analyze_Aspect_Specifications.
(Analyze_Package_Declaration): Simplify call to
Analyze_Aspect_Specifications.
(Analyze_Private_Type_Declaration): Likewise.
* sem_ch8.adb: Simplify calls to
Analyze_Aspect_Specifications.
* sem_ch9.adb (Analyze_Entry_Body): Simplify call to
Analyze_Aspects_On_Subprogram_Body_Or_Stub.
(Analyze_Entry_Declaration): Simplify call to
Analyze_Aspect_Specifications.
(Analyze_Protected_Body): Likewise.
(Analyze_Protected_Type_Declaration): Likewise.
(Analyze_Single_Protected_Declaration): Keep the aspects from
the original node after a rewrite. Simplify call to
Analyze_Aspect_Specifications.
(Analyze_Single_Task_Declaration): Likewise.
(Analyze_Task_Body): Simplify call to
Analyze_Aspect_Specifications.
(Analyze_Task_Type_Declaration): Simplify calls to
Analyze_Aspect_Specifications.
* sem_dim.adb: Remove explicitly setting the parents
for the Aspect_Specification list.
* sem_disp.adb: Remove the with that is no longer
required since Aspect_Specifications is a node operation now.
* sem_util.adb (Copy_Node_With_Replacement): Remove explicit code for aspects.
* treepr.adb (Print_Field): Remove the version that was used for printing
aspects.
(Print_Node): Remove aspect specific code.
Tested on x86_64-pc-linux-gnu, committed on master.
---
gcc/ada/aspects.adb | 104 ++++++---------------------
gcc/ada/aspects.ads | 33 ++-------
gcc/ada/atree.adb | 35 ---------
gcc/ada/exp_ch3.adb | 4 ++
gcc/ada/exp_ch6.adb | 1 +
gcc/ada/exp_unst.adb | 9 +--
gcc/ada/gen_il-fields.ads | 2 +-
gcc/ada/gen_il-gen-gen_nodes.adb | 83 ++++++++++++++++------
gcc/ada/ghost.adb | 3 -
gcc/ada/inline.adb | 11 +--
gcc/ada/par-ch13.adb | 1 -
gcc/ada/par-ch6.adb | 2 -
gcc/ada/par_sco.adb | 6 +-
gcc/ada/sem_ch10.adb | 12 +---
gcc/ada/sem_ch11.adb | 4 +-
gcc/ada/sem_ch12.adb | 118 ++++++++++++++-----------------
gcc/ada/sem_ch13.adb | 20 ++++--
gcc/ada/sem_ch3.adb | 69 ++++++++++--------
gcc/ada/sem_ch6.adb | 36 +++-------
gcc/ada/sem_ch7.adb | 17 +----
gcc/ada/sem_ch8.adb | 20 ++----
gcc/ada/sem_ch9.adb | 74 ++++++++-----------
gcc/ada/sem_dim.adb | 2 -
gcc/ada/sem_disp.adb | 1 -
gcc/ada/sem_util.adb | 5 --
gcc/ada/treepr.adb | 56 ---------------
26 files changed, 266 insertions(+), 462 deletions(-)
diff --git a/gcc/ada/aspects.adb b/gcc/ada/aspects.adb
index cdef68e2914..1d322ed5af5 100644
--- a/gcc/ada/aspects.adb
+++ b/gcc/ada/aspects.adb
@@ -68,30 +68,6 @@ package body Aspects is
Aspect_Variable_Indexing => True,
others => False);
- ------------------------------------------
- -- Hash Table for Aspect Specifications --
- ------------------------------------------
-
- type AS_Hash_Range is range 0 .. 510;
- -- Size of hash table headers
-
- function AS_Hash (F : Node_Id) return AS_Hash_Range;
- -- Hash function for hash table
-
- function AS_Hash (F : Node_Id) return AS_Hash_Range is
- begin
- return AS_Hash_Range (F mod 511);
- end AS_Hash;
-
- package Aspect_Specifications_Hash_Table is new
- GNAT.HTable.Simple_HTable
- (Header_Num => AS_Hash_Range,
- Element => List_Id,
- No_Element => No_List,
- Key => Node_Id,
- Hash => AS_Hash,
- Equal => "=");
-
-------------------------------------
-- Hash Table for Aspect Id Values --
-------------------------------------
@@ -116,19 +92,6 @@ package body Aspects is
Hash => AI_Hash,
Equal => "=");
- ---------------------------
- -- Aspect_Specifications --
- ---------------------------
-
- function Aspect_Specifications (N : Node_Id) return List_Id is
- begin
- if Has_Aspects (N) then
- return Aspect_Specifications_Hash_Table.Get (N);
- else
- return No_List;
- end if;
- end Aspect_Specifications;
-
--------------------------------
-- Aspects_On_Body_Or_Stub_OK --
--------------------------------
@@ -161,31 +124,6 @@ package body Aspects is
return True;
end Aspects_On_Body_Or_Stub_OK;
- ----------------------
- -- Exchange_Aspects --
- ----------------------
-
- procedure Exchange_Aspects (N1 : Node_Id; N2 : Node_Id) is
- begin
- pragma Assert
- (Permits_Aspect_Specifications (N1)
- and then Permits_Aspect_Specifications (N2));
-
- -- Perform the exchange only when both nodes have lists to be swapped
-
- if Has_Aspects (N1) and then Has_Aspects (N2) then
- declare
- L1 : constant List_Id := Aspect_Specifications (N1);
- L2 : constant List_Id := Aspect_Specifications (N2);
- begin
- Set_Parent (L1, N2);
- Set_Parent (L2, N1);
- Aspect_Specifications_Hash_Table.Set (N1, L2);
- Aspect_Specifications_Hash_Table.Set (N2, L1);
- end;
- end if;
- end Exchange_Aspects;
-
-----------------
-- Find_Aspect --
-----------------
@@ -358,6 +296,12 @@ package body Aspects is
return Present (Find_Aspect (Id, A, Class_Present => Class_Present));
end Has_Aspect;
+ function Has_Aspects (N : Node_Id) return Boolean
+ is (Atree.Present (N) and then
+ Permits_Aspect_Specifications (N) and then
+ Nlists.Present (Sinfo.Nodes.Aspect_Specifications (N)) and then
+ Nlists.Is_Non_Empty_List (Sinfo.Nodes.Aspect_Specifications (N)));
+
------------------
-- Is_Aspect_Id --
------------------
@@ -377,8 +321,7 @@ package body Aspects is
begin
if Has_Aspects (From) then
Set_Aspect_Specifications (To, Aspect_Specifications (From));
- Aspect_Specifications_Hash_Table.Remove (From);
- Set_Has_Aspects (From, False);
+ Set_Aspect_Specifications (From, No_List);
end if;
end Move_Aspects;
@@ -485,6 +428,21 @@ package body Aspects is
end if;
end Move_Or_Merge_Aspects;
+ -------------------
+ -- Copy_Aspects --
+ -------------------
+
+ procedure Copy_Aspects (From : Node_Id; To : Node_Id) is
+
+ begin
+ if not Has_Aspects (From) then
+ return;
+ end if;
+
+ Set_Aspect_Specifications
+ (To, New_Copy_List (Aspect_Specifications (From)));
+ end Copy_Aspects;
+
-----------------------------------
-- Permits_Aspect_Specifications --
-----------------------------------
@@ -547,8 +505,7 @@ package body Aspects is
procedure Remove_Aspects (N : Node_Id) is
begin
if Has_Aspects (N) then
- Aspect_Specifications_Hash_Table.Remove (N);
- Set_Has_Aspects (N, False);
+ Set_Aspect_Specifications (N, No_List);
end if;
end Remove_Aspects;
@@ -595,21 +552,6 @@ package body Aspects is
return Canonical_Aspect (A1) = Canonical_Aspect (A2);
end Same_Aspect;
- -------------------------------
- -- Set_Aspect_Specifications --
- -------------------------------
-
- procedure Set_Aspect_Specifications (N : Node_Id; L : List_Id) is
- begin
- pragma Assert (Permits_Aspect_Specifications (N));
- pragma Assert (not Has_Aspects (N));
- pragma Assert (L /= No_List);
-
- Set_Has_Aspects (N);
- Set_Parent (L, N);
- Aspect_Specifications_Hash_Table.Set (N, L);
- end Set_Aspect_Specifications;
-
package body User_Aspect_Support is
-- This is similar to the way that user-defined check names are
diff --git a/gcc/ada/aspects.ads b/gcc/ada/aspects.ads
index aaa5db9310e..8f4ae51b7ce 100644
--- a/gcc/ada/aspects.ads
+++ b/gcc/ada/aspects.ads
@@ -1147,28 +1147,12 @@ package Aspects is
-- implemented internally with a hash table in the body, that provides
-- access to aspect specifications.
- function Aspect_Specifications (N : Node_Id) return List_Id;
- -- Given a node N, returns the list of N_Aspect_Specification nodes that
- -- are attached to this declaration node. If the node is in the class of
- -- declaration nodes that permit aspect specifications, as defined by the
- -- predicate above, and if their Has_Aspects flag is set to True, then this
- -- will always be a non-empty list. If this flag is set to False, then
- -- No_List is returned. Normally, the only nodes that have Has_Aspects set
- -- True are the nodes for which Permits_Aspect_Specifications would return
- -- True (i.e. the declaration nodes defined in the RM as permitting the
- -- presence of Aspect_Specifications). However, it is possible for the
- -- flag Has_Aspects to be set on other nodes as a result of Rewrite and
- -- Replace calls, and this function may be used to retrieve the aspect
- -- specifications for the original rewritten node in such cases.
-
function Aspects_On_Body_Or_Stub_OK (N : Node_Id) return Boolean;
-- N denotes a body [stub] with aspects. Determine whether all aspects of N
-- are allowed to appear on a body [stub].
- procedure Exchange_Aspects (N1 : Node_Id; N2 : Node_Id);
- -- Exchange the aspect specifications of two nodes. If either node lacks an
- -- aspect specification list, the routine has no effect. It is assumed that
- -- both nodes can support aspects.
+ procedure Copy_Aspects (From : Node_Id; To : Node_Id);
+ -- Create a copy of Aspect of From and add them to To.
function Find_Aspect (Id : Entity_Id;
A : Aspect_Id;
@@ -1197,6 +1181,9 @@ package Aspects is
Class_Present : Boolean := False) return Boolean;
-- Determine whether entity Id has aspect A (or A'Class, if Class_Present)
+ function Has_Aspects (N : Node_Id) return Boolean;
+ -- Returns whether the node has any aspect specifications
+
procedure Move_Aspects (From : Node_Id; To : Node_Id);
-- Relocate the aspect specifications of node From to node To. On entry it
-- is assumed that To does not have aspect specifications. If From has no
@@ -1227,16 +1214,6 @@ package Aspects is
-- a simple equality test because e.g. Post and Postcondition are the same.
-- This is used for detecting duplicate aspects.
- procedure Set_Aspect_Specifications (N : Node_Id; L : List_Id);
- -- The node N must be in the class of declaration nodes that permit aspect
- -- specifications and the Has_Aspects flag must be False on entry. L must
- -- be a non-empty list of N_Aspect_Specification nodes. This procedure sets
- -- the Has_Aspects flag to True, and makes an entry that can be retrieved
- -- by a subsequent Aspect_Specifications call. It is an error to call this
- -- procedure with a node that does not permit aspect specifications, or a
- -- node that has its Has_Aspects flag set True on entry, or with L being an
- -- empty list or No_List.
-
package User_Aspect_Support is
procedure Register_UAD_Pragma (UAD_Pragma : Node_Id);
-- Argument is a User_Aspect_Definition pragma.
diff --git a/gcc/ada/atree.adb b/gcc/ada/atree.adb
index 8e4c4437636..f265526afb7 100644
--- a/gcc/ada/atree.adb
+++ b/gcc/ada/atree.adb
@@ -24,7 +24,6 @@
------------------------------------------------------------------------------
with Ada.Unchecked_Conversion;
-with Aspects; use Aspects;
with Namet; use Namet;
with Nlists; use Nlists;
with Opt; use Opt;
@@ -1460,16 +1459,6 @@ package body Atree is
Walk (New_Id, Source);
- -- Explicitly copy the aspect specifications as those do not reside
- -- in a node field.
-
- if Permits_Aspect_Specifications (Source)
- and then Has_Aspects (Source)
- then
- Set_Aspect_Specifications
- (New_Id, Copy_List (Aspect_Specifications (Source)));
- end if;
-
-- Set Entity field to Empty to ensure that no entity references
-- are shared between the two, if the source is already analyzed.
@@ -1873,11 +1862,6 @@ package body Atree is
Set_Is_Overloaded (New_Id, False);
end if;
- -- Always clear Has_Aspects, the caller must take care of copying
- -- aspects if this is required for the particular situation.
-
- Set_Has_Aspects (New_Id, False);
-
-- Mark the copy as Ghost depending on the current Ghost region
if Nkind (New_Id) in N_Entity then
@@ -2156,7 +2140,6 @@ package body Atree is
procedure Replace (Old_Node, New_Node : Node_Id) is
Old_Post : constant Boolean := Error_Posted (Old_Node);
- Old_HasA : constant Boolean := Has_Aspects (Old_Node);
Old_CFS : constant Boolean := Comes_From_Source (Old_Node);
procedure Destroy_New_Node;
@@ -2183,7 +2166,6 @@ package body Atree is
Copy_Node (Source => New_Node, Destination => Old_Node);
Set_Comes_From_Source (Old_Node, Old_CFS);
Set_Error_Posted (Old_Node, Old_Post);
- Set_Has_Aspects (Old_Node, Old_HasA);
-- Fix parents of substituted node, since it has changed identity
@@ -2224,8 +2206,6 @@ package body Atree is
Old_Is_IGN : constant Boolean := Is_Ignored_Ghost_Node (Old_Node);
Old_Error_Posted : constant Boolean :=
Error_Posted (Old_Node);
- Old_Has_Aspects : constant Boolean :=
- Has_Aspects (Old_Node);
Old_Must_Not_Freeze : constant Boolean :=
(if Nkind (Old_Node) in N_Subexpr then Must_Not_Freeze (Old_Node)
@@ -2261,27 +2241,12 @@ package body Atree is
Sav_Node := New_Copy (Old_Node);
Set_Original_Node (Sav_Node, Sav_Node);
Set_Original_Node (Old_Node, Sav_Node);
-
- -- Both the old and new copies of the node will share the same list
- -- of aspect specifications if aspect specifications are present.
- -- Restore the parent link of the aspect list to the old node, which
- -- is the one linked in the tree.
-
- if Old_Has_Aspects then
- declare
- Aspects : constant List_Id := Aspect_Specifications (Old_Node);
- begin
- Set_Aspect_Specifications (Sav_Node, Aspects);
- Set_Parent (Aspects, Old_Node);
- end;
- end if;
end if;
-- Copy substitute node into place, preserving old fields as required
Copy_Node (Source => New_Node, Destination => Old_Node);
Set_Error_Posted (Old_Node, Old_Error_Posted);
- Set_Has_Aspects (Old_Node, Old_Has_Aspects);
Set_Check_Actuals (Old_Node, Old_CA);
Set_Is_Ignored_Ghost_Node (Old_Node, Old_Is_IGN);
diff --git a/gcc/ada/exp_ch3.adb b/gcc/ada/exp_ch3.adb
index bb015986200..0217f8d7eb0 100644
--- a/gcc/ada/exp_ch3.adb
+++ b/gcc/ada/exp_ch3.adb
@@ -8960,6 +8960,10 @@ package body Exp_Ch3 is
Subtype_Mark => New_Occurrence_Of (Etype (Def_Id), Loc),
Name => Expr_Q));
+ -- Keep original aspects
+
+ Move_Aspects (Original_Node (N), N);
+
-- We do not analyze this renaming declaration, because all its
-- components have already been analyzed, and if we were to go
-- ahead and analyze it, we would in effect be trying to generate
diff --git a/gcc/ada/exp_ch6.adb b/gcc/ada/exp_ch6.adb
index 0e6f950f5d7..1a2a027265c 100644
--- a/gcc/ada/exp_ch6.adb
+++ b/gcc/ada/exp_ch6.adb
@@ -10121,6 +10121,7 @@ package body Exp_Ch6 is
return Skip;
when N_Abstract_Subprogram_Declaration
+ | N_Aspect_Specification
| N_At_Clause
| N_Call_Marker
| N_Empty
diff --git a/gcc/ada/exp_unst.adb b/gcc/ada/exp_unst.adb
index 239cda02ea7..b01cfc13bf9 100644
--- a/gcc/ada/exp_unst.adb
+++ b/gcc/ada/exp_unst.adb
@@ -1255,11 +1255,12 @@ package body Exp_Unst is
return Skip;
end if;
- -- Pragmas and component declarations are ignored. Quantified
- -- expressions are expanded into explicit loops and the
- -- original epression must be ignored.
+ -- Aspects, pragmas and component declarations are ignored.
+ -- Quantified expressions are expanded into explicit loops
+ -- and the original epression must be ignored.
- when N_Component_Declaration
+ when N_Aspect_Specification
+ | N_Component_Declaration
| N_Pragma
| N_Quantified_Expression
=>
diff --git a/gcc/ada/gen_il-fields.ads b/gcc/ada/gen_il-fields.ads
index a017f45d9a6..1b40cd9472e 100644
--- a/gcc/ada/gen_il-fields.ads
+++ b/gcc/ada/gen_il-fields.ads
@@ -50,7 +50,6 @@ package Gen_IL.Fields is
Error_Posted,
Small_Paren_Count,
Check_Actuals,
- Has_Aspects,
Is_Ignored_Ghost_Node,
Link,
@@ -77,6 +76,7 @@ package Gen_IL.Fields is
Array_Aggregate,
Aspect_On_Partial_View,
Aspect_Rep_Item,
+ Aspect_Specifications,
Assignment_OK,
Attribute_Name,
At_End_Proc,
diff --git a/gcc/ada/gen_il-gen-gen_nodes.adb b/gcc/ada/gen_il-gen-gen_nodes.adb
index 0d2a68ea681..fdf928d60a3 100644
--- a/gcc/ada/gen_il-gen-gen_nodes.adb
+++ b/gcc/ada/gen_il-gen-gen_nodes.adb
@@ -62,7 +62,6 @@ begin -- Gen_IL.Gen.Gen_Nodes
Sm (Error_Posted, Flag),
Sm (Small_Paren_Count, Small_Paren_Count_Type),
Sm (Check_Actuals, Flag),
- Sm (Has_Aspects, Flag),
Sm (Is_Ignored_Ghost_Node, Flag),
Sm (Link, Union_Id)));
@@ -591,6 +590,7 @@ begin -- Gen_IL.Gen.Gen_Nodes
(Sy (Defining_Identifier, Node_Id),
Sy (Component_Definition, Node_Id),
Sy (Expression, Node_Id, Default_Empty),
+ Sy (Aspect_Specifications, List_Id, Default_No_List),
Sm (More_Ids, Flag),
Sm (Prev_Ids, Flag)));
@@ -600,11 +600,13 @@ begin -- Gen_IL.Gen.Gen_Nodes
Sy (Parameter_Specifications, List_Id, Default_No_List),
Sy (Must_Override, Flag),
Sy (Must_Not_Override, Flag),
+ Sy (Aspect_Specifications, List_Id, Default_No_List),
Sm (Corresponding_Body, Node_Id)));
Cc (N_Expression_Function, N_Declaration,
(Sy (Specification, Node_Id),
Sy (Expression, Node_Id, Default_Empty),
+ Sy (Aspect_Specifications, List_Id, Default_No_List),
Sm (Corresponding_Spec, Node_Id)));
Cc (N_Formal_Object_Declaration, N_Declaration,
@@ -615,6 +617,7 @@ begin -- Gen_IL.Gen.Gen_Nodes
Sy (Subtype_Mark, Node_Id, Default_Empty),
Sy (Access_Definition, Node_Id, Default_Empty),
Sy (Default_Expression, Node_Id, Default_Empty),
+ Sy (Aspect_Specifications, List_Id, Default_No_List),
Sm (More_Ids, Flag),
Sm (Prev_Ids, Flag)));
@@ -623,12 +626,14 @@ begin -- Gen_IL.Gen.Gen_Nodes
Sy (Formal_Type_Definition, Node_Id),
Sy (Discriminant_Specifications, List_Id, Default_No_List),
Sy (Unknown_Discriminants_Present, Flag),
- Sy (Default_Subtype_Mark, Node_Id)));
+ Sy (Default_Subtype_Mark, Node_Id),
+ Sy (Aspect_Specifications, List_Id, Default_No_List)));
Cc (N_Full_Type_Declaration, N_Declaration,
(Sy (Defining_Identifier, Node_Id),
Sy (Discriminant_Specifications, List_Id, Default_No_List),
Sy (Type_Definition, Node_Id),
+ Sy (Aspect_Specifications, List_Id, Default_No_List),
Sm (Discr_Check_Funcs_Built, Flag),
Sm (Incomplete_View, Node_Id)));
@@ -661,6 +666,7 @@ begin -- Gen_IL.Gen.Gen_Nodes
Sy (Object_Definition, Node_Id),
Sy (Expression, Node_Id, Default_Empty),
Sy (Has_Init_Expression, Flag),
+ Sy (Aspect_Specifications, List_Id, Default_No_List),
Sm (Assignment_OK, Flag),
Sm (Corresponding_Generic_Association, Node_Id),
Sm (Exception_Junk, Flag),
@@ -676,6 +682,7 @@ begin -- Gen_IL.Gen.Gen_Nodes
Sy (Discriminant_Specifications, List_Id, Default_No_List),
Sy (Interface_List, List_Id, Default_No_List),
Sy (Protected_Definition, Node_Id),
+ Sy (Aspect_Specifications, List_Id, Default_No_List),
Sm (Corresponding_Body, Node_Id)));
Cc (N_Private_Extension_Declaration, N_Declaration,
@@ -687,6 +694,7 @@ begin -- Gen_IL.Gen.Gen_Nodes
Sy (Synchronized_Present, Flag),
Sy (Subtype_Indication, Node_Id, Default_Empty),
Sy (Interface_List, List_Id, Default_No_List),
+ Sy (Aspect_Specifications, List_Id, Default_No_List),
Sm (Uninitialized_Variable, Node_Id)));
Cc (N_Private_Type_Declaration, N_Declaration,
@@ -695,12 +703,14 @@ begin -- Gen_IL.Gen.Gen_Nodes
Sy (Unknown_Discriminants_Present, Flag),
Sy (Abstract_Present, Flag),
Sy (Tagged_Present, Flag),
- Sy (Limited_Present, Flag)));
+ Sy (Limited_Present, Flag),
+ Sy (Aspect_Specifications, List_Id, Default_No_List)));
Cc (N_Subtype_Declaration, N_Declaration,
(Sy (Defining_Identifier, Node_Id),
Sy (Null_Exclusion_Present, Flag, Default_False),
Sy (Subtype_Indication, Node_Id, Default_Empty),
+ Sy (Aspect_Specifications, List_Id, Default_No_List),
Sm (Exception_Junk, Flag),
Sm (Generic_Parent_Type, Node_Id)));
@@ -721,6 +731,7 @@ begin -- Gen_IL.Gen.Gen_Nodes
Sy (Null_Present, Flag),
Sy (Must_Override, Flag),
Sy (Must_Not_Override, Flag),
+ Sy (Aspect_Specifications, List_Id, Default_No_List),
Sm (Null_Statement, Node_Id)));
Ab (N_Access_To_Subprogram_Definition, Node_Kind);
@@ -751,6 +762,7 @@ begin -- Gen_IL.Gen.Gen_Nodes
Sy (Discriminant_Specifications, List_Id, Default_No_List),
Sy (Interface_List, List_Id, Default_No_List),
Sy (Task_Definition, Node_Id, Default_Empty),
+ Sy (Aspect_Specifications, List_Id, Default_No_List),
Sm (Corresponding_Body, Node_Id)));
Ab (N_Body_Stub, N_Later_Decl_Item,
@@ -759,16 +771,20 @@ begin -- Gen_IL.Gen.Gen_Nodes
Sm (Library_Unit, Node_Id)));
Cc (N_Package_Body_Stub, N_Body_Stub,
- (Sy (Defining_Identifier, Node_Id)));
+ (Sy (Defining_Identifier, Node_Id),
+ Sy (Aspect_Specifications, List_Id, Default_No_List)));
Cc (N_Protected_Body_Stub, N_Body_Stub,
- (Sy (Defining_Identifier, Node_Id)));
+ (Sy (Defining_Identifier, Node_Id),
+ Sy (Aspect_Specifications, List_Id, Default_No_List)));
Cc (N_Subprogram_Body_Stub, N_Body_Stub,
- (Sy (Specification, Node_Id)));
+ (Sy (Specification, Node_Id),
+ Sy (Aspect_Specifications, List_Id, Default_No_List)));
Cc (N_Task_Body_Stub, N_Body_Stub,
- (Sy (Defining_Identifier, Node_Id)));
+ (Sy (Defining_Identifier, Node_Id),
+ Sy (Aspect_Specifications, List_Id, Default_No_List)));
Ab (N_Generic_Instantiation, N_Later_Decl_Item,
(Sm (Instance_Spec, Node_Id),
@@ -786,19 +802,22 @@ begin -- Gen_IL.Gen.Gen_Nodes
Sy (Name, Node_Id, Default_Empty),
Sy (Generic_Associations, List_Id, Default_No_List),
Sy (Must_Override, Flag),
- Sy (Must_Not_Override, Flag)));
+ Sy (Must_Not_Override, Flag),
+ Sy (Aspect_Specifications, List_Id, Default_No_List)));
Cc (N_Procedure_Instantiation, N_Subprogram_Instantiation,
(Sy (Defining_Unit_Name, Node_Id),
Sy (Name, Node_Id, Default_Empty),
Sy (Generic_Associations, List_Id, Default_No_List),
Sy (Must_Override, Flag),
- Sy (Must_Not_Override, Flag)));
+ Sy (Must_Not_Override, Flag),
+ Sy (Aspect_Specifications, List_Id, Default_No_List)));
Cc (N_Package_Instantiation, N_Generic_Instantiation,
(Sy (Defining_Unit_Name, Node_Id),
Sy (Name, Node_Id, Default_Empty),
- Sy (Generic_Associations, List_Id, Default_No_List)));
+ Sy (Generic_Associations, List_Id, Default_No_List),
+ Sy (Aspect_Specifications, List_Id, Default_No_List)));
Ab (N_Proper_Body, N_Later_Decl_Item,
(Sm (Corresponding_Spec, Node_Id),
@@ -810,7 +829,8 @@ begin -- Gen_IL.Gen.Gen_Nodes
(Sy (Defining_Unit_Name, Node_Id),
Sy (Declarations, List_Id, Default_No_List),
Sy (Handled_Statement_Sequence, Node_Id, Default_Empty),
- Sy (At_End_Proc, Node_Id, Default_Empty)));
+ Sy (At_End_Proc, Node_Id, Default_Empty),
+ Sy (Aspect_Specifications, List_Id, Default_No_List)));
Cc (N_Subprogram_Body, N_Unit_Body,
(Sy (Specification, Node_Id),
@@ -818,6 +838,7 @@ begin -- Gen_IL.Gen.Gen_Nodes
Sy (Handled_Statement_Sequence, Node_Id, Default_Empty),
Sy (Bad_Is_Detected, Flag),
Sy (At_End_Proc, Node_Id, Default_Empty),
+ Sy (Aspect_Specifications, List_Id, Default_No_List),
Sm (Activation_Chain_Entity, Node_Id),
Sm (Acts_As_Spec, Flag),
Sm (Corresponding_Entry_Body, Node_Id),
@@ -833,13 +854,15 @@ begin -- Gen_IL.Gen.Gen_Nodes
Cc (N_Protected_Body, N_Proper_Body,
(Sy (Defining_Identifier, Node_Id),
Sy (Declarations, List_Id, Default_No_List),
- Sy (End_Label, Node_Id, Default_Empty)));
+ Sy (End_Label, Node_Id, Default_Empty),
+ Sy (Aspect_Specifications, List_Id, Default_No_List)));
Cc (N_Task_Body, N_Proper_Body,
(Sy (Defining_Identifier, Node_Id),
Sy (Declarations, List_Id, Default_No_List),
Sy (Handled_Statement_Sequence, Node_Id, Default_Empty),
Sy (At_End_Proc, Node_Id, Default_Empty),
+ Sy (Aspect_Specifications, List_Id, Default_No_List),
Sm (Activation_Chain_Entity, Node_Id),
Sm (Is_Task_Master, Flag)));
@@ -849,6 +872,7 @@ begin -- Gen_IL.Gen.Gen_Nodes
Cc (N_Package_Declaration, N_Later_Decl_Item,
(Sy (Specification, Node_Id),
+ Sy (Aspect_Specifications, List_Id, Default_No_List),
Sm (Activation_Chain_Entity, Node_Id),
Sm (Corresponding_Body, Node_Id),
Sm (Parent_Spec, Node_Id)));
@@ -856,10 +880,12 @@ begin -- Gen_IL.Gen.Gen_Nodes
Cc (N_Single_Task_Declaration, N_Later_Decl_Item,
(Sy (Defining_Identifier, Node_Id),
Sy (Interface_List, List_Id, Default_No_List),
- Sy (Task_Definition, Node_Id, Default_Empty)));
+ Sy (Task_Definition, Node_Id, Default_Empty),
+ Sy (Aspect_Specifications, List_Id, Default_No_List)));
Cc (N_Subprogram_Declaration, N_Later_Decl_Item,
(Sy (Specification, Node_Id),
+ Sy (Aspect_Specifications, List_Id, Default_No_List),
Sm (Body_To_Inline, Node_Id),
Sm (Corresponding_Body, Node_Id),
Sm (Is_Entry_Barrier_Function, Flag),
@@ -883,11 +909,13 @@ begin -- Gen_IL.Gen.Gen_Nodes
Cc (N_Generic_Package_Declaration, N_Generic_Declaration,
(Sy (Specification, Node_Id),
Sy (Generic_Formal_Declarations, List_Id),
+ Sy (Aspect_Specifications, List_Id, Default_No_List),
Sm (Activation_Chain_Entity, Node_Id)));
Cc (N_Generic_Subprogram_Declaration, N_Generic_Declaration,
(Sy (Specification, Node_Id),
- Sy (Generic_Formal_Declarations, List_Id)));
+ Sy (Generic_Formal_Declarations, List_Id),
+ Sy (Aspect_Specifications, List_Id, Default_No_List)));
Ab (N_Array_Type_Definition, Node_Kind);
@@ -903,7 +931,8 @@ begin -- Gen_IL.Gen.Gen_Nodes
Cc (N_Exception_Renaming_Declaration, N_Renaming_Declaration,
(Sy (Defining_Identifier, Node_Id),
- Sy (Name, Node_Id, Default_Empty)));
+ Sy (Name, Node_Id, Default_Empty),
+ Sy (Aspect_Specifications, List_Id, Default_No_List)));
Cc (N_Object_Renaming_Declaration, N_Renaming_Declaration,
(Sy (Defining_Identifier, Node_Id),
@@ -911,24 +940,28 @@ begin -- Gen_IL.Gen.Gen_Nodes
Sy (Subtype_Mark, Node_Id, Default_Empty),
Sy (Access_Definition, Node_Id, Default_Empty),
Sy (Name, Node_Id, Default_Empty),
+ Sy (Aspect_Specifications, List_Id, Default_No_List),
Sm (Comes_From_Iterator, Flag),
Sm (Corresponding_Generic_Association, Node_Id)));
Cc (N_Package_Renaming_Declaration, N_Renaming_Declaration,
(Sy (Defining_Unit_Name, Node_Id),
Sy (Name, Node_Id, Default_Empty),
+ Sy (Aspect_Specifications, List_Id, Default_No_List),
Sm (Parent_Spec, Node_Id)));
Cc (N_Subprogram_Renaming_Declaration, N_Renaming_Declaration,
(Sy (Specification, Node_Id),
Sy (Name, Node_Id, Default_Empty),
+ Sy (Aspect_Specifications, List_Id, Default_No_List),
Sm (Corresponding_Formal_Spec, Node_Id),
Sm (Corresponding_Spec, Node_Id),
Sm (From_Default, Flag),
Sm (Parent_Spec, Node_Id)));
Ab (N_Generic_Renaming_Declaration, N_Renaming_Declaration,
- (Sm (Parent_Spec, Node_Id)));
+ (Sy (Aspect_Specifications, List_Id, Default_No_List),
+ Sm (Parent_Spec, Node_Id)));
Cc (N_Generic_Function_Renaming_Declaration, N_Generic_Renaming_Declaration,
(Sy (Defining_Unit_Name, Node_Id),
@@ -1148,13 +1181,15 @@ begin -- Gen_IL.Gen.Gen_Nodes
(Sy (Specification, Node_Id),
Sy (Default_Name, Node_Id, Default_Empty),
Sy (Expression, Node_Id, Default_Empty),
- Sy (Box_Present, Flag)));
+ Sy (Box_Present, Flag),
+ Sy (Aspect_Specifications, List_Id, Default_No_List)));
Cc (N_Formal_Concrete_Subprogram_Declaration, N_Formal_Subprogram_Declaration,
(Sy (Specification, Node_Id),
Sy (Default_Name, Node_Id, Default_Empty),
Sy (Expression, Node_Id, Default_Empty),
- Sy (Box_Present, Flag)));
+ Sy (Box_Present, Flag),
+ Sy (Aspect_Specifications, List_Id, Default_No_List)));
Ab (N_Push_Pop_xxx_Label, Node_Kind);
@@ -1191,7 +1226,8 @@ begin -- Gen_IL.Gen.Gen_Nodes
(Sy (Statements, List_Id, Default_Empty_List)));
Cc (N_Abstract_Subprogram_Declaration, Node_Kind,
- (Sy (Specification, Node_Id)));
+ (Sy (Specification, Node_Id),
+ Sy (Aspect_Specifications, List_Id, Default_No_List)));
Cc (N_Access_Definition, Node_Kind,
(Sy (Null_Exclusion_Present, Flag, Default_False),
@@ -1215,6 +1251,7 @@ begin -- Gen_IL.Gen.Gen_Nodes
Sm (Aspect_On_Partial_View, Flag),
Sm (Aspect_Rep_Item, Node_Id),
Sm (Entity_Or_Associated_Node, Node_Id), -- just Entity
+ Sm (Expression_Copy, Node_Id),
Sm (Is_Boolean_Aspect, Flag),
Sm (Is_Checked, Flag),
Sm (Is_Delayed_Aspect, Flag),
@@ -1347,6 +1384,7 @@ begin -- Gen_IL.Gen.Gen_Nodes
Sy (Declarations, List_Id, Default_No_List),
Sy (Handled_Statement_Sequence, Node_Id, Default_Empty),
Sy (At_End_Proc, Node_Id, Default_Empty),
+ Sy (Aspect_Specifications, List_Id, Default_No_List),
Sm (Activation_Chain_Entity, Node_Id),
Sm (Corresponding_Spec, Node_Id)));
@@ -1361,6 +1399,7 @@ begin -- Gen_IL.Gen.Gen_Nodes
Cc (N_Exception_Declaration, N_Declaration,
(Sy (Defining_Identifier, Node_Id),
+ Sy (Aspect_Specifications, List_Id, Default_No_List),
Sm (Expression, Node_Id),
Sm (More_Ids, Flag),
Sm (Prev_Ids, Flag),
@@ -1402,6 +1441,7 @@ begin -- Gen_IL.Gen.Gen_Nodes
Sy (Name, Node_Id, Default_Empty),
Sy (Generic_Associations, List_Id, Default_No_List),
Sy (Box_Present, Flag),
+ Sy (Aspect_Specifications, List_Id, Default_No_List),
Sm (Instance_Spec, Node_Id),
Sm (Is_Known_Guaranteed_ABE, Flag)));
@@ -1485,6 +1525,7 @@ begin -- Gen_IL.Gen.Gen_Nodes
Sy (Visible_Declarations, List_Id),
Sy (Private_Declarations, List_Id, Default_No_List),
Sy (End_Label, Node_Id, Default_Empty),
+ Sy (Aspect_Specifications, List_Id, Default_No_List),
Sm (Generic_Parent, Node_Id),
Sm (Limited_View_Installed, Flag)));
@@ -1502,6 +1543,7 @@ begin -- Gen_IL.Gen.Gen_Nodes
Sy (Null_Exclusion_Present, Flag, Default_False),
Sy (Parameter_Type, Node_Id),
Sy (Expression, Node_Id, Default_Empty),
+ Sy (Aspect_Specifications, List_Id, Default_No_List),
Sm (Default_Expression, Node_Id),
Sm (More_Ids, Flag),
Sm (Prev_Ids, Flag)));
@@ -1560,7 +1602,8 @@ begin -- Gen_IL.Gen.Gen_Nodes
Cc (N_Single_Protected_Declaration, Node_Kind,
(Sy (Defining_Identifier, Node_Id),
Sy (Interface_List, List_Id, Default_No_List),
- Sy (Protected_Definition, Node_Id)));
+ Sy (Protected_Definition, Node_Id),
+ Sy (Aspect_Specifications, List_Id, Default_No_List)));
Cc (N_Subunit, Node_Kind,
(Sy (Name, Node_Id, Default_Empty),
diff --git a/gcc/ada/ghost.adb b/gcc/ada/ghost.adb
index 6cf87ce29b1..ceb5d0ad7df 100644
--- a/gcc/ada/ghost.adb
+++ b/gcc/ada/ghost.adb
@@ -2029,9 +2029,6 @@ package body Ghost is
Rewrite (N, Make_Null_Statement (Sloc (N)));
- -- Eliminate any aspects hanging off the ignored Ghost node
-
- Remove_Aspects (N);
end if;
end Remove_Ignored_Ghost_Node;
diff --git a/gcc/ada/inline.adb b/gcc/ada/inline.adb
index 4e8d0f1bb74..5fff88144b2 100644
--- a/gcc/ada/inline.adb
+++ b/gcc/ada/inline.adb
@@ -3629,16 +3629,9 @@ package body Inline is
function Process_Formals_In_Aspects
(N : Node_Id) return Traverse_Result
is
- A : Node_Id;
-
begin
- if Has_Aspects (N) then
- A := First (Aspect_Specifications (N));
- while Present (A) loop
- Replace_Formals (Expression (A));
-
- Next (A);
- end loop;
+ if Nkind (N) = N_Aspect_Specification then
+ Replace_Formals (Expression (N));
end if;
return OK;
end Process_Formals_In_Aspects;
diff --git a/gcc/ada/par-ch13.adb b/gcc/ada/par-ch13.adb
index 075af019fee..85adad2d782 100644
--- a/gcc/ada/par-ch13.adb
+++ b/gcc/ada/par-ch13.adb
@@ -945,7 +945,6 @@ package body Ch13 is
-- Here aspects are allowed, and we store them
else
- Set_Parent (Aspects, Decl);
Set_Aspect_Specifications (Decl, Aspects);
end if;
end if;
diff --git a/gcc/ada/par-ch6.adb b/gcc/ada/par-ch6.adb
index 3171c5c3ce1..f041bbb2e49 100644
--- a/gcc/ada/par-ch6.adb
+++ b/gcc/ada/par-ch6.adb
@@ -935,7 +935,6 @@ package body Ch6 is
-- the body.
if Is_Non_Empty_List (Aspects) then
- Set_Parent (Aspects, Body_Node);
Set_Aspect_Specifications (Body_Node, Aspects);
end if;
@@ -974,7 +973,6 @@ package body Ch6 is
else
if Is_Non_Empty_List (Aspects) then
- Set_Parent (Aspects, Decl_Node);
Set_Aspect_Specifications (Decl_Node, Aspects);
end if;
diff --git a/gcc/ada/par_sco.adb b/gcc/ada/par_sco.adb
index 5e65fa25de1..0639ca616e0 100644
--- a/gcc/ada/par_sco.adb
+++ b/gcc/ada/par_sco.adb
@@ -1689,6 +1689,10 @@ package body Par_SCO is
C1 : Character;
begin
+ if not Has_Aspects (N) then
+ return;
+ end if;
+
AN := First (Aspect_Specifications (N));
while Present (AN) loop
AE := Expression (AN);
@@ -2408,8 +2412,6 @@ package body Par_SCO is
end if;
end case;
- -- Process aspects if present
-
Traverse_Aspects (N);
end Traverse_One;
diff --git a/gcc/ada/sem_ch10.adb b/gcc/ada/sem_ch10.adb
index 90d2f3c6c74..7cca555f276 100644
--- a/gcc/ada/sem_ch10.adb
+++ b/gcc/ada/sem_ch10.adb
@@ -1697,9 +1697,7 @@ package body Sem_Ch10 is
Mutate_Ekind (Id, E_Package_Body);
Set_Etype (Id, Standard_Void_Type);
- if Has_Aspects (N) then
- Analyze_Aspect_Specifications (N, Id);
- end if;
+ Analyze_Aspect_Specifications (N, Id);
Set_Has_Completion (Nam);
Set_Corresponding_Spec_Of_Stub (N, Nam);
@@ -2039,9 +2037,7 @@ package body Sem_Ch10 is
Mutate_Ekind (Id, E_Protected_Body);
Set_Etype (Id, Standard_Void_Type);
- if Has_Aspects (N) then
- Analyze_Aspect_Specifications (N, Id);
- end if;
+ Analyze_Aspect_Specifications (N, Id);
Set_Has_Completion (Etype (Nam));
Set_Corresponding_Spec_Of_Stub (N, Nam);
@@ -2693,9 +2689,7 @@ package body Sem_Ch10 is
Mutate_Ekind (Id, E_Task_Body);
Set_Etype (Id, Standard_Void_Type);
- if Has_Aspects (N) then
- Analyze_Aspect_Specifications (N, Id);
- end if;
+ Analyze_Aspect_Specifications (N, Id);
Generate_Reference (Nam, Id, 'b');
Set_Corresponding_Spec_Of_Stub (N, Nam);
diff --git a/gcc/ada/sem_ch11.adb b/gcc/ada/sem_ch11.adb
index 73eca7a603e..eda3232264c 100644
--- a/gcc/ada/sem_ch11.adb
+++ b/gcc/ada/sem_ch11.adb
@@ -70,9 +70,7 @@ package body Sem_Ch11 is
Set_Is_Statically_Allocated (Id);
Set_Is_Pure (Id, PF);
- if Has_Aspects (N) then
- Analyze_Aspect_Specifications (N, Id);
- end if;
+ Analyze_Aspect_Specifications (N, Id);
end Analyze_Exception_Declaration;
--------------------------------
diff --git a/gcc/ada/sem_ch12.adb b/gcc/ada/sem_ch12.adb
index 80b3e16ea75..582940da74b 100644
--- a/gcc/ada/sem_ch12.adb
+++ b/gcc/ada/sem_ch12.adb
@@ -2469,6 +2469,11 @@ package body Sem_Ch12 is
Make_Full_Type_Declaration (Loc,
Defining_Identifier => T,
Type_Definition => Def));
+
+ -- Keep the aspects from the original node
+
+ Move_Aspects (Original_Node (N), N);
+
Analyze (N);
Set_Is_Generic_Type (T);
end Analyze_Formal_Derived_Interface_Type;
@@ -2519,6 +2524,11 @@ package body Sem_Ch12 is
end if;
Rewrite (N, New_N);
+
+ -- Keep the aspects from the original node
+
+ Move_Aspects (Original_Node (N), N);
+
Analyze (N);
if Unk_Disc then
@@ -2651,6 +2661,11 @@ package body Sem_Ch12 is
Type_Definition => Def);
Rewrite (N, New_N);
+
+ -- Keep the aspects from the original node
+
+ Move_Aspects (Original_Node (N), N);
+
Analyze (N);
Set_Is_Generic_Type (T);
end Analyze_Formal_Interface_Type;
@@ -2817,9 +2832,7 @@ package body Sem_Ch12 is
end if;
end if;
- if Has_Aspects (N) then
- Analyze_Aspect_Specifications (N, Id);
- end if;
+ Analyze_Aspect_Specifications (N, Id);
if Parent_Installed then
Remove_Parent;
@@ -3273,12 +3286,10 @@ package body Sem_Ch12 is
Set_Has_Completion (Pack_Id, True);
<<Leave>>
- if Has_Aspects (N) then
- -- Unclear that any other aspects may appear here, analyze them
- -- for completion, given that the grammar allows their appearance.
+ -- Unclear that any other aspects may appear here, analyze them
+ -- for completion, given that the grammar allows their appearance.
- Analyze_Aspect_Specifications (N, Pack_Id);
- end if;
+ Analyze_Aspect_Specifications (N, Pack_Id);
Ignore_SPARK_Mode_Pragmas_In_Instance := Save_ISMP;
end Analyze_Formal_Package_Declaration;
@@ -3593,9 +3604,7 @@ package body Sem_Ch12 is
end if;
<<Leave>>
- if Has_Aspects (N) then
- Analyze_Aspect_Specifications (N, Nam);
- end if;
+ Analyze_Aspect_Specifications (N, Nam);
if Parent_Installed then
Remove_Parent;
@@ -3689,9 +3698,7 @@ package body Sem_Ch12 is
Validate_Formal_Type_Default (N);
end if;
- if Has_Aspects (N) then
- Analyze_Aspect_Specifications (N, T);
- end if;
+ Analyze_Aspect_Specifications (N, T);
if Parent_Installed then
Remove_Parent;
@@ -3839,11 +3846,6 @@ package body Sem_Ch12 is
Set_Parent_Spec (New_N, Save_Parent);
Rewrite (N, New_N);
- -- Once the contents of the generic copy and the template are swapped,
- -- do the same for their respective aspect specifications.
-
- Exchange_Aspects (N, New_N);
-
-- Collect all contract-related source pragmas found within the template
-- and attach them to the contract of the package spec. This contract is
-- used in the capture of global references within annotations.
@@ -3881,9 +3883,7 @@ package body Sem_Ch12 is
-- Analyze aspects now, so that generated pragmas appear in the
-- declarations before building and analyzing the generic copy.
- if Has_Aspects (N) then
- Analyze_Aspect_Specifications (N, Id);
- end if;
+ Analyze_Aspect_Specifications (N, Id);
Push_Scope (Id);
Enter_Generic_Scope (Id);
@@ -4003,11 +4003,6 @@ package body Sem_Ch12 is
Set_Parent_Spec (New_N, Save_Parent);
Rewrite (N, New_N);
- -- Once the contents of the generic copy and the template are swapped,
- -- do the same for their respective aspect specifications.
-
- Exchange_Aspects (N, New_N);
-
-- Collect all contract-related source pragmas found within the template
-- and attach them to the contract of the subprogram spec. This contract
-- is used in the capture of global references within annotations.
@@ -4112,9 +4107,7 @@ package body Sem_Ch12 is
-- Analyze the aspects of the generic copy to ensure that all generated
-- pragmas (if any) perform their semantic effects.
- if Has_Aspects (N) then
- Analyze_Aspect_Specifications (N, Id);
- end if;
+ Analyze_Aspect_Specifications (N, Id);
-- For a library unit, we have reconstructed the entity for the unit,
-- and must reset it in the library tables. We also make sure that
@@ -4950,9 +4943,7 @@ package body Sem_Ch12 is
-- take into account categorization pragmas before analyzing the
-- instance.
- if Has_Aspects (N) then
- Analyze_Aspect_Specifications (N, Act_Decl_Id);
- end if;
+ Analyze_Aspect_Specifications (N, Act_Decl_Id);
Analyze (Act_Decl);
Set_Unit (Parent (N), N);
@@ -5065,7 +5056,7 @@ package body Sem_Ch12 is
end if;
<<Leave>>
- if Has_Aspects (N) and then Nkind (Parent (N)) /= N_Compilation_Unit then
+ if Nkind (Parent (N)) /= N_Compilation_Unit then
Analyze_Aspect_Specifications (N, Act_Decl_Id);
end if;
@@ -6355,14 +6346,6 @@ package body Sem_Ch12 is
Rewrite (N, Act_Body);
- -- Propagate the aspect specifications from the package body template to
- -- the instantiated version of the package body.
-
- if Has_Aspects (Act_Body) then
- Set_Aspect_Specifications
- (N, New_Copy_List_Tree (Aspect_Specifications (Act_Body)));
- end if;
-
Body_Cunit := Parent (N);
-- The two compilation unit nodes are linked by the Library_Unit field
@@ -8081,14 +8064,6 @@ package body Sem_Ch12 is
New_N := New_Copy (N);
- -- Copy aspects if present
-
- if Has_Aspects (N) then
- Set_Has_Aspects (New_N, False);
- Set_Aspect_Specifications
- (New_N, Copy_Generic_List (Aspect_Specifications (N), Parent_Id));
- end if;
-
-- If we are instantiating, we want to adjust the sloc based on the
-- current S_Adjustment. However, if this is the root node of a subunit,
-- we need to defer that adjustment to below (see "elsif Instantiating
@@ -16878,29 +16853,40 @@ package body Sem_Ch12 is
elsif Nkind (N) = N_Pragma then
Save_References_In_Pragma (N);
- else
- Save_References_In_Descendants (N);
- end if;
+ elsif Nkind (N) = N_Aspect_Specification then
+ declare
+ P : constant Node_Id := Parent (N);
+ Expr : Node_Id;
+ begin
- -- Save all global references found within the aspect specifications
- -- of the related node.
+ if Permits_Aspect_Specifications (P) then
- if Permits_Aspect_Specifications (N) and then Has_Aspects (N) then
+ -- The capture of global references within aspects
+ -- associated with generic packages, subprograms or
+ -- their bodies must be delayed due to timing of
+ -- annotation analysis. Global references are still
+ -- captured in routine Save_Global_References_In_Contract.
- -- The capture of global references within aspects associated with
- -- generic packages, subprograms or their bodies must be delayed
- -- due to timing of annotation analysis. Global references are
- -- still captured in routine Save_Global_References_In_Contract.
+ if Requires_Delayed_Save (Original_Node (P)) then
+ null;
- if Requires_Delayed_Save (N) then
- null;
+ -- Otherwise save all global references within the
+ -- aspects
- -- Otherwise save all global references within the aspects
+ else
+ Expr := Expression (N);
- else
- Save_Global_References_In_Aspects (N);
- end if;
+ if Present (Expr) then
+ Save_Global_References (Expr);
+ end if;
+ end if;
+ end if;
+ end;
+
+ else
+ Save_References_In_Descendants (N);
end if;
+
end Save_References;
---------------------
diff --git a/gcc/ada/sem_ch13.adb b/gcc/ada/sem_ch13.adb
index ae97da58da3..5747ee9c539 100644
--- a/gcc/ada/sem_ch13.adb
+++ b/gcc/ada/sem_ch13.adb
@@ -1673,7 +1673,6 @@ package body Sem_Ch13 is
Ent : Node_Id;
L : constant List_Id := Aspect_Specifications (N);
- pragma Assert (Present (L));
Ins_Node : Node_Id := N;
-- Insert pragmas/attribute definition clause after this node when no
@@ -1702,6 +1701,10 @@ package body Sem_Ch13 is
-- visibility for the expression analysis. Thus, we just insert the
-- pragma after the node N.
+ if No (L) then
+ return;
+ end if;
+
-- Loop through aspects
Aspect := First (L);
@@ -2880,9 +2883,9 @@ package body Sem_Ch13 is
-- requires its own analysis procedure (see sem_ch6).
if Nkind (Expr) = N_Operator_Symbol then
- Set_Entity (Id, Expr);
+ Set_Expression_Copy (Aspect, Expr);
else
- Set_Entity (Id, New_Copy_Tree (Expr));
+ Set_Expression_Copy (Aspect, New_Copy_Tree (Expr));
end if;
-- Set Delay_Required as appropriate to aspect
@@ -5122,7 +5125,10 @@ package body Sem_Ch13 is
-- aspects are allowed to break this rule (for all applicable cases, see
-- table Aspects.Aspect_On_Body_Or_Stub_OK).
- if Spec_Id /= Body_Id and then not Aspects_On_Body_Or_Stub_OK (N) then
+ if Spec_Id /= Body_Id
+ and then Has_Aspects (N)
+ and then not Aspects_On_Body_Or_Stub_OK (N)
+ then
Diagnose_Misplaced_Aspects (Spec_Id);
else
Analyze_Aspect_Specifications (N, Body_Id);
@@ -10339,7 +10345,7 @@ package body Sem_Ch13 is
-- Check_Aspect_At_xxx routines.
if Present (Asp) then
- Set_Entity (Identifier (Asp), New_Copy_Tree (Arg2_Copy));
+ Set_Expression_Copy (Asp, New_Copy_Tree (Arg2_Copy));
end if;
-- "and"-in the Arg2 condition to evolving expression
@@ -11008,7 +11014,7 @@ package body Sem_Ch13 is
Ident : constant Node_Id := Identifier (ASN);
A_Id : constant Aspect_Id := Get_Aspect_Id (Chars (Ident));
- End_Decl_Expr : constant Node_Id := Entity (Ident);
+ End_Decl_Expr : constant Node_Id := Expression_Copy (ASN);
-- Expression to be analyzed at end of declarations
Freeze_Expr : constant Node_Id := Expression (ASN);
@@ -11262,7 +11268,7 @@ package body Sem_Ch13 is
-- Make a copy of the expression to be preanalyzed
- Set_Expression (ASN, New_Copy_Tree (Entity (Ident)));
+ Set_Expression (ASN, New_Copy_Tree (Expression_Copy (ASN)));
-- Find type for preanalyze call
diff --git a/gcc/ada/sem_ch3.adb b/gcc/ada/sem_ch3.adb
index 8583ac05261..a38275133f4 100644
--- a/gcc/ada/sem_ch3.adb
+++ b/gcc/ada/sem_ch3.adb
@@ -2311,9 +2311,7 @@ package body Sem_Ch3 is
Set_Original_Record_Component (Id, Id);
- if Has_Aspects (N) then
- Analyze_Aspect_Specifications (N, Id);
- end if;
+ Analyze_Aspect_Specifications (N, Id);
Analyze_Dimension (N);
end Analyze_Component_Declaration;
@@ -3525,25 +3523,22 @@ package body Sem_Ch3 is
-- them to the entity for the type which is currently the partial
-- view, but which is the one that will be frozen.
- if Has_Aspects (N) then
-
- -- In most cases the partial view is a private type, and both views
- -- appear in different declarative parts. In the unusual case where
- -- the partial view is incomplete, perform the analysis on the
- -- full view, to prevent freezing anomalies with the corresponding
- -- class-wide type, which otherwise might be frozen before the
- -- dispatch table is built.
+ -- In most cases the partial view is a private type, and both views
+ -- appear in different declarative parts. In the unusual case where
+ -- the partial view is incomplete, perform the analysis on the
+ -- full view, to prevent freezing anomalies with the corresponding
+ -- class-wide type, which otherwise might be frozen before the
+ -- dispatch table is built.
- if Prev /= Def_Id
- and then Ekind (Prev) /= E_Incomplete_Type
- then
- Analyze_Aspect_Specifications (N, Prev);
+ if Prev /= Def_Id
+ and then Ekind (Prev) /= E_Incomplete_Type
+ then
+ Analyze_Aspect_Specifications (N, Prev);
- -- Normal case
+ -- Normal case
- else
- Analyze_Aspect_Specifications (N, Def_Id);
- end if;
+ else
+ Analyze_Aspect_Specifications (N, Def_Id);
end if;
if Is_Derived_Type (Prev)
@@ -5323,9 +5318,7 @@ package body Sem_Ch3 is
Set_Encapsulating_State (Id, Empty);
end if;
- if Has_Aspects (N) then
- Analyze_Aspect_Specifications (N, Id);
- end if;
+ Analyze_Aspect_Specifications (N, Id);
Analyze_Dimension (N);
@@ -5604,9 +5597,7 @@ package body Sem_Ch3 is
Set_Has_Private_Extension (Parent_Type);
<<Leave>>
- if Has_Aspects (N) then
- Analyze_Aspect_Specifications (N, T);
- end if;
+ Analyze_Aspect_Specifications (N, T);
end Analyze_Private_Extension_Declaration;
---------------------------------
@@ -6226,9 +6217,7 @@ package body Sem_Ch3 is
Check_Eliminated (Id);
<<Leave>>
- if Has_Aspects (N) then
- Analyze_Aspect_Specifications (N, Id);
- end if;
+ Analyze_Aspect_Specifications (N, Id);
Analyze_Dimension (N);
@@ -7195,6 +7184,11 @@ package body Sem_Ch3 is
Constraint => Constraint (Indic)));
Rewrite (N, New_Indic);
+
+ -- Keep the aspects from the original node
+
+ Move_Aspects (Original_Node (N), N);
+
Analyze (N);
end if;
@@ -7374,6 +7368,10 @@ package body Sem_Ch3 is
Defining_Identifier => Derived_Type,
Subtype_Indication => New_Indic));
+ -- Keep the aspects from the original node
+
+ Move_Aspects (Original_Node (N), N);
+
Analyze (N);
return;
end;
@@ -7802,12 +7800,16 @@ package body Sem_Ch3 is
Make_Range_Constraint (Loc,
Range_Expression => Rang_Expr))));
+ -- Keep the aspects from the orignal node
+
+ Move_Aspects (Original_Node (N), N);
+
Analyze (N);
-- Propagate the aspects from the original type declaration to the
-- declaration of the implicit base.
- Move_Aspects (From => Original_Node (N), To => Type_Decl);
+ Copy_Aspects (From => N, To => Type_Decl);
-- Apply a range check. Since this range expression doesn't have an
-- Etype, we have to specifically pass the Source_Typ parameter. Is
@@ -9466,6 +9468,10 @@ package body Sem_Ch3 is
Defining_Identifier => Derived_Type,
Subtype_Indication => New_Indic));
+ -- Keep the aspects from the original node
+
+ Move_Aspects (Original_Node (N), N);
+
Analyze (N);
-- Derivation of subprograms must be delayed until the full subtype
@@ -10041,6 +10047,11 @@ package body Sem_Ch3 is
Replace_Discriminants (Derived_Type, New_Decl);
end if;
+ -- Relocate the aspects from the original type
+
+ Remove_Aspects (New_Decl);
+ Move_Aspects (N, New_Decl);
+
-- Insert the new derived type declaration
Rewrite (N, New_Decl);
diff --git a/gcc/ada/sem_ch6.adb b/gcc/ada/sem_ch6.adb
index 00f7e379cb2..3dd265901dd 100644
--- a/gcc/ada/sem_ch6.adb
+++ b/gcc/ada/sem_ch6.adb
@@ -290,9 +290,7 @@ package body Sem_Ch6 is
Generate_Reference_To_Formals (Subp_Id);
Check_Eliminated (Subp_Id);
- if Has_Aspects (N) then
- Analyze_Aspect_Specifications (N, Subp_Id);
- end if;
+ Analyze_Aspect_Specifications (N, Subp_Id);
end Analyze_Abstract_Subprogram_Declaration;
---------------------------------
@@ -430,11 +428,10 @@ package body Sem_Ch6 is
Generate_Reference (Prev, Defining_Entity (N), 'b', Force => True);
Rewrite (N, New_Body);
- -- Remove any existing aspects from the original node because the act
- -- of rewriting causes the list to be shared between the two nodes.
+ -- Keep the aspects from the original node
Orig_N := Original_Node (N);
- Remove_Aspects (Orig_N);
+ Move_Aspects (Orig_N, N);
-- Propagate any pragmas that apply to expression function to the
-- proper body when the expression function acts as a completion.
@@ -488,11 +485,10 @@ package body Sem_Ch6 is
Rewrite (N, Make_Subprogram_Declaration (Loc, Specification => Spec));
- -- Remove any existing aspects from the original node because the act
- -- of rewriting causes the list to be shared between the two nodes.
+ -- Keep the aspects from the original node
Orig_N := Original_Node (N);
- Remove_Aspects (Orig_N);
+ Move_Aspects (Orig_N, N);
Analyze (N);
@@ -1139,11 +1135,6 @@ package body Sem_Ch6 is
New_N := Copy_Generic_Node (N, Empty, Instantiating => False);
Rewrite (N, New_N);
- -- Once the contents of the generic copy and the template are
- -- swapped, do the same for their respective aspect specifications.
-
- Exchange_Aspects (N, New_N);
-
-- Collect all contract-related source pragmas found within the
-- template and attach them to the contract of the subprogram body.
-- This contract is used in the capture of global references within
@@ -1289,9 +1280,7 @@ package body Sem_Ch6 is
-- Analyze any aspect specifications that appear on the generic
-- subprogram body.
- if Has_Aspects (N) then
- Analyze_Aspects_On_Subprogram_Body_Or_Stub (N);
- end if;
+ Analyze_Aspects_On_Subprogram_Body_Or_Stub (N);
-- Process the contract of the subprogram body after analyzing all
-- the contract-related pragmas within the declarations.
@@ -1506,6 +1495,7 @@ package body Sem_Ch6 is
Is_Completion := True;
Rewrite (N, Null_Body);
+ Move_Aspects (Original_Node (N), N);
Analyze (N);
end if;
@@ -4363,9 +4353,7 @@ package body Sem_Ch6 is
-- or a statement part, and it cannot be inlined.
if Nkind (N) = N_Subprogram_Body_Stub then
- if Has_Aspects (N) then
- Analyze_Aspects_On_Subprogram_Body_Or_Stub (N);
- end if;
+ Analyze_Aspects_On_Subprogram_Body_Or_Stub (N);
goto Leave;
end if;
@@ -4612,9 +4600,7 @@ package body Sem_Ch6 is
-- Analyze any aspect specifications that appear on the subprogram body
- if Has_Aspects (N) then
- Analyze_Aspects_On_Subprogram_Body_Or_Stub (N);
- end if;
+ Analyze_Aspects_On_Subprogram_Body_Or_Stub (N);
-- Process the contract of the subprogram body after analyzing all the
-- contract-related pragmas within the declarations.
@@ -5251,9 +5237,7 @@ package body Sem_Ch6 is
-- case the subprogram is a compilation unit and one of its aspects is
-- converted into a categorization pragma.
- if Has_Aspects (N) then
- Analyze_Aspect_Specifications (N, Designator);
- end if;
+ Analyze_Aspect_Specifications (N, Designator);
-- The legality of a function specification in SPARK depends on whether
-- the function is a function with or without side-effects. Analyze the
diff --git a/gcc/ada/sem_ch7.adb b/gcc/ada/sem_ch7.adb
index 1a49a53ad63..21a22267590 100644
--- a/gcc/ada/sem_ch7.adb
+++ b/gcc/ada/sem_ch7.adb
@@ -877,11 +877,6 @@ package body Sem_Ch7 is
New_N := Copy_Generic_Node (N, Empty, Instantiating => False);
Rewrite (N, New_N);
- -- Once the contents of the generic copy and the template are
- -- swapped, do the same for their respective aspect specifications.
-
- Exchange_Aspects (N, New_N);
-
-- Collect all contract-related source pragmas found within the
-- template and attach them to the contract of the package body.
-- This contract is used in the capture of global references within
@@ -929,9 +924,7 @@ package body Sem_Ch7 is
Set_Has_Completion (Spec_Id);
Last_Spec_Entity := Last_Entity (Spec_Id);
- if Has_Aspects (N) then
- Analyze_Aspect_Specifications (N, Body_Id);
- end if;
+ Analyze_Aspect_Specifications (N, Body_Id);
Push_Scope (Spec_Id);
@@ -1213,9 +1206,7 @@ package body Sem_Ch7 is
-- Analyze aspect specifications immediately, since we need to recognize
-- things like Pure early enough to diagnose violations during analysis.
- if Has_Aspects (N) then
- Analyze_Aspect_Specifications (N, Id);
- end if;
+ Analyze_Aspect_Specifications (N, Id);
-- Ada 2005 (AI-217): Check if the package has been illegally named in
-- a limited-with clause of its own context. In this case the error has
@@ -2094,9 +2085,7 @@ package body Sem_Ch7 is
Set_SPARK_Pragma (Id, SPARK_Mode_Pragma);
Set_SPARK_Pragma_Inherited (Id);
- if Has_Aspects (N) then
- Analyze_Aspect_Specifications (N, Id);
- end if;
+ Analyze_Aspect_Specifications (N, Id);
end Analyze_Private_Type_Declaration;
----------------------------------
diff --git a/gcc/ada/sem_ch8.adb b/gcc/ada/sem_ch8.adb
index 0d3c2349284..7f6accd7768 100644
--- a/gcc/ada/sem_ch8.adb
+++ b/gcc/ada/sem_ch8.adb
@@ -605,9 +605,7 @@ package body Sem_Ch8 is
-- declaration, but not language-defined ones. The call to procedure
-- Analyze_Aspect_Specifications will take care of this error check.
- if Has_Aspects (N) then
- Analyze_Aspect_Specifications (N, Id);
- end if;
+ Analyze_Aspect_Specifications (N, Id);
end Analyze_Exception_Renaming;
---------------------------
@@ -753,9 +751,7 @@ package body Sem_Ch8 is
-- declaration, but not language-defined ones. The call to procedure
-- Analyze_Aspect_Specifications will take care of this error check.
- if Has_Aspects (N) then
- Analyze_Aspect_Specifications (N, New_P);
- end if;
+ Analyze_Aspect_Specifications (N, New_P);
end Analyze_Generic_Renaming;
-----------------------------
@@ -1582,9 +1578,7 @@ package body Sem_Ch8 is
-- declaration, but not language-defined ones. The call to procedure
-- Analyze_Aspect_Specifications will take care of this error check.
- if Has_Aspects (N) then
- Analyze_Aspect_Specifications (N, Id);
- end if;
+ Analyze_Aspect_Specifications (N, Id);
-- Deal with dimensions
@@ -1765,9 +1759,7 @@ package body Sem_Ch8 is
-- declaration, but not language-defined ones. The call to procedure
-- Analyze_Aspect_Specifications will take care of this error check.
- if Has_Aspects (N) then
- Analyze_Aspect_Specifications (N, New_P);
- end if;
+ Analyze_Aspect_Specifications (N, New_P);
end Analyze_Package_Renaming;
-------------------------------
@@ -4205,9 +4197,7 @@ package body Sem_Ch8 is
-- declaration, but not language-defined ones. The call to procedure
-- Analyze_Aspect_Specifications will take care of this error check.
- if Has_Aspects (N) then
- Analyze_Aspect_Specifications (N, New_S);
- end if;
+ Analyze_Aspect_Specifications (N, New_S);
-- AI12-0279
diff --git a/gcc/ada/sem_ch9.adb b/gcc/ada/sem_ch9.adb
index 72821c51c3f..365887cbe14 100644
--- a/gcc/ada/sem_ch9.adb
+++ b/gcc/ada/sem_ch9.adb
@@ -1292,9 +1292,7 @@ package body Sem_Ch9 is
-- Analyze any aspect specifications that appear on the entry body
- if Has_Aspects (N) then
- Analyze_Aspects_On_Subprogram_Body_Or_Stub (N);
- end if;
+ Analyze_Aspects_On_Subprogram_Body_Or_Stub (N);
E := First_Entity (P_Type);
while Present (E) loop
@@ -1729,9 +1727,7 @@ package body Sem_Ch9 is
Generate_Reference_To_Formals (Def_Id);
- if Has_Aspects (N) then
- Analyze_Aspect_Specifications (N, Def_Id);
- end if;
+ Analyze_Aspect_Specifications (N, Def_Id);
end Analyze_Entry_Declaration;
---------------------------------------
@@ -1880,9 +1876,7 @@ package body Sem_Ch9 is
Spec_Id := Etype (Spec_Id);
end if;
- if Has_Aspects (N) then
- Analyze_Aspect_Specifications (N, Body_Id);
- end if;
+ Analyze_Aspect_Specifications (N, Body_Id);
Push_Scope (Spec_Id);
Set_Corresponding_Spec (N, Spec_Id);
@@ -2046,9 +2040,7 @@ package body Sem_Ch9 is
if No_Run_Time_Mode then
Error_Msg_CRT ("protected type", N);
- if Has_Aspects (N) then
- Analyze_Aspect_Specifications (N, Def_Id);
- end if;
+ Analyze_Aspect_Specifications (N, Def_Id);
return;
end if;
@@ -2128,18 +2120,15 @@ package body Sem_Ch9 is
-- If aspects are present, analyze them now. They can make references to
-- the discriminants of the type, but not to any components.
- if Has_Aspects (N) then
-
- -- The protected type is the full view of a private type. Analyze the
- -- aspects with the entity of the private type to ensure that after
- -- both views are exchanged, the aspect are actually associated with
- -- the full view.
+ -- The protected type is the full view of a private type. Analyze the
+ -- aspects with the entity of the private type to ensure that after
+ -- both views are exchanged, the aspect are actually associated with
+ -- the full view.
- if T /= Def_Id and then Is_Private_Type (Def_Id) then
- Analyze_Aspect_Specifications (N, T);
- else
- Analyze_Aspect_Specifications (N, Def_Id);
- end if;
+ if T /= Def_Id and then Is_Private_Type (Def_Id) then
+ Analyze_Aspect_Specifications (N, T);
+ else
+ Analyze_Aspect_Specifications (N, Def_Id);
end if;
Analyze (Protected_Definition (N));
@@ -2873,6 +2862,10 @@ package body Sem_Ch9 is
-- Obj : Typ;
+ -- Keep the aspects from the original node
+
+ Move_Aspects (Original_Node (N), N);
+
Obj_Decl :=
Make_Object_Declaration (Loc,
Defining_Identifier => Obj_Id,
@@ -2915,9 +2908,7 @@ package body Sem_Ch9 is
Analyze_Protected_Type_Declaration (N);
- if Has_Aspects (N) then
- Analyze_Aspect_Specifications (N, Obj_Id);
- end if;
+ Analyze_Aspect_Specifications (N, Obj_Id);
end Analyze_Single_Protected_Declaration;
-------------------------------------
@@ -2959,6 +2950,10 @@ package body Sem_Ch9 is
-- Obj : Typ;
+ -- Keep the aspects from the original node
+
+ Move_Aspects (Original_Node (N), N);
+
Obj_Decl :=
Make_Object_Declaration (Loc,
Defining_Identifier => Obj_Id,
@@ -3011,9 +3006,7 @@ package body Sem_Ch9 is
Analyze_Task_Type_Declaration (N);
- if Has_Aspects (N) then
- Analyze_Aspect_Specifications (N, Obj_Id);
- end if;
+ Analyze_Aspect_Specifications (N, Obj_Id);
end Analyze_Single_Task_Declaration;
-----------------------
@@ -3094,9 +3087,7 @@ package body Sem_Ch9 is
Set_SPARK_Pragma (Body_Id, SPARK_Mode_Pragma);
Set_SPARK_Pragma_Inherited (Body_Id);
- if Has_Aspects (N) then
- Analyze_Aspect_Specifications (N, Body_Id);
- end if;
+ Analyze_Aspect_Specifications (N, Body_Id);
Push_Scope (Spec_Id);
Set_Corresponding_Spec (N, Spec_Id);
@@ -3325,18 +3316,15 @@ package body Sem_Ch9 is
Set_Is_Constrained (T, not Has_Discriminants (T));
- if Has_Aspects (N) then
+ -- The task type is the full view of a private type. Analyze the
+ -- aspects with the entity of the private type to ensure that after
+ -- both views are exchanged, the aspect are actually associated with
+ -- the full view.
- -- The task type is the full view of a private type. Analyze the
- -- aspects with the entity of the private type to ensure that after
- -- both views are exchanged, the aspect are actually associated with
- -- the full view.
-
- if T /= Def_Id and then Is_Private_Type (Def_Id) then
- Analyze_Aspect_Specifications (N, T);
- else
- Analyze_Aspect_Specifications (N, Def_Id);
- end if;
+ if T /= Def_Id and then Is_Private_Type (Def_Id) then
+ Analyze_Aspect_Specifications (N, T);
+ else
+ Analyze_Aspect_Specifications (N, Def_Id);
end if;
if Present (Task_Definition (N)) then
diff --git a/gcc/ada/sem_dim.adb b/gcc/ada/sem_dim.adb
index cc191dfa983..816870fc70a 100644
--- a/gcc/ada/sem_dim.adb
+++ b/gcc/ada/sem_dim.adb
@@ -23,7 +23,6 @@
-- --
------------------------------------------------------------------------------
-with Aspects; use Aspects;
with Atree; use Atree;
with Einfo; use Einfo;
with Einfo.Entities; use Einfo.Entities;
@@ -2922,7 +2921,6 @@ package body Sem_Dim is
Subtype_Indication => New_Occurrence_Of (Btyp_Of_L, Loc));
Append (New_Aspect, New_Aspects);
- Set_Parent (New_Aspects, New_Subtyp_Decl_For_L);
Set_Aspect_Specifications (New_Subtyp_Decl_For_L, New_Aspects);
Analyze (New_Subtyp_Decl_For_L);
diff --git a/gcc/ada/sem_disp.adb b/gcc/ada/sem_disp.adb
index b22407aafb8..ab7bc40978a 100644
--- a/gcc/ada/sem_disp.adb
+++ b/gcc/ada/sem_disp.adb
@@ -23,7 +23,6 @@
-- --
------------------------------------------------------------------------------
-with Aspects; use Aspects;
with Atree; use Atree;
with Debug; use Debug;
with Elists; use Elists;
diff --git a/gcc/ada/sem_util.adb b/gcc/ada/sem_util.adb
index cfd8b88a26e..afe69da6a84 100644
--- a/gcc/ada/sem_util.adb
+++ b/gcc/ada/sem_util.adb
@@ -23601,11 +23601,6 @@ package body Sem_Util is
Set_Chars (Result, Chars (Entity (Result)));
end if;
end if;
-
- if Has_Aspects (N) then
- Set_Aspect_Specifications (Result,
- Copy_List_With_Replacement (Aspect_Specifications (N)));
- end if;
end if;
return Result;
diff --git a/gcc/ada/treepr.adb b/gcc/ada/treepr.adb
index 0a8bf55ca61..cf938d4f226 100644
--- a/gcc/ada/treepr.adb
+++ b/gcc/ada/treepr.adb
@@ -187,7 +187,6 @@ package body Treepr is
-- Called if the node being printed is an entity. Prints fields from the
-- extension, using routines in Einfo to get the field names and flags.
- procedure Print_Field (Val : Union_Id; Format : UI_Format := Auto);
procedure Print_Field
(Prefix : String;
Field : String;
@@ -726,51 +725,6 @@ package body Treepr is
function Get_Mechanism_Type is new Get_32_Bit_Field
(Mechanism_Type) with Inline, Unreferenced;
- procedure Print_Field (Val : Union_Id; Format : UI_Format := Auto) is
- begin
- if Phase /= Printing then
- return;
- end if;
-
- if Val in Node_Range then
- Print_Node_Ref (Node_Id (Val));
-
- elsif Val in List_Range then
- Print_List_Ref (List_Id (Val));
-
- elsif Val in Elist_Range then
- Print_Elist_Ref (Elist_Id (Val));
-
- elsif Val in Names_Range then
- Print_Name (Name_Id (Val));
- Write_Str (" (Name_Id=");
- Write_Int (Int (Val));
- Write_Char (')');
-
- elsif Val in Strings_Range then
- Write_String_Table_Entry (String_Id (Val));
- Write_Str (" (String_Id=");
- Write_Int (Int (Val));
- Write_Char (')');
-
- elsif Val in Uint_Range then
- UI_Write (From_Union (Val), Format);
- Write_Str (" (Uint = ");
- Write_Int (Int (Val));
- Write_Char (')');
-
- elsif Val in Ureal_Range then
- UR_Write (From_Union (Val));
- Write_Str (" (Ureal = ");
- Write_Int (Int (Val));
- Write_Char (')');
-
- else
- Print_Str ("****** Incorrect value = ");
- Print_Int (Int (Val));
- end if;
- end Print_Field;
-
procedure Print_Field
(Prefix : String;
Field : String;
@@ -1393,7 +1347,6 @@ package body Treepr is
| F_Assignment_OK
| F_Do_Range_Check
| F_Has_Dynamic_Length_Check
- | F_Has_Aspects
| F_Is_Controlling_Actual
| F_Is_Overloaded
| F_Is_Static_Expression
@@ -1440,15 +1393,6 @@ package body Treepr is
end loop;
end;
- -- Print aspects if present
-
- if Has_Aspects (N) then
- Print_Str (Prefix);
- Print_Str ("Aspect_Specifications = ");
- Print_Field (Union_Id (Aspect_Specifications (N)));
- Print_Eol;
- end if;
-
-- Print entity information for entities
if Nkind (N) in N_Entity then
--
2.42.0
^ permalink raw reply [flat|nested] only message in thread
only message in thread, other threads:[~2023-11-07 9:20 UTC | newest]
Thread overview: (only message) (download: mbox.gz / follow: Atom feed)
-- links below jump to the message on this page --
2023-11-07 9:20 [COMMITTED] ada: Implement Aspects as fields under nodes Marc Poulhiès
This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox;
as well as URLs for read-only IMAP folder(s) and NNTP newsgroup(s).