An error occurring in a subexpression that is part of some construct in
general suppresses the reporting of further errors on the same construct,
to avoid noisy cascaded messages. This patch ensures that this is also
the case when named associations are present.
The following test case must be rejected with the indicated errors only
(note no additional message in the case where a named discriminant
association is used).
$ gcc -c bogus_constraint.ads
bogus_constraint.ads:9:21: "Cst1" is not visible
bogus_constraint.ads:9:21: non-visible declaration at line 3
bogus_constraint.ads:10:30: "Cst2" is not visible
bogus_constraint.ads:10:30: non-visible declaration at line 4
package Bogus_Constraint is
package P is
Cst1 : constant Integer := 1;
Cst2 : constant Integer := 2;
end P;
type R (Start, Endx : Integer) is null record;
subtype R1 is R (Cst1);
subtype R2 is R (Start => Cst2);
end Bogus_Constraint;
Tested on x86_64-pc-linux-gnu, committed on trunk
2014-07-29 Thomas Quinot <qui...@adacore.com>
* errout.adb (Set_Error_Posted): When propagating flag to
an enclosing named association, also propagate to the parent
of that node, so that named and positional associations are
treated consistently.
Index: errout.adb
===================================================================
--- errout.adb (revision 213154)
+++ errout.adb (working copy)
@@ -156,11 +156,12 @@
-- variables Msg_Buffer are set on return Msglen.
procedure Set_Posted (N : Node_Id);
- -- Sets the Error_Posted flag on the given node, and all its parents
- -- that are subexpressions and then on the parent non-subexpression
- -- construct that contains the original expression (this reduces the
- -- number of cascaded messages). Note that this call only has an effect
- -- for a serious error. For a non-serious error, it has no effect.
+ -- Sets the Error_Posted flag on the given node, and all its parents that
+ -- are subexpressions and then on the parent non-subexpression construct
+ -- that contains the original expression. If that parent is a named
+ -- association, the flag is further propagated to its parent. This is done
+ -- in order to guard against cascaded errors. Note that this call has an
+ -- effect for a serious error only.
procedure Set_Qualification (N : Nat; E : Entity_Id);
-- Outputs up to N levels of qualification for the given entity. For
@@ -3007,6 +3008,16 @@
exit when Nkind (P) not in N_Subexpr;
end loop;
+ if Nkind_In (P,
+ N_Pragma_Argument_Association,
+ N_Component_Association,
+ N_Discriminant_Association,
+ N_Generic_Association,
+ N_Parameter_Association)
+ then
+ Set_Error_Posted (Parent (P));
+ end if;
+
-- A special check, if we just posted an error on an attribute
-- definition clause, then also set the entity involved as posted.
-- For example, this stops complaining about the alignment after
