gcc/testsuite/gnat.dg/sec_stack2.adb

   1 --  { dg-do run }
   2 --  { dg-options "-gnatws" }
   3
   4 with Ada.Strings.Unbounded;  use Ada.Strings.Unbounded;
   5 with Ada.Text_IO;            use Ada.Text_IO;
   6 with System.Parameters;      use System.Parameters;
   7 with System.Secondary_Stack; use System.Secondary_Stack;
   8
   9 procedure Sec_Stack2 is
  10    procedure Overflow_SS_Index;
  11    --  Create a scenario where the frame index of the secondary stack overflows
  12    --  while the stack itself uses little memory.
  13
  14    -----------------------
  15    -- Overflow_SS_Index --
  16    -----------------------
  17
  18    procedure Overflow_SS_Index is
  19       Max_Iterations : constant := 20_000;
  20       --  The approximate number of iterations needed to overflow the frame
  21       --  index type on a 64bit target.
  22
  23       Algn : constant Positive := Positive (Standard'Maximum_Alignment);
  24       --  The maximum alignment of the target
  25
  26       Size : constant Positive := Positive (Runtime_Default_Sec_Stack_Size);
  27       --  The default size of the secondary stack on the target
  28
  29       Base_Str : constant String (1 .. Size) := (others => 'a');
  30       --  A string big enough to fill the static frame of the secondary stack
  31
  32       Small_Str : constant String (1 .. Algn) := (others => 'a');
  33       --  A string small enough to cause a new round up to the nearest multiple
  34       --  of the maximum alignment on the target at each new iteration of the
  35       --  loop.
  36
  37       Base_US : Unbounded_String := To_Unbounded_String (Base_Str);
  38       --  Unbounded version of the base string
  39
  40       procedure SS_Print is new SS_Info (Put_Line);
  41
  42    begin
  43       for Iteration in 1 .. Max_Iterations loop
  44
  45           --  Grow the base string by a small amount at each iteration of the
  46           --  loop.
  47
  48           Append (Base_US, Small_Str);
  49
  50           --  Convert the unbounded base into a new base. This causes routine
  51           --  To_String to allocates the new base on the secondary stack. Since
  52           --  the new base is slignly bigger than the previous base, the stack
  53           --  would have to create a new frame.
  54
  55           --  Due to an issue with frame reclamation, the last frame (which is
  56           --  also not big enough to fit the new base) is never reclaimed. This
  57           --  causes the range of the new frame to shift toward the overflow
  58           --  point of the frame index type.
  59
  60           begin
  61              declare
  62                 New_Base_Str : constant String := To_String (Base_US);
  63              begin null; end;
  64
  65           exception
  66              when Storage_Error =>
  67                 Put_Line ("ERROR: SS depleted");
  68                 Put_Line ("Iteration:" & Iteration'Img);
  69                 Put_Line ("SS_Size  :" & Size'Img);
  70                 Put_Line ("SS_Algn  :" & Algn'Img);
  71
  72                 SS_Print;
  73                 exit;
  74
  75              when others =>
  76                 Put_Line ("ERROR: unexpected exception");
  77                 exit;
  78           end;
  79       end loop;
  80    end Overflow_SS_Index;
  81
  82 --  Start of processing for SS_Depletion
  83
  84 begin
  85    --  This issue manifests only on targets with a dynamic secondary stack
  86
  87    if Sec_Stack_Dynamic then
  88       Overflow_SS_Index;
  89    end if;
  90 end Sec_Stack2;