This is the mail archive of the gcc-patches@gcc.gnu.org mailing list for the GCC project.


Index Nav: [Date Index] [Subject Index] [Author Index] [Thread Index]
Message Nav: [Date Prev] [Date Next] [Thread Prev] [Thread Next]
Other format: [Raw text]

[Ada] Implementation of AI05-0071: class-wide ops for formal subprograms


>From the text of AI05-0071:
   If a generic unit has a subprogram_default specified by a box, and
   the corresponding actual parameter is omitted, then it is equivalent
   to an explicit actual parameter that is a usage name identical to the
   defining name of the formal. {If a subtype_mark in the profile of the
   formal_subprogram_declaration denotes a formal private or formal derived
   type and the actual type for this formal type is a class-wide type
   T'Class, then for the purposes of resolving this default_name at the
   point of the instantiation, for each primitive subprogram of T that has
   a matching defining name, that is directly visible at the point of the
   instantiation, and that has at least one controlling formal parameter,
   a corresponding subprogram with the same defining name is directly
   visible, but with T systematically replaced by T'Class in the types
   of its profile. The body of such a subprogram is as defined in
   12.5.1 for primitive subprograms of a formal type when the actual
   type is class-wide.}

This patch implements this resolution rule by creating the class-wide operation
and its body within an instance that has such a defaulted formal subprogram.

The following commands:

   gnatmake -q class_wide_default
   class_wide_default

must yield:

   Mangle T
   Mangle T1

---
with P1, P2; use P1, P2;
procedure Class_Wide_Default is
   Thing : T;
   Thing1 : T1;
begin
   I.Test (Thing);
   I.Test (Thing1);
end;
---
package P1 is
   type T is tagged null record;
   function Empty return T;
   procedure Mangle (X : T);
end P1;
---
with P1; use P1;
generic
   type NT(<>) is new T with private;
    with procedure Mangle (X : NT) is <>;
package Gen_Pack is
   procedure Test(XX : in out NT);
end Gen_Pack;
---
with Gen_Pack;
with P1; use P1;
package P2 is
   type T1 is new T with null record;
   function Empty return T1;
   procedure Mangle (X : T1);
   package I is new Gen_Pack (T'Class);
end;
---
with Ada.Tags; use Ada.Tags;
with Text_IO; use Text_IO;
package body Gen_Pack is
   procedure Test(XX : in out NT) is
   begin
      Mangle (XX);
   end Test;
end Gen_Pack;
---
with Text_IO; use Text_IO;
package body P1 is
   function Empty return T is
      result : T;
   begin
      return Result;
   end;

   procedure Mangle (X : T) is
   begin
      Put_Line ("Mangle T");
   end;
end P1;
---
with Text_IO; use Text_IO;
package body P2 is
   function Empty return T1 is
      Result : T1;
   begin
      return Result;
   end;

   procedure Mangle (X : T1) is
   begin
      Put_Line ("Mangle T1");
   end;
   procedure Huh (Y : T1'class) is
   begin
      Mangle (Y);
   end;
end;

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

2011-08-02  Ed Schonberg  <schonberg@adacore.com>

	* sem_ch8.adb (Analyze_Subprogram_Renaming): new procedure
	Check_Class_Wide_Actual, to implement AI05-0071, on defaulted
	primitive operations of class-wide actuals.

Attachment: difs
Description: Text document


Index Nav: [Date Index] [Subject Index] [Author Index] [Thread Index]
Message Nav: [Date Prev] [Date Next] [Thread Prev] [Thread Next]