From: Bob Duff <[email protected]>
In case of an Annotate aspect of the form "Annotate => Expr",
where Expr is an identifier (as opposed to an aggregate),
the Parent field of the N_Identifier node for Expr was
destroyed. This patch changes the code that turns the aspect
into a pragma, so that it no longer has that bug.
The problem was in "New_List (Expr)"; which sets the Parent of
Expr to Empty. But Expr is still part of the tree of the aspect,
so it should have a proper Parent; we can't just stick it in a
temporary list.
The new algorithm constructs the pragma arguments without disturbing
the tree of the aspect.
This is the last known case of missing Parent fields, so we can
now enable the VAST check that detected this bug.
gcc/ada/ChangeLog:
* sem_ch13.adb (Aspect_Annotate): Avoid disturbing the tree of the
aspect.
* vast.adb: Enable Check_Parent_Present.
* exp_ch6.adb (Validate_Subprogram_Calls): Minor reformatting.
Tested on x86_64-pc-linux-gnu, committed on master.
---
gcc/ada/exp_ch6.adb | 5 +++--
gcc/ada/sem_ch13.adb | 51 +++++++++++++++++++-------------------------
gcc/ada/vast.adb | 2 +-
3 files changed, 26 insertions(+), 32 deletions(-)
diff --git a/gcc/ada/exp_ch6.adb b/gcc/ada/exp_ch6.adb
index 6bf8d3ba145..42111a416de 100644
--- a/gcc/ada/exp_ch6.adb
+++ b/gcc/ada/exp_ch6.adb
@@ -10558,8 +10558,9 @@ package body Exp_Ch6 is
begin
pragma Assert (Check_BIP_Actuals (Call_Node, Subp));
- -- Build-in-place function calls return their result by
- -- reference.
+
+ -- Build-in-place function calls return their result by
+ -- reference.
pragma Assert (not Is_Build_In_Place_Function (Subp)
or else Returns_By_Ref (Subp));
diff --git a/gcc/ada/sem_ch13.adb b/gcc/ada/sem_ch13.adb
index 46eb08e38f1..98c3335e593 100644
--- a/gcc/ada/sem_ch13.adb
+++ b/gcc/ada/sem_ch13.adb
@@ -2167,12 +2167,10 @@ package body Sem_Ch13 is
Pragma_Name : Name_Id) return Node_Id;
-- This is a wrapper for Make_Pragma used for converting aspects
-- to pragmas. It takes care of Sloc (set from Loc) and building
- -- the pragma identifier from the given name. In addition the flag
- -- Class_Present is set from the aspect node, as well as
- -- Is_Ignored. This routine also sets the
- -- From_Aspect_Specification in the resulting pragma node to True,
- -- and sets Corresponding_Aspect to point to the aspect. The
- -- resulting pragma is assigned to Aitem.
+ -- the pragma identifier from the given name. In addition
+ -- Class_Present and Is_Ignored are set from the aspect node.
+ -- This routine also sets From_Aspect_Specification to True,
+ -- and sets Corresponding_Aspect to point to the aspect.
-------------------------------
-- Analyze_Aspect_Convention --
@@ -4814,12 +4812,10 @@ package body Sem_Ch13 is
when Aspect_Annotate | Aspect_GNAT_Annotate =>
declare
- Args : List_Id;
- Pargs : List_Id;
- Arg : Node_Id;
-
+ Pargs : constant List_Id := New_List; -- pragma args
begin
- -- The argument can be a single identifier
+ -- The argument can be a single identifier; add it to
+ -- Pargs.
if Nkind (Expr) = N_Identifier then
@@ -4831,11 +4827,12 @@ package body Sem_Ch13 is
Set_Paren_Count (Expr, 0);
- -- Add the single item to the list
+ Append_To (Pargs,
+ Make_Pragma_Argument_Association (Sloc (Expr),
+ Expression => Relocate_Node (Expr)));
- Args := New_List (Expr);
-
- -- Otherwise we must have an aggregate
+ -- Otherwise we must have an aggregate; add all
+ -- expressions to Pargs.
elsif Nkind (Expr) = N_Aggregate then
@@ -4854,9 +4851,16 @@ package body Sem_Ch13 is
("redundant parentheses", Expr);
end if;
- -- List of arguments is list of aggregate expressions
-
- Args := Expressions (Expr);
+ declare
+ Arg : Node_Id := First (Expressions (Expr));
+ begin
+ while Present (Arg) loop
+ Append_To (Pargs,
+ Make_Pragma_Argument_Association (Sloc (Arg),
+ Expression => Relocate_Node (Arg)));
+ Next (Arg);
+ end loop;
+ end;
-- Anything else is illegal
@@ -4865,17 +4869,6 @@ package body Sem_Ch13 is
goto Continue;
end if;
- -- Prepare pragma arguments
-
- Pargs := New_List;
- Arg := First (Args);
- while Present (Arg) loop
- Append_To (Pargs,
- Make_Pragma_Argument_Association (Sloc (Arg),
- Expression => Relocate_Node (Arg)));
- Next (Arg);
- end loop;
-
Append_To (Pargs,
Make_Pragma_Argument_Association (Sloc (Ent),
Chars => Name_Entity,
diff --git a/gcc/ada/vast.adb b/gcc/ada/vast.adb
index e085e1251de..429eeaf8c29 100644
--- a/gcc/ada/vast.adb
+++ b/gcc/ada/vast.adb
@@ -88,7 +88,7 @@ package body VAST is
Check_Error_Nodes => Enabled,
Check_FE_Only => Disabled,
Check_Sharing => Disabled,
- Check_Parent_Present => Disabled,
+ Check_Parent_Present => Enabled,
Check_Parent_Correct => Disabled,
Check_Scope_Present => Print_And_Continue,
Check_Scope_Correct => Print_And_Continue);
--
2.51.0
