This is the mail archive of the 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
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;
  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
    Gp.Dispatch_To := Dispatch_To;
  end Open;

  procedure Send (Message : Message_Type) is
    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
    accept Start;
    while Running loop
        accept Dispatch (Deliver : Integer) do
          Ada.Text_Io.Put_Line ("The integer:" & Integer'Image (Deliver));
        end Dispatch;
      end select;
    end loop;
  end Main_T;

  procedure Start is
    Running := True;
    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  <>

	* 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]