gcc/testsuite/gnat.dg/stack_check2.adb

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