[Ada] Completion of private types with synchronized types

[Arnaud Charlet <charlet at adacore dot com>]

This patch adds code to properly handle any primitives declared between the
private and the full view of a concurrent type that implements an interface.
Such primitives receive wrappers similar to those used for protected procedures
and entries to ensure proper overriding of interface primitives.

Source:
   package Types is
      type Task_Iface is task interface;
      procedure Stop (Obj : in out Task_Iface) is abstract;
      procedure Wink (Obj : in out Task_Iface) is abstract;
      type T is synchronized new Task_Iface with private;
      procedure Prev (Obj : in out T);
      procedure Wink (Obj : in out T);
   private
      task type T is new Task_Iface with
         entry Stop;
      end T;
      procedure Post (Obj : in out T);
   end Types;

   with Ada.Text_IO; use Ada.Text_IO;
   package body Types is
      task body T is
      begin
         accept Stop do
            Put_Line ("Stop");
         end Stop;
      end T;
      procedure Prev (Obj : in out T) is
      begin
         Put_Line ("Prev");
      end Prev;
      procedure Post (Obj : in out T) is
      begin
         Put_Line ("Post");
      end Post;
      procedure Wink (Obj : in out T) is
      begin
         Put_Line ("Wink");
      end Wink;
   end Types;

   with Types; use Types;
   procedure Test1 is
      procedure Dispatch_Wink (Obj : in out Task_Iface'Class);
      procedure Dispatch_Stop (Obj : in out Task_Iface'Class);
      procedure Dispatch_Wink (Obj : in out Task_Iface'Class) is
      begin
         Obj.Wink;
      end Dispatch_Wink;
      procedure Dispatch_Stop (Obj : in out Task_Iface'Class) is
      begin
         Obj.Stop;
      end Dispatch_Stop;
      Obj_T : T;
   begin
      Prev (Obj_T);
      Dispatch_Wink (Obj_T);
      Dispatch_Stop (Obj_T);
   end Test1;

Compilation:
   gnatmake -q -gnat05 test1.adb

Execution and output:
   $ ./test1
   Prev
   Wink
   Stop

Tested on i686-pc-linux-gnu, committed on trunk.

2008-07-30  Hristian Kirtchev  <kirtchev@adacore.com>

	* einfo.adb: Flag245 is now used.
	(Is_Primitive_Wrapper, Set_Is_Primitive_Wrapper): Relax the assertion
	check to include functions.
	(Is_Private_Primitive, Set_Is_Private_Primitive): New subprograms.
	(Wrapped_Entity, Set_Wrapped_Entity): Relax the assertion check to
	include functions.
	(Write_Entity_Flags): Move flag Is_Primitive, add Is_Private_Primitive
	to the list of displayed flags.

	* einfo.ads: Update comment on the usage of Is_Primitive_Wrapper and
	Wrapped_Entity. These two flags are now present in functions.
	New flag Is_Private_Primitive.
	(Is_Private_Primitive, Set_Is_Private_Primitive): New subprograms.

	* exp_ch9.adb:
	(Build_Wrapper_Bodies): New subprogram.
	(Build_Wrapper_Body): The spec and body have been moved to in
	Build_Wrapper_ Bodies. Code cleanup.
	(Build_Wrapper_Spec): Moved to the spec of Exp_Ch9. Code cleanup.
	Wrappers are now generated for primitives declared between the private
	and full view of a concurrent type that implements an interface.
	(Build_Wrapper_Specs): New subprogram.
	(Expand_N_Protected_Body): Code reformatting. Replace the wrapper body
	creation mechanism with a call to Build_Wrapper_Bodies.
	(Expand_N_Protected_Type_Declaration): Code reformatting. Replace the
	wrapper spec creation mechanism with a call to Build_Wrapper_Specs.
	(Expand_N_Task_Body): Replace the wrapper body creation
	mechanism with a call to Build_Wrapper_Bodies.
	(Expand_N_Task_Type_Declaration): Replace the wrapper spec
	creation mechanism with a call to Build_Wrapper_Specs.
	(Is_Private_Primitive_Subprogram): New subprogram.
	(Overriding_Possible): Code cleanup.
	(Replicate_Entry_Formals): Renamed to Replicate_Formals, code cleanup.

	* exp_ch9.ads (Build_Wrapper_Spec): Moved from the body of Exp_Ch9.

	* sem_ch3.adb: Add with and use clause for Exp_Ch9.
	(Process_Full_View): Build wrapper specs for all primitives
	that belong to a private view completed by a concurrent type
	implementing an interface.
	
	* sem_ch6.adb (Analyze_Subprogram_Body): When the current subprogram
	is a primitive of a
	concurrent type with a private view that implements an interface, try to
	find the proper spec.
	(Analyze_Subprogram_Declaration): Mark a subprogram as a private
	primitive if the type of its first parameter is a non-generic tagged
	private type.
	(Analyze_Subprogram_Specification): Code reformatting.
	(Disambiguate_Spec): New routine.
	(Find_Corresponding_Spec): Add a flag to controll the output of errors.
	(Is_Private_Concurrent_Primitive): New routine.

	* sem_ch6.ads:
	(Find_Corresponding_Spec): Add a formal to control the output of errors.

Attachment: difs
Description: Text document