1! { dg-do run }
2!
3! Check that pointer assignments allowed by F2003:C717
4! work and check null initialization of CLASS(*) pointers.
5!
6! Contributed by Tobias Burnus <burnus@gcc.gnu.org>
7!
8program main
9  interface
10    subroutine foo(z)
11      class(*), pointer, intent(in) :: z
12    end subroutine foo
13  end interface
14  type sq
15    sequence
16    integer :: i
17  end type sq
18  type(sq), target :: x
19  class(*), pointer :: y, z
20  x%i = 42
21  y => x
22  z => y ! unlimited => unlimited allowed
23  call foo (z)
24  call bar
25contains
26  subroutine bar
27    type t
28    end type t
29    type(t), pointer :: x
30    class(*), pointer :: ptr1 => null() ! pointer initialization
31    if (same_type_as (ptr1, x) .neqv. .FALSE.) call abort
32  end subroutine bar
33
34end program main
35
36
37subroutine foo(tgt)
38  use iso_c_binding
39  class(*), pointer, intent(in) :: tgt
40  type, bind(c) :: s
41    integer (c_int) :: k
42  end type s
43  type t
44    sequence
45    integer :: k
46  end type t
47  type(s), pointer :: ptr1
48  type(t), pointer :: ptr2
49  ptr1 => tgt ! bind(c) => unlimited allowed
50  if (ptr1%k .ne. 42) call abort
51  ptr2 => tgt ! sequence type => unlimited allowed
52  if (ptr2%k .ne. 42) call abort
53end subroutine foo
54