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] Initialization of limited objects by a function


This patch corrects two issues associated with limited objects initialized in
extended return statements. The first one is related to finalization of objects
obtained by functions through extended return statements. The second is the
necessity for an interface conversion of such objects when the return type is
an interface class-wide type.

Source:
   with Ada.Text_IO;       use Ada.Text_IO;
   with Ada.Finalization;  use Ada.Finalization;

   procedure Test1 is
      package P is
         type I is limited interface;
         function Name (Object : I) return String is abstract;
      end P;
      use P;

      package Q is
         type T is new Limited_Controlled and I with
      private;
         function Create return T;
         overriding procedure Initialize (Object : in out T);
         overriding procedure Finalize (Object: in out T);
         overriding function  Name (Object : T) return String;
      private
         type T is new Limited_Controlled and I with record
            Name : String (1..3);
         end record;
      end Q;

      package body Q is
         function Create return T is
         begin
            return Object : T do
               Object.Name := "foo";
            end return;
         end Create;
         procedure Initialize (Object : in out T) is
         begin
            Put_Line ("Initialize");
         end Initialize;

         procedure Finalize (Object : in out T) is
         begin
            Put_Line ("Finalize");
         end Finalize;

         function Name (Object : T) return String is
         begin
            return Object.Name;
         end name;
      end Q;

      package Factory is
         function Create return I'Class;
      end Factory;

      package body Factory is
         function Create return I'Class is
         begin
            return Q.Create;
         end;
      end Factory;

      X : I'Class := Factory.Create;

   begin
      Put_Line (X.Name);

   end Test1;

Compilation:
   gnatmake -q -gnat05 test1.adb

Execution and output:
   $ ./test1
   $ Initialize
   $ foo
   $ Finalize

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

2008-08-20  Hristian Kirtchev  <kirtchev@adacore.com>

	* exp_ch5.adb (Controlled_Type): New routine.
	(Expand_N_Extended_Return_Statement): When generating a move of the
	final list in extended return statements, check the type of the
	function and in the case of double expanded return statements, the type
	of the returned object.
	(Expand_Simple_Function_Return): Perform an interface conversion when
	the type of the returned object is an interface and the context is an
	extended return statement.

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]