gcc/testsuite/gfortran.dg/proc_ptr_30.f90

   1 ! { dg-do compile }
   2 !
   3 ! PR 46067: [F03] invalid procedure pointer assignment not detected
   4 !
   5 ! Contributed by Stephen J. Bespalko <sjbespa@comcast.net>
   6
   7   implicit none
   8
   9   type test_type
  10     integer :: id = 1
  11   end type
  12
  13   abstract interface
  14     real function fun_interface(t,x)
  15       import :: test_type
  16       real, intent(in) :: x
  17       class(test_type) :: t
  18     end function
  19   end interface
  20
  21   type(test_type) :: funs
  22   real :: r
  23   procedure(fun_interface), pointer :: pp
  24
  25   pp => fun1        ! { dg-error "Interface mismatch in procedure pointer assignment" }
  26   r = pp(funs,0.)
  27   print *, " pp(0) ", r
  28
  29 contains
  30
  31   real function fun1 (t,x)
  32     real, intent(in) :: x
  33     type(test_type) :: t
  34     print *," id = ", t%id
  35     fun1 = cos(x)
  36   end function
  37
  38 end