gcc/testsuite/gnat.dg/boolean_conv.adb

   1 -- { dg-do run }
   2
   3 with System; use System;
   4
   5 procedure Boolean_Conv is
   6   subtype B1 is Boolean;
   7   subtype B2 is Boolean;
   8   A0, A1, A2 : Address;
   9
  10   B : aliased B1;
  11
  12   procedure P2 (X2 : access B2) is
  13   begin
  14      A2 := X2.all'Address;
  15   end P2;
  16
  17   procedure P1 (X1 : access B1) is
  18   begin
  19      A1 := X1.all'Address;
  20      P2 (B2 (X1.all)'Unrestricted_Access);
  21   end P1;
  22
  23 begin
  24    A0 := B'Address;
  25    P1 (B'Access);
  26
  27    if A1 /= A0 then
  28       raise Program_Error;
  29    end if;
  30
  31    if A2 /= A0 then
  32       raise Program_Error;
  33    end if;
  34 end;