1--  { dg-do run }
2
3procedure Missing_Acc_Check is
4
5   Test_Failed : Exception;
6
7   type Int_Access is access all Integer;
8
9   Save : Int_Access := null;
10
11   type Int_Rec is record
12      Int : aliased Integer;
13   end record;
14
15   type Ltd_Rec (IR_Acc : access Int_Rec) is limited null record;
16
17   function Pass_Rec (IR_Acc : access Int_Rec) return Int_Access is
18   begin
19      return IR_Acc.Int'Access;  -- Accessibility check here
20   end Pass_Rec;
21
22   procedure Proc is
23      IR : aliased Int_Rec;
24      LR : Ltd_Rec (IR'Access);
25   begin
26      Save := Pass_Rec (LR.IR_Acc);  -- Must raise Program_Error;
27
28      if Save /= null then
29         raise Test_Failed;
30      end if;
31
32   exception
33      when Program_Error =>
34         null;
35   end Proc;
36
37begin
38   Proc;
39end Missing_Acc_Check;
40