gcc/testsuite/gfortran.dg/proc_ptr_comp_9.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  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
  27 CONTAINS
  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
  36 END PROGRAM test_prog
  37