1! { dg-do run }
2!
3! PR 40176:  Fortran 2003: Procedure pointers with array return value
4!
5! Original test case by Barron Bichon <barron.bichon@swri.org>
6! Modified by Janus Weil <janus@gcc.gnu.org>
7
8PROGRAM test_prog
9
10 TYPE ProcPointerType
11   PROCEDURE(triple), POINTER, NOPASS :: f
12 END TYPE ProcPointerType
13
14 TYPE (ProcPointerType) :: ppt
15 PROCEDURE(triple), POINTER :: f
16 REAL :: tres(2)
17
18 ppt%f => triple
19 f => ppt%f
20 tres = f(2,[2.,4.])
21 if (abs(tres(1)-6.)>1E-3) call abort()
22 if (abs(tres(2)-12.)>1E-3) call abort()
23 tres = ppt%f(2,[3.,5.])
24 if (abs(tres(1)-9.)>1E-3) call abort()
25 if (abs(tres(2)-15.)>1E-3) call abort()
26
27CONTAINS
28
29 FUNCTION triple(n,x) RESULT(tre)
30   INTEGER, INTENT(in) :: n
31   REAL, INTENT(in) :: x(2)
32   REAL :: tre(2)
33   tre = 3.*x
34 END FUNCTION triple
35
36END PROGRAM test_prog
37
38