+2019-12-13 Justin Squirek <squirek@adacore.com>
+
+ * sem_ch6.adb (Check_Overriding_Indicator): Modify condition to
+ take into account the modification of the Is_Hidden flag within
+ generic instances.
+ (Verify_Overriding_Indicator): Add an exception for controlled
+ primitives within an instance.
+
2019-12-13 Ed Schonberg <schonberg@adacore.com>
* sinfo.ads, sinfo.adb (Aspect_On_Partial_View,
then
null;
- elsif not Present (Overridden_Operation (Spec_Id)) then
+ -- Overridden controlled primitives may have had their
+ -- Overridden_Operation field cleared according to the setting of
+ -- the Is_Hidden flag. An issue arises, however, when analyzing
+ -- an instance that may have manipulated the flag during
+ -- expansion. As a result, we add an exception for this case.
+
+ elsif not Present (Overridden_Operation (Spec_Id))
+ and then not (Nam_In (Chars (Spec_Id), Name_Adjust,
+ Name_Finalize,
+ Name_Initialize)
+ and then In_Instance)
+ then
Error_Msg_NE
("subprogram& is not overriding", Body_Spec, Spec_Id);
-- If there is an overridden subprogram, then check that there is no
-- "not overriding" indicator, and mark the subprogram as overriding.
+
-- This is not done if the overridden subprogram is marked as hidden,
-- which can occur for the case of inherited controlled operations
-- (see Derive_Subprogram), unless the inherited subprogram's parent
- -- subprogram is not itself hidden. (Note: This condition could probably
- -- be simplified, leaving out the testing for the specific controlled
- -- cases, but it seems safer and clearer this way, and echoes similar
- -- special-case tests of this kind in other places.)
+ -- subprogram is not itself hidden or we are within a generic instance,
+ -- in which case the hidden flag may have been modified for the
+ -- expansion of the instance.
+
+ -- (Note: This condition could probably be simplified, leaving out the
+ -- testing for the specific controlled cases, but it seems safer and
+ -- clearer this way, and echoes similar special-case tests of this
+ -- kind in other places.)
if Present (Overridden_Subp)
and then (not Is_Hidden (Overridden_Subp)
Name_Adjust,
Name_Finalize)
and then Present (Alias (Overridden_Subp))
- and then not Is_Hidden (Alias (Overridden_Subp))))
+ and then (not Is_Hidden (Alias (Overridden_Subp))
+ or else In_Instance)))
then
if Must_Not_Override (Spec) then
Error_Msg_Sloc := Sloc (Overridden_Subp);