gcc/testsuite/gfortran.dg/proc_ptr_comp_12.f90

   1 ! { dg-do run }
   2 !
   3 ! PR 40646: [F03] array-valued procedure pointer components
   4 !
   5 ! Original test case by Charlie Sharpsteen <chuck@sharpsteen.net>
   6 ! Modified by Janus Weil <janus@gcc.gnu.org>
   7
   8 module bugTestMod
   9   implicit none
  10   type:: boundTest
  11     procedure(returnMat), pointer, nopass:: test
  12   end type boundTest
  13 contains
  14   function returnMat( a, b ) result( mat )
  15     integer:: a, b
  16     double precision, dimension(a,b):: mat
  17     mat = 1d0
  18   end function returnMat
  19 end module bugTestMod
  20
  21 program bugTest
  22   use bugTestMod
  23   implicit none
  24   type( boundTest ):: testObj
  25   double precision, dimension(2,2):: testCatch
  26   testObj%test => returnMat
  27   testCatch = testObj%test(2,2)
  28   print *,testCatch
  29   if (sum(testCatch)/=4) call abort()
  30   print *,testObj%test(3,3)
  31   if (sum(testObj%test(3,3))/=9) call abort()
  32 end program bugTest
  33
  34 ! { dg-final { cleanup-modules "bugTestMod" } }
  35