gcc/testsuite/gnat.dg/stack_check1.adb

   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
   9 procedure 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
  37 begin
  38   null;
  39 end;