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