gcc/testsuite/gfortran.dg/proc_ptr_19.f90

   1 ! { dg-do run }
   2 !
   3 ! PR 40176:  Fortran 2003: Procedure pointers with array return value
   4 !
   5 ! This example tests for a bug in procedure pointer assignments,
   6 ! where the rhs is a dummy.
   7 !
   8 ! Original test case by Barron Bichon <barron.bichon@swri.org>
   9 ! Modified by Janus Weil <janus@gcc.gnu.org>
  10
  11 PROGRAM test_prog
  12
  13   PROCEDURE(add), POINTER :: forig, fset
  14
  15   forig => add
  16
  17   CALL set_ptr(forig,fset)
  18
  19   if (forig(1,2) /= fset(1,2)) call abort()
  20
  21 CONTAINS
  22
  23   SUBROUTINE set_ptr(f1,f2)
  24     PROCEDURE(add), POINTER :: f1, f2
  25     f2 => f1
  26   END SUBROUTINE set_ptr
  27
  28   FUNCTION add(a,b)
  29     INTEGER :: a,b,add
  30     add = a+b
  31
  32   END FUNCTION add
  33
  34 END PROGRAM test_prog
  35