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