https://gcc.gnu.org/g:adb8151b26c1b3b9689a81f29a42fcca56fb38d9
commit r16-5655-gadb8151b26c1b3b9689a81f29a42fcca56fb38d9 Author: Bob Duff <[email protected]> Date: Fri Nov 14 16:29:45 2025 -0500 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: --- 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 6bf8d3ba145d..42111a416de2 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 46eb08e38f13..98c3335e593c 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 - - 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 e085e1251de8..429eeaf8c294 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);
