1! { dg-do run } 2! { dg-options "-std=f2003 -fall-intrinsics" } 3! Pointer intent test 4! PR fortran/29624 5! 6! Valid program 7program test 8 implicit none 9 type myT 10 integer :: x 11 integer, pointer :: point 12 end type myT 13 integer, pointer :: p 14 type(myT), pointer :: t 15 type(myT) :: t2 16 allocate(p,t) 17 allocate(t%point) 18 t%point = 55 19 p = 33 20 call a(p,t) 21 deallocate(p) 22 nullify(p) 23 call a(p,t) 24 t2%x = 5 25 allocate(t2%point) 26 t2%point = 42 27 call nonpointer(t2) 28 if(t2%point /= 7) call abort() 29contains 30 subroutine a(p,t) 31 integer, pointer,intent(in) :: p 32 type(myT), pointer, intent(in) :: t 33 integer, pointer :: tmp 34 if(.not.associated(p)) return 35 if(p /= 33) call abort() 36 p = 7 37 if (associated(t)) then 38 ! allocating is valid as we don't change the status 39 ! of the pointer "t", only of it's target 40 t%x = -15 41 if(.not.associated(t%point)) call abort() 42 if(t%point /= 55) call abort() 43 nullify(t%point) 44 allocate(tmp) 45 t%point => tmp 46 deallocate(t%point) 47 t%point => null(t%point) 48 tmp => null(tmp) 49 allocate(t%point) 50 t%point = 27 51 if(t%point /= 27) call abort() 52 if(t%x /= -15) call abort() 53 call foo(t) 54 if(t%x /= 32) call abort() 55 if(t%point /= -98) call abort() 56 end if 57 call b(p) 58 if(p /= 5) call abort() 59 end subroutine 60 subroutine b(v) 61 integer, intent(out) :: v 62 v = 5 63 end subroutine b 64 subroutine foo(comp) 65 type(myT), intent(inout) :: comp 66 if(comp%x /= -15) call abort() 67 if(comp%point /= 27) call abort() 68 comp%x = 32 69 comp%point = -98 70 end subroutine foo 71 subroutine nonpointer(t) 72 type(myT), intent(in) :: t 73 if(t%x /= 5 ) call abort() 74 if(t%point /= 42) call abort() 75 t%point = 7 76 end subroutine nonpointer 77end program 78