1--  { dg-do run }
2--  { dg-options "-gnatws" }
3
4with Ada.Strings.Unbounded;  use Ada.Strings.Unbounded;
5with Ada.Text_IO;            use Ada.Text_IO;
6with System.Parameters;      use System.Parameters;
7with System.Secondary_Stack; use System.Secondary_Stack;
8
9procedure 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
84begin
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;
90end Sec_Stack2;
91