[Ada] Adjust on limited controlled types

[Ada] Adjust on limited controlled types

[Arnaud Charlet]

[-- Attachment #1: Type: text/plain, Size: 989 bytes --]

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  <schonberg@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.


[-- Attachment #2: difs --]
[-- Type: text/plain, Size: 1135 bytes --]

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;