1! { dg-do run } 2! 3! PR39630: Fortran 2003: Procedure pointer components. 4! 5! Basic test for PPCs with SUBROUTINE interface and NOPASS. 6! 7! Contributed by Janus Weil <janus@gcc.gnu.org> 8 9 type t 10 integer :: i 11 procedure(sub), pointer, nopass :: ppc 12 procedure(), pointer, nopass :: proc 13 end type 14 15 type, extends(t) :: t2 16 procedure(), pointer, nopass :: proc2 17 end type t2 18 19 type(t) :: x 20 type(t2) :: x2 21 22 procedure(sub),pointer :: pp 23 integer :: sum = 0 24 25 x%i = 1 26 x%ppc => sub 27 pp => x%ppc 28 29 call sub(1) 30 if (sum/=1) STOP 1 31 call pp(2) 32 if (sum/=3) STOP 2 33 call x%ppc(3) 34 if (sum/=6) STOP 3 35 36 ! calling object as argument 37 x%proc => sub2 38 call x%proc(x) 39 if (x%i/=7) STOP 4 40 41 ! type extension 42 x%proc => sub 43 call x%proc(4) 44 if (sum/=10) STOP 5 45 x2%proc => sub 46 call x2%proc(5) 47 if (sum/=15) STOP 6 48 x2%proc2 => sub 49 call x2%proc2(6) 50 if (sum/=21) STOP 7 51 52contains 53 54 subroutine sub(y) 55 integer, intent(in) :: y 56 sum = sum + y 57 end subroutine 58 59 subroutine sub2(arg) 60 type(t),intent(inout) :: arg 61 arg%i = arg%i + sum 62 end subroutine 63 64end 65 66