a GNAT artifact: Limited_Controlled is declared as an extension of Root_
Controlled, and thus has a useless Adjust operation. This operation should not
be inherited by other limited controlled types. An explicit Adjust for them is
not overriding.
gcc -c -gnat05 lib2.ads
must yield
lib2.ads:13:04: subprogram "Adjust" is not overriding
---
private with Ada.Finalization;
package Lib2 is
type Type_A (Value : Integer) is tagged limited private;
private
use Ada.Finalization;
type Type_A (Value : Integer) is new Limited_Controlled with record
Refcount : Natural;
end record;
overriding -- ERROR
procedure Adjust (Object : in out Type_A);
end Lib2;
Tested on x86_64-pc-linux-gnu, committed on trunk
2011-09-02 Ed Schonberg <schonb...@adacore.com>
* sem_ch6.adb (Check_Overriding_Indicator): add special check
to reject an overriding indicator on a user-defined Adjust
subprogram for a limited controlled type.
Index: sem_ch6.adb
===================================================================
--- sem_ch6.adb (revision 178452)
+++ sem_ch6.adb (working copy)
@@ -4956,6 +4956,20 @@
("subprogram & overrides inherited operation #", Spec, Subp);
end if;
+ -- Special-case to fix a GNAT oddity: Limited_Controlled is declared
+ -- as an extension of Root_Controlled, and thus has a useless Adjust
+ -- operation. This operation should not be inherited by other limited
+ -- controlled types. An explicit Adjust for them is not overriding.
+
+ elsif Must_Override (Spec)
+ and then Chars (Overridden_Subp) = Name_Adjust
+ and then Is_Limited_Type (Etype (First_Formal (Subp)))
+ and then Present (Alias (Overridden_Subp))
+ and then Is_Predefined_File_Name
+ (Unit_File_Name (Get_Source_Unit (Alias (Overridden_Subp))))
+ then
+ Error_Msg_NE ("subprogram & is not overriding", Spec, Subp);
+
elsif Is_Subprogram (Subp) then
if Is_Init_Proc (Subp) then
null;
