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