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] Allocation of controlled private type with unknown discriminants


This patch ensures that the finalization machinery properly locates primitive
Finalize_Address when the designated type is private, has unknown discriminants
and is controlled.

------------
-- Source --
------------

--  types.ads

with Ada.Finalization; use Ada.Finalization;
package Types is
   type Root is abstract new Controlled with private;
   overriding procedure Finalize (Obj : in out Root);
   type Child (<>) is new Root with private;
   type Child_Ptr is access all Child;
   function Make_Child return Child_Ptr;
private
   type Root is abstract new Controlled with record
      Id : Natural := 123;
   end record;
   type Child (Discr : Natural) is new Root with null record;
end Types;

--  types.adb

with Ada.Text_IO; use Ada.Text_IO;
package body Types is
   overriding procedure Finalize (Obj : in out Root) is
   begin
      Put_Line (Obj.Id'Img);
   end Finalize;
   function Make_Child return Child_Ptr is
   begin
      return new Child'(Root with Discr => 456);
   end Make_Child;
end Types;

-- main.adb

with Types; use Types;
procedure Main is
   Obj : Child_Ptr := Make_Child;
begin
   null;
end Main;

----------------------------
-- Compilation and output --
----------------------------

$ gnatmake -q -gnat05 main.adb
$ ./main
$  123

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

2012-02-17  Hristian Kirtchev  <kirtchev@adacore.com>

	* exp_util.adb (Find_Finalize_Address): When dealing with an
	internally built full view for a type with unknown discriminants,
	use the original record type.

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]