gcc/testsuite/gfortran.dg/dummy_procedure_4.f90

   1 ! { dg-do compile }
   2 !
   3 ! PR 46067: [F03] invalid procedure pointer assignment not detected
   4 !
   5 ! Contributed by Janus Weil <janus@gcc.gnu.org>
   6
   7 module m
   8
   9   type test_type
  10     integer :: id = 1
  11   end type
  12
  13 contains
  14
  15   real function fun1 (t,x)
  16     real, intent(in) :: x
  17     type(test_type) :: t
  18     print *," id = ", t%id
  19     fun1 = cos(x)
  20   end function
  21
  22 end module
  23
  24
  25   use m
  26   implicit none
  27
  28   call test (fun1)  ! { dg-error "Interface mismatch in dummy procedure" }
  29
  30 contains
  31
  32   subroutine test(proc)
  33     interface
  34       real function proc(t,x)
  35         import :: test_type
  36         real, intent(in) :: x
  37         class(test_type) :: t
  38       end function
  39     end interface
  40     type(test_type) :: funs
  41     real :: r
  42     r = proc(funs,0.)
  43     print *, " proc(0) ",r
  44   end subroutine
  45
  46 end
  47
  48 ! { dg-final { cleanup-modules "m" } }