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] The progenitor of a type extension may be a subtype.


A subtype of an interface type can appear as a progenitor in a type extension.
The routine that determines whether a given interface is a progenitor of a
type must take this subtype into account.

Compiling and executing main.adb must yield:

    The integer: 42

---
with Ultimate_User;
procedure Main is
begin
  Ultimate_User.Start;
end Main;
--
package Ultimate_User is
  procedure Start;
end Ultimate_User;
---
with gp;
package user is
  package Implementation is new gp (Message_Type => integer);
  subtype T is Implementation.T;
  subtype Dispatch_To_T is Implementation.Dispatch_To_T;
  procedure Open (Dispatch_To : Dispatch_To_T) renames Implementation.Open;
end user;
---
generic
  type Message_Type is private;
package Gp is
  type T is limited interface;
  procedure Dispatch
      (Dispatch_To : in out T; Message : Message_Type) is abstract;
  type Dispatch_To_T is access all T'Class;
  procedure Open (Dispatch_To : Dispatch_To_T);
  procedure Send (Message : Message_Type);
end Gp;
---
package body Gp is
  Dispatch_To : Dispatch_To_T;

  procedure Open (Dispatch_To : Dispatch_To_T) is
  begin
    Gp.Dispatch_To := Dispatch_To;
  end Open;

  procedure Send (Message : Message_Type) is
  begin
    Dispatch_To.Dispatch (Message);
  end Send;
end Gp;
---
with Ada.Text_Io;
with User;
package body Ultimate_User is
    task type Main_T is new User.T with
    entry Start;
    entry Dispatch (Deliver : Integer);
    pragma Unreferenced (Dispatch);
        -- It is a bit obscure but dispatch is actually called.
  end Main_T;

  Running : Boolean := True;
  pragma Atomic (Running);

  Main : aliased Main_T;

  task body Main_T is
  begin
    accept Start;
    while Running loop
      select
        accept Dispatch (Deliver : Integer) do
          Ada.Text_Io.Put_Line ("The integer:" & Integer'Image (Deliver));
        end Dispatch;
      or
        terminate;
      end select;
    end loop;
  end Main_T;

  procedure Start is
  begin
    Running := True;
    Main.Start;
    User.Open (Main'Access);
    User.Implementation.Send (42);
  end Start;
end Ultimate_User;

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

2013-10-10  Ed Schonberg  <schonberg@adacore.com>

	* sem_type.adb (Interface_Present_In_Ancestor): The progenitor
	in a type declaration may be an interface subtype.

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]