47 lines
1.2 KiB
Ada
47 lines
1.2 KiB
Ada
-- { 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;
|