https://gcc.gnu.org/g:81ba15c03e43a5fa5c1d63d351672a310b43aef7
commit r17-853-g81ba15c03e43a5fa5c1d63d351672a310b43aef7 Author: Bob Duff <[email protected]> Date: Mon Feb 16 21:54:51 2026 -0500 ada: VAST Check_Corresponding_Aspect Add Check_Corresponding_Aspect to VAST. Improve comments. gcc/ada/ChangeLog: * vast.adb (Check_Corresponding_Aspect): New checks for aspect/pragma consistency. (Check_Enum): Add documentation of the checks. Diff: --- gcc/ada/vast.adb | 56 ++++++++++++++++++++++++++++++++++++++++++++++++++++---- 1 file changed, 52 insertions(+), 4 deletions(-) diff --git a/gcc/ada/vast.adb b/gcc/ada/vast.adb index 5570e123fe0a..31356a991e03 100644 --- a/gcc/ada/vast.adb +++ b/gcc/ada/vast.adb @@ -67,15 +67,35 @@ package body VAST is type Check_Enum is (Check_Other, + -- Checks other than listed below. These should all pass. Check_Sloc, + -- Check that nodes have a Sloc. Check_Analyzed, + -- Check that the Analyzed flag is True for all nodes. Check_Error_Nodes, + -- Check that there are no Error nodes in the tree. Check_FE_Only, + -- Check that front-end-only nodes (i.e. nodes that should not be passed + -- to the back end) are not present. Check_Sharing, + -- Check that the tree is treeish; a node cannot be a subtree of two or + -- more parents. This one is hopeless. Check_Parent_Present, + -- Check that each node has a non-Empty Parent field. Check_Parent_Correct, + -- Check that the Parent points to the right node (the one we came from + -- in the tree walk). Note that Parents cannot be correct if there is + -- sharing; Parent can't point to more than one node. Check_Scope_Present, - Check_Scope_Correct); + -- Check that each Entity has a non-Empty Scope field. + Check_Scope_Correct, + -- Check that each Entity has a correct Scope field. + Check_Corresponding_Aspect); + -- Check that the Corresponding_Aspect and related fields are correct. + -- Currently, only pragmas have Corresponding_Aspect, but we should + -- probably add it to attribute definition clauses. Then we could + -- get rid of From_Aspect_Specification, which should always equal + -- Present(Corresponding_Aspect(...)). type Check_Status is -- Action in case of check failure: @@ -95,7 +115,8 @@ package body VAST is Check_Parent_Present => Enabled, Check_Parent_Correct => Disabled, Check_Scope_Present => Print_And_Continue, - Check_Scope_Correct => Print_And_Continue); + Check_Scope_Correct => Print_And_Continue, + Check_Corresponding_Aspect => Print_And_Continue); -- others => Print_And_Continue); -- others => Enabled); -- others => Disabled); @@ -605,6 +626,32 @@ package body VAST is Assert (Parent (N) = Ancestor_Node (1), Check_Parent_Correct); end if; end case; + + -- Check that From_Aspect_Specification, Corresponding_Aspect, and + -- Aspect_Rep_Item are consistent with one another. + + if Nkind (N) in N_Aspect_Specification then + if Present (Aspect_Rep_Item (N)) then + Assert (Nkind (Aspect_Rep_Item (N)) in + N_Pragma | N_Attribute_Definition_Clause, + Check_Corresponding_Aspect); + Assert (From_Aspect_Specification (Aspect_Rep_Item (N)), + Check_Corresponding_Aspect); + Assert (Corresponding_Aspect (Aspect_Rep_Item (N)) = N, + Check_Corresponding_Aspect); + end if; + end if; + + if Nkind (N) in N_Pragma | N_Attribute_Definition_Clause then + Assert + (From_Aspect_Specification (N) = Present (Corresponding_Aspect (N)), + Check_Corresponding_Aspect); + if From_Aspect_Specification (N) then + Assert + (Aspect_Rep_Item (Corresponding_Aspect (N)) = N, + Check_Corresponding_Aspect); + end if; + end if; end Do_Node_Pass_2; ------------- @@ -655,8 +702,9 @@ package body VAST is -- subtrees get placed inside the pragmas without removing -- them from the original aspect specifications. - if Pass = 2 and then Nodes_Info (N).Count > 1 and then - not Nodes_Info (N).In_Aspect -- ????cuts failures by 1.9 + if Pass = 2 and then Nodes_Info (N).Count > 1 + and then not Nodes_Info (N).In_Aspect + -- Ignoring In_Aspect cases cuts failures by a factor of 1.9 then declare Count : constant String :=
