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:
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);
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;
-------------
-- 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 :=