1! { dg-do compile }
2!
3! PR 40940: CLASS statement
4!
5! Contributed by Janus Weil <janus@gcc.gnu.org>
6
7use,intrinsic :: iso_c_binding
8
9type t1
10  integer :: comp
11end type
12
13type t2
14  sequence
15  real :: r
16end type
17
18type,bind(c) :: t3
19  integer(c_int) :: i
20end type
21
22type :: t4
23  procedure(absint), pointer :: p  ! { dg-error "Non-polymorphic passed-object dummy argument" }
24end type
25
26type :: t5
27  class(t1) :: c  ! { dg-error "must be allocatable or pointer" }
28end type
29
30abstract interface
31  subroutine absint(arg)
32    import :: t4
33    type(t4) :: arg
34  end subroutine
35end interface
36
37type t6
38  integer :: i
39  class(t6), allocatable :: foo  ! { dg-error "must have the POINTER attribute" }
40end type t6
41
42
43class(t1) :: o1  ! { dg-error "must be dummy, allocatable or pointer" }
44
45class(t2), pointer :: o2  ! { dg-error "is not extensible" }
46class(t3), pointer :: o3  ! { dg-error "is not extensible" }
47
48end
49
50