view gcc/testsuite/gnat.dg/access8.adb @ 158:494b0b89df80 default tip

...
author Shinji KONO <kono@ie.u-ryukyu.ac.jp>
date Mon, 25 May 2020 18:13:55 +0900
parents 1830386684a0
children
line wrap: on
line source

--  { dg-do run }
--  { dg-options "-gnatws" }

with Access8_Pkg;
procedure Access8 is
   Errors : Natural := 0;
   outer_object_accessibility_check
     : access Access8_Pkg.object;
   outer_discriminant_accessibility_check
     : access Access8_Pkg.discriminant;
   Mistake
     : access Access8_Pkg.discriminant;
   outer_discriminant_copy_discriminant_check
     : access Access8_Pkg.discriminant;
begin
   declare
      obj
        : aliased Access8_Pkg.object := Access8_Pkg.get;
      inner_object
        : access Access8_Pkg.object := obj'Access;
      inner_discriminant
        : access Access8_Pkg.discriminant := obj.d;
   begin
      begin
         outer_object_accessibility_check
           := inner_object;        --  ERROR
      exception
         when others => Errors := Errors + 1;
      end;
      begin
         Mistake
           := inner_object.d;      --  ERROR
      exception
         when others => Errors := Errors + 1;
      end;
      begin
         outer_discriminant_copy_discriminant_check
           := inner_discriminant;  --  ERROR
      exception
        when others => Errors := Errors + 1;
      end;
      if Errors /= 3 then
         raise Program_Error;
      end if;
   end;
end;