repo.or.cz
/
official-gcc.git
/
blob
commit
grep
author
committer
pickaxe
?
search:
re
summary
|
log
|
graphiclog1
|
graphiclog2
|
commit
|
commitdiff
|
tree
|
refs
|
edit
|
fork
blame
|
history
|
raw
|
HEAD
2017-07-25 Richard Biener <rguenther@suse.de>
[official-gcc.git]
/
gcc
/
testsuite
/
gnat.dg
/
iprot_test.adb
blob
17c2021557592a7e8df767d2708a3ebc5ef92ad8
1
-- { dg-do run }
2
3
procedure
iprot_test
is
4
type
T1
is tagged null record
;
5
package
PP
is
6
protected type
P
is
7
procedure
S
(
X
:
T1
'Class
);
8
private
9
R2
:
access
T1
'Class
;
10
end
P
;
11
end
PP
;
12
package body
PP
is
13
protected body
P
is
14
procedure
S
(
X
:
T1
'Class
)
is
15
begin
16
R2
:=
new
T1
'Class
'(X);
17
if R2 /= null then
18
null;
19
end if;
20
end S;
21
end P;
22
end PP;
23
use PP;
24
Prot : P;
25
procedure Proc is
26
type T2 is new T1 with null record;
27
X2 : T2;
28
begin
29
Prot.S (X2);
30
end Proc;
31
begin
32
Proc;
33
exception
34
when Program_Error => null;
35
end iprot_test;