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