gcc/testsuite/gnat.dg/access6.adb

   1 --  { dg-do run }
   2 --  { dg-options "-gnat12" }
   3
   4 procedure Access6 is
   5    type Int_Ref is access all Integer;
   6    Ptr : Int_Ref;
   7
   8    procedure update_ptr (X : access integer) is
   9    begin
  10       --  Failed accessibility test: supposed to raise a Program_Error
  11       Ptr := Int_Ref (X);
  12    end;
  13
  14    procedure bar is
  15       ref : access integer := new integer;
  16    begin
  17       update_ptr (ref);
  18    end;
  19 begin
  20    bar;
  21
  22    --  As the call to bar must raise a Program_Error, the following is not supposed to be executed:
  23    raise Constraint_Error;
  24
  25 exception
  26    when Program_Error =>
  27       null;
  28 end;