1-- { dg-do run }
2-- { dg-require-stack-check "" }
3-- { dg-options "-fstack-check" }
4
5-- This test requires architecture- and OS-specific support code for unwinding
6-- through signal frames (typically located in *-unwind.h) to pass.  Feel free
7-- to disable it if this code hasn't been implemented yet.
8
9procedure Stack_Check1 is
10
11  type A is Array (1..2048) of Integer;
12
13  procedure Consume_Stack (N : Integer) is
14    My_A : A; -- 8 KB static
15  begin
16    My_A (1) := 0;
17    if N <= 0 then
18      return;
19    end if;
20    Consume_Stack (N-1);
21  end;
22
23  Task T;
24
25  Task body T is
26  begin
27    begin
28      Consume_Stack (Integer'Last);
29      raise Program_Error;
30    exception
31      when Storage_Error => null;
32    end;
33
34    Consume_Stack (128);
35  end;
36
37begin
38  null;
39end;
40