gcc/testsuite/gfortran.dg/proc_ptr_18.f90

   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
   8 PROGRAM test_prog
   9
  10   PROCEDURE(triple), POINTER :: f
  11
  12   f => triple
  13   if (sum(f(2.,4.)-triple(2.,4.))>1E-3) call abort()
  14
  15 CONTAINS
  16
  17   FUNCTION triple(a,b) RESULT(tre)
  18     REAL, INTENT(in) :: a, b
  19     REAL :: tre(2)
  20     tre(1) = 3.*a
  21     tre(2) = 3.*b
  22   END FUNCTION triple
  23
  24 END PROGRAM test_prog
  25