[Ada] Inherited interface operations hidden by local declaration

[Ada] Inherited interface operations hidden by local declaration

[Arnaud Charlet]

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

When compiling a type extension with progenitors, we create local symbols for
the entries in secondary tables. For each interface primitive we locate the
operation that implements the primitive, or else the inherited abstract
operation that must eventually be overridden. This abstract operation is
normally introduced in the current scope, but it may be hidden because of a
local non-overloadable declaration. This patch adds a search through the
primitive operations of the type extension to locate the desired inherited
interface operation. This prevents crashes on programs where the extension
fails to implement the interface operation.

Compiling crash.adb must yield:

   crash.adb:7:04: interface subprogram "p" must be overridden

---
procedure Crash is
   package P is
      type A_Type is limited interface;
      procedure P (P : in out A_Type) is abstract;
   end P;
   
   protected type B_Type is new P.A_Type with
   end;
 
   protected body B_Type is
   end;
begin
   null;
end Crash;

Tested on x86_64-pc-linux-gnu, committed on trunk

2010-06-22  Ed Schonberg  <schonberg@adacore.com>

	* sem_ch3.adb (Add_Internal_Interface_Entities): If
	Find_Primitive_Covering_Interface does not find the operation, it may
	be because of a name conflict between the inherited operation and a
	local non-overloadable name. In that case look for the operation among
	the primitive operations of the type. This search must succeed
	regardless of visibility.


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

Index: sem_ch3.adb
===================================================================
--- sem_ch3.adb	(revision 161141)
+++ sem_ch3.adb	(working copy)
@@ -1551,7 +1551,34 @@ package body Sem_Ch3 is
                       (Tagged_Type => Tagged_Type,
                        Iface_Prim  => Iface_Prim);
 
-                  pragma Assert (Present (Prim));
+                  if No (Prim) then
+
+                     --  In some are cases, a name conflict may have
+                     --  kept the operation completely hidden. Look for
+                     --  it in the list of primitive operations of the
+                     --  type.
+
+                     declare
+                        El : Elmt_Id :=
+                          First_Elmt (Primitive_Operations (Tagged_Type));
+                     begin
+                        while Present (El) loop
+                           Prim := Node (El);
+                           if Is_Subprogram (Prim)
+                             and then Alias (Prim) = Iface_Prim
+                           then
+                              exit;
+                           end if;
+                           Next_Elmt (El);
+                        end loop;
+                     end;
+                  end if;
+
+                  if No (Prim) then
+                     --  If the operation was not explicitly overridden, it
+                     --  should have been inherited as an abstract operation.
+                     raise Program_Error;
+                  end if;
 
                   Derive_Subprogram
                     (New_Subp     => New_Subp,