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