1! { dg-do run } 2! 3! PR 40164: Fortran 2003: "Arrays of procedure pointers" (using PPCs) 4! 5! Original test case by Barron Bichon <barron.bichon@swri.org> 6! Adapted by Janus Weil <janus@gcc.gnu.org> 7 8PROGRAM test_prog 9 10 ABSTRACT INTERFACE 11 FUNCTION fn_template(n,x) RESULT(y) 12 INTEGER, INTENT(in) :: n 13 REAL, INTENT(in) :: x(n) 14 REAL :: y(n) 15 END FUNCTION fn_template 16 END INTERFACE 17 18 TYPE PPA 19 PROCEDURE(fn_template), POINTER, NOPASS :: f 20 END TYPE PPA 21 22 TYPE ProcPointerArray 23 PROCEDURE(add), POINTER, NOPASS :: f 24 END TYPE ProcPointerArray 25 26 TYPE (ProcPointerArray) :: f_array(3) 27 PROCEDURE(add), POINTER :: f 28 real :: r 29 30 f_array(1)%f => add 31 f => f_array(1)%f 32 f_array(2)%f => sub 33 f_array(3)%f => f_array(1)%f 34 35 r = f(1.,2.) 36 if (abs(r-3.)>1E-3) STOP 1 37 r = f_array(1)%f(4.,2.) 38 if (abs(r-6.)>1E-3) STOP 2 39 r = f_array(2)%f(5.,3.) 40 if (abs(r-2.)>1E-3) STOP 3 41 if (abs(f_array(1)%f(1.,3.)-f_array(3)%f(2.,2.))>1E-3) STOP 4 42 43CONTAINS 44 45 FUNCTION add(a,b) RESULT(sum) 46 REAL, INTENT(in) :: a, b 47 REAL :: sum 48 sum = a + b 49 END FUNCTION add 50 51 FUNCTION sub(a,b) RESULT(diff) 52 REAL, INTENT(in) :: a, b 53 REAL :: diff 54 diff = a - b 55 END FUNCTION sub 56 57END PROGRAM test_prog 58 59