ada: VAST found bug: Missing Parent in annotate aspect

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.

diff --git a/gcc/ada/exp_ch6.adb b/gcc/ada/exp_ch6.adb
index 6bf8d3ba145d6c24fef2e5ba1a2b5b104bb1ebee..42111a416de229095adbee1d3aa68e8b36525d58 100644 (file)
--- 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 46eb08e38f13791d17a48555ea0bec9a5cef34ef..98c3335e593c98cb4812239a82856ed3239967df 100644 (file)
--- 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
-
-                        Args := New_List (Expr);
+                        Append_To (Pargs,
+                          Make_Pragma_Argument_Association (Sloc (Expr),
+                            Expression => Relocate_Node (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 e085e1251de8346c05db5e2101d40459fee94c67..429eeaf8c294ce5935d15f490c0f79517554b9a2 100644 (file)
--- 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);