gcc/testsuite/gnat.dg/access8.adb

   1 --  { dg-do run }
   2 --  { dg-options "-gnatws" }
   3
   4 with Access8_Pkg;
   5 procedure Access8 is
   6    Errors : Natural := 0;
   7    outer_object_accessibility_check
   8      : access Access8_Pkg.object;
   9    outer_discriminant_accessibility_check
  10      : access Access8_Pkg.discriminant;
  11    Mistake
  12      : access Access8_Pkg.discriminant;
  13    outer_discriminant_copy_discriminant_check
  14      : access Access8_Pkg.discriminant;
  15 begin
  16    declare
  17       obj
  18         : aliased Access8_Pkg.object := Access8_Pkg.get;
  19       inner_object
  20         : access Access8_Pkg.object := obj'Access;
  21       inner_discriminant
  22         : access Access8_Pkg.discriminant := obj.d;
  23    begin
  24       begin
  25          outer_object_accessibility_check
  26            := inner_object;        --  ERROR
  27       exception
  28          when others => Errors := Errors + 1;
  29       end;
  30       begin
  31          Mistake
  32            := inner_object.d;      --  ERROR
  33       exception
  34          when others => Errors := Errors + 1;
  35       end;
  36       begin
  37          outer_discriminant_copy_discriminant_check
  38            := inner_discriminant;  --  ERROR
  39       exception
  40         when others => Errors := Errors + 1;
  41       end;
  42       if Errors /= 3 then
  43          raise Program_Error;
  44       end if;
  45    end;
  46 end;