[Ada] fix bugs in handling of interface

[Arnaud Charlet <charlet at adacore dot com>]

Tested on i686-linux, committed on trunk

The frontend did not handle well interface subtypes. After this patch
gnat.dg/interface3.adb compiles and executes without errors.

Also call Adjust for initialized allocators of limited types that are not
inherently limited. Such an allocator is illegal, but is generated by the
expander for a return statement, to copy the result onto the secondary stack.

The following program should print "Adjust called." in Ada 95 mode,
and is illegal in Ada 2005 mode.

with Ada.Finalization; use Ada.Finalization;
package Pack is
   type T is limited private;
private
   type T is new Controlled with null record;
   procedure Adjust (X : in out T);
end Pack;

with Text_IO; use Text_IO;
package body Pack is
   procedure Adjust (X : in out T) is
   begin
      Put_Line ("Adjust called.");
   end Adjust;
end Pack;

with Pack;
procedure Main is
   Global : Pack.T;
   function F return Pack.T is
   begin
      return Global;
   end F;
   F_Result: Pack.T renames F;
begin
   null;
end Main;

This patch avoids spurious errors associated with allocated objects
that are initialized in place. After applied, the following test compiles
without errors:
--
with Ada.Finalization;
package P2 is
   type T2 is
      abstract new Ada.Finalization.Limited_Controlled with null record;
   function Create (Args : not null access Integer) return T2 is abstract;
end P2;
--
with P2; use P2;
package P3 is
   type T3 is new T2 with null record;
   function Create (Args : not null access Integer) return T3;
end P3;
--
package body P3 is
   function Create (Args : not null access Integer) return T3 is
      Result : T3;
   begin
      return Result;
   end Create;
end P3;
--
with P2;
package Factory is
   function Create return access P2.T2'Class;
end Factory;
--
with P3;
with Ada.Tags.Generic_Dispatching_Constructor;
package body Factory is
   function Dispatching_Create is
     new Ada.Tags.Generic_Dispatching_Constructor
           (P2.T2, Integer, P2.Create);
--
   function Create return access P2.T2'Class is
      Arg : aliased Integer;
   begin
      return new P2.T2'Class'(Dispatching_Create (P3.T3'Tag, Arg'Access));
   end Create;
end Factory;
--
Command: gcc -c -gnat05 factory.adb

Finally, add missing code to support the allocation of a class-wide interface
object initialized with a qualified expression.

2007-06-06  Javier Miranda  <miranda@adacore.com>
	    Hristian Kirtchev  <kirtchev@adacore.com>
	    Bob Duff  <duff@adacore.com>

	* exp_ch4.adb (Complete_Coextension_Finalization): Add machinery to
	handle the creation of finalization lists and calls for nested
	coextensions when the root of the chains is part of a return statement.
	(Inside_A_Return_Statement): New function inside Complete_Coextension_
	Finalization.
	(Expand_Record_Equality): Skip components that are interface types.
	(Displace_Allocator_Pointer): Add missing support for interface subtypes
	(Expand_N_Allocator): Replace invocation of Is_Local_Access_Discriminant
	with Rewrite_Coextension. Change the condition for detecting coextension
	root nodes.
	(Is_Local_Access_Discriminant): Removed.
	(Rewrite_Coextension): New routine which rewrites a static coextension
	as a temporary and uses its unrestricted access in the construction of
	the outer object.
	(Complete_Coextension_Finalization): New routine. Generate finalization
	attachment calls to all delayed coextensions.
	(Expand_N_Allocator): Call Complete_Coextension_Finalization whenever
	the allocator is not a coextension itself and has delayed coextensions.
	If the current allocator is controlled, but also a coextension, delay
	the generation of the finalization attachment call.
	Rename local variable "Node" to "Nod" in order to avoid confusion with
	"Elists.Node".
	(Expand_Allocator_Expression): Call Adjust for initialized allocators of
	limited types that are not inherently limited. Such an allocator is
	illegal, but is generated by the expander for a return statement, to
	copy the result onto the secondary stack. This is the only case where a
	limited object can be copied. Generate code to displace the pointer
	to the object if the qualified expression is a class-wide interface
	object. Such displacement was missing and hence the copy of the object
	was wrong.
	(Apply_Accessibility_Check): Handle allocated objects initialized in
	place.
	(Displace_Allocator_Pointer): Subsidiary procedure to Expand_N_Allocator
	and Expand_Allocator_Expression. Allocating class-wide interface objects
	this routine displaces the pointer to the allocated object to reference
	the component referencing the corresponding secondary dispatch table.
	Expand_Allocator_Expression): Add missing support to allocate class-wide
	interface objects initialized with a qualified expression.
	(Get_Allocator_Final_List): Test for an anonymous access type that is a
	function result type, and use the finalization list associated with the
	function scope in that case (such an anonymous type should not be
	treated like an access parameter's type).

Attachment: difs
Description: Text document