gcc/testsuite/gfortran.dg/pr106999.f90

   1 ! { dg-do compile }
   2 ! Test the fix for PR106999
   3 ! Contributed by Gerhard Steinmetz  <gscfq@t-online.de>
   4 program p
   5    type t
   6       integer :: i
   7       procedure(g), pointer :: f
   8    end type
   9    class(t), allocatable :: y, z
  10    procedure(g), pointer :: ff
  11    allocate (z)
  12    z%i = 42
  13    z%f => g
  14    ff => g
  15    call r(z%f)
  16    call s(z%f) ! { dg-error "Interface mismatch in dummy procedure" }
  17    call s(ff)  ! { dg-error "Interface mismatch in dummy procedure" }
  18 contains
  19    subroutine g(x)
  20       class(t) :: x
  21       x%i = 84
  22    end
  23    subroutine r(x)
  24       procedure(g) :: x
  25       print *, "in r"
  26       allocate (y)
  27       call x(y)
  28       print *, y%i
  29    end
  30    subroutine s(x)
  31       class(*) :: x
  32    end subroutine
  33 end