gcc/testsuite/gnat.dg/stack_check2.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_Check2 is
  10
  11   function UB return Integer is
  12   begin
  13     return 2048;
  14   end;
  15
  16   type A is Array (Positive range <>) of Integer;
  17
  18   procedure Consume_Stack (N : Integer) is
  19     My_A : A (1..UB); -- 8 KB dynamic
  20   begin
  21     My_A (1) := 0;
  22     if N <= 0 then
  23       return;
  24     end if;
  25     Consume_Stack (N-1);
  26   end;
  27
  28   Task T;
  29
  30   Task body T is
  31   begin
  32     begin
  33       Consume_Stack (Integer'Last);
  34       raise Program_Error;
  35     exception
  36       when Storage_Error => null;
  37     end;
  38
  39     Consume_Stack (128);
  40   end;
  41
  42 begin
  43   null;
  44 end;