]> git.ipfire.org Git - thirdparty/gcc.git/commitdiff
ada: VAST Check_Corresponding_Aspect
authorBob Duff <duff@adacore.com>
Tue, 17 Feb 2026 02:54:51 +0000 (21:54 -0500)
committerMarc Poulhiès <dkm@gcc.gnu.org>
Thu, 28 May 2026 08:52:44 +0000 (10:52 +0200)
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.

gcc/ada/vast.adb

index 5570e123fe0acf26b4fc6ef084bb1185ff10420f..31356a991e03926ef94706241dc888447f801614 100644 (file)
@@ -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 :=