[Ada] Subprogram renaming and private overriding

Message ID 20101004131723.GA17852@adacore.com
State New
Headers show

Commit Message

Arnaud Charlet Oct. 4, 2010, 1:17 p.m.
If an inherited operation is overridden in the private part, a client only
sees the overridden operation, which may be abstact. A call from a client
will invoke the overridding operation, so this is the one that must be used
in the renaming. Otherwise the compiler with produce a spurious error if the
overridden operation is abstract.

The following must compile quietly:

   gcc -c -gnat05 my_vector.ads

package My_Interface is
   type Instance is interface;
   procedure P (I : in out Instance) is abstract;
end My_Interface;
with My_Interface;
package My_Tagged_Type is
   type Instance is new My_Interface.Instance with private;

   procedure P (TT : in out Instance) is null;
   type Instance is new My_Interface.Instance with null record;
end My_Tagged_Type;
with Ada.Containers.Vectors;
with My_Tagged_Type;
package My_Vector is new Ada.Containers.Vectors
  (Index_Type   => Positive,
   Element_Type => My_Tagged_Type.Instance,
   "="          => My_Tagged_Type."=");

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

2010-10-04  Ed Schonberg  <schonberg@adacore.com>

	* sem_ch8.adb (Analyze_Subprogram_Renaming): If the renamed operation
	is an overridden inherited operation, the desired operation is the
	overriding one, which is the alias of the visible one.


Index: sem_ch8.adb
--- sem_ch8.adb	(revision 164906)
+++ sem_ch8.adb	(working copy)
@@ -2100,6 +2100,21 @@  package body Sem_Ch8 is
       if No (Old_S) then
          Old_S := Find_Renamed_Entity (N, Name (N), New_S, Is_Actual);
+         --  The visible operation may be an inherited abstract operation that
+         --  was overridden in the private part, in which case a call will
+         --  dispatch to the overriding operation. Use the overriding one in
+         --  the renaming declaration, to prevent spurious errors below.
+         if Is_Overloadable (Old_S)
+           and then Is_Abstract_Subprogram (Old_S)
+           and then No (DTC_Entity (Old_S))
+           and then Present (Alias (Old_S))
+           and then not Is_Abstract_Subprogram (Alias (Old_S))
+           and then Is_Overriding_Operation (Alias (Old_S))
+         then
+            Old_S := Alias (Old_S);
+         end if;
          --  When the renamed subprogram is overloaded and used as an actual
          --  of a generic, its entity is set to the first available homonym.
          --  We must first disambiguate the name, then set the proper entity.