[Ada] Secondary stack leak due to controlled component

Message ID 20180111090834.GA103210@adacore.com
State New
Headers show
  • [Ada] Secondary stack leak due to controlled component
Related show

Commit Message

Pierre-Marie de Rodat Jan. 11, 2018, 9:08 a.m.
This pach modifies the expansion related to initialization calls and secondary
stack usage to inspec the components of a type derived from Limited_Controlled
or Controlled. Previously controlled types were treated as never utilizing the
secondary stack, however this is not true because a controlled type may contain
a component initialized by a function which returns on the secondary stack.

-- Source --

--  pack1.ads

with Ada.Finalization; use Ada.Finalization;

package Pack1 is
   type Ctrl is new Controlled with record
      Comp : Integer;
   end record;

   function Make_Ctrl return Ctrl;
end Pack1;

--  pack1.adb

package body Pack1 is
   Empty : constant Ctrl := (Controlled with Comp => 123);

   function Make_Ctrl return Ctrl is
      return Empty;
   end Make_Ctrl;
end Pack1;

--  pack2.ads

with Ada.Finalization; use Ada.Finalization;
with Pack1;            use Pack1;

package Pack2 is
   type Ctrl_Wrap is new Controlled with record
      Comp : Ctrl := Make_Ctrl;
   end record;
end Pack2;

--  main.adb

with Pack2; use Pack2;

procedure Main is
   procedure Make_Ctrl_Wrap is
      Obj : Ctrl_Wrap;
      pragma Warnings (Off, Obj);
   begin null; end Make_Ctrl_Wrap;

   for Iter in 1 .. 10_000 loop
   end loop;
end Main;

-- Compilation and output --

$ gnatmake -q main.adb
$ valgrind ./main >& valgrind.log
$ grep -c "still reachable" valgrind.log

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

2018-01-11  Hristian Kirtchev  <kirtchev@adacore.com>


	* sem_res.adb (Uses_SS): A controlled type requires the secondary stack
	if it contains at least one component declaration employing a function
	call returning on the secondary stack.


--- gcc/ada/sem_res.adb
+++ gcc/ada/sem_res.adb
@@ -889,10 +889,7 @@  package body Sem_Res is
             Full_Type := T;
          end if;
-         if Is_Controlled (Full_Type) then
-            return False;
-         elsif Is_Array_Type (Full_Type) then
+         if Is_Array_Type (Full_Type) then
             return Uses_SS (Component_Type (Full_Type));
          elsif Is_Record_Type (Full_Type) then