gcc/testsuite/gnat.dg/test_prio.adb

   1 -- { dg-do run }
   2 -- { dg-options "-gnatws" }
   3
   4 pragma Locking_Policy (Ceiling_Locking);
   5 with test_prio_p;use test_prio_p;
   6 with text_io; use text_io;
   7 procedure Test_Prio is
   8    task Tsk is
   9       pragma Priority (10);
  10    end Tsk;
  11    task body Tsk is
  12    begin
  13       Sema2.Seize;
  14       Sema1.Seize;
  15       Put_Line ("error");
  16    exception
  17       when Program_Error => null;  -- OK
  18    end;
  19 begin
  20    null;
  21 end;