blob: 05a4b3f54ec801d518ccab54c225fe6d19e0c701 (
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
40
41
42
43
44
45
46
47
48
49
50
51
52
53
|
! { dg-do run }
!
! Check that pointer assignments allowed by F2003:C717
! work and check null initialization of CLASS(*) pointers.
!
! Contributed by Tobias Burnus <burnus@gcc.gnu.org>
!
program main
interface
subroutine foo(z)
class(*), pointer, intent(in) :: z
end subroutine foo
end interface
type sq
sequence
integer :: i
end type sq
type(sq), target :: x
class(*), pointer :: y, z
x%i = 42
y => x
z => y ! unlimited => unlimited allowed
call foo (z)
call bar
contains
subroutine bar
type t
end type t
type(t), pointer :: x
class(*), pointer :: ptr1 => null() ! pointer initialization
if (same_type_as (ptr1, x) .neqv. .FALSE.) call abort
end subroutine bar
end program main
subroutine foo(tgt)
use iso_c_binding
class(*), pointer, intent(in) :: tgt
type, bind(c) :: s
integer (c_int) :: k
end type s
type t
sequence
integer :: k
end type t
type(s), pointer :: ptr1
type(t), pointer :: ptr2
ptr1 => tgt ! bind(c) => unlimited allowed
if (ptr1%k .ne. 42) call abort
ptr2 => tgt ! sequence type => unlimited allowed
if (ptr2%k .ne. 42) call abort
end subroutine foo
|
