Patchwork [Ada] Incorrect finalization of build-in-place function result

login
register
mail settings
Submitter Arnaud Charlet
Date March 30, 2012, 9:29 a.m.
Message ID <20120330092923.GA28008@adacore.com>
Download mbox | patch
Permalink /patch/149597/
State New
Headers show

Comments

Arnaud Charlet - March 30, 2012, 9:29 a.m.
This patch updates the mechanism which detects build-in-place function calls
returning controlled results on the secondary stack.

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

--  types.ads

with Ada.Finalization; use Ada.Finalization;
package Types is
   type Ctrl_Comp is new Limited_Controlled with null record;
   procedure Finalize (Obj : in out Ctrl_Comp);
   type Root is tagged limited null record;
   type Root_Ptr is access all Root'Class;
   function Create (Ctrl : Boolean) return Root'Class;
   type Empty_Child is new Root with null record;
   type Ctrl_Child is new Root with record
      Comp : Ctrl_Comp;
   end record;
end Types;

--  types.adb

with Ada.Text_IO; use Ada.Text_IO;
package body Types is
   function Create (Ctrl : Boolean) return Root'Class is
   begin
      if Ctrl then
         return Result : Ctrl_Child;
      else
         return Result : Empty_Child;
      end if;
   end Create;
   procedure Finalize (Obj : in out Ctrl_Comp) is
   begin
      Put_Line ("  Finalize");
   end Finalize;
end Types;

--  main.adb

with Ada.Text_IO; use Ada.Text_IO;
with Types;       use Types;
procedure Main is
   pragma Suppress (Accessibility_Check);
begin
   Put_Line ("Empty child");
   declare
      Obj : Root_Ptr := new Root'Class'(Create (False));
   begin
      Put_Line ("Empty child allocated");
   end;
   Put_Line ("Ctrl child");
   declare
      Obj : Root_Ptr := new Root'Class'(Create (True));
   begin
      Put_Line ("Ctrl child allocated");
   end;
   Put_Line ("End");
end Main;

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

$ gnatmake -q -gnat05 main.adb
$ ./main
Empty child
Empty child allocated
Ctrl child
Ctrl child allocated
End
  Finalize

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

2012-03-30  Hristian Kirtchev  <kirtchev@adacore.com>

	* exp_util.adb (Is_Secondary_Stack_BIP_Func_Call): Handle a case where
	a build-in-place call appears as Prefix'Reference'Reference.

Patch

Index: exp_util.adb
===================================================================
--- exp_util.adb	(revision 186001)
+++ exp_util.adb	(working copy)
@@ -4889,11 +4889,13 @@ 
       Call : Node_Id := Expr;
 
    begin
-      --  Build-in-place calls usually appear in 'reference format
+      --  Build-in-place calls usually appear in 'reference format. Note that
+      --  the accessibility check machinery may add an extra 'reference due to
+      --  side effect removal.
 
-      if Nkind (Call) = N_Reference then
+      while Nkind (Call) = N_Reference loop
          Call := Prefix (Call);
-      end if;
+      end loop;
 
       if Nkind_In (Call, N_Qualified_Expression,
                          N_Unchecked_Type_Conversion)