gcc/testsuite/gfortran.dg/typebound_call_9.f03

   1 ! { dg-do compile }
   2
   3 ! PR fortran/37638
   4 ! If a PASS(arg) is invalid, a call to this routine later would ICE in
   5 ! resolving.  Check that this also works for GENERIC, in addition to the
   6 ! PR's original test.
   7
   8 ! Contributed by Salvatore Filippone <sfilippone@uniroma2.it>
   9
  10 module foo_mod
  11   implicit none
  12
  13   type base_foo_type
  14     integer           :: nr,nc
  15     integer, allocatable :: iv1(:), iv2(:)
  16
  17   contains
  18
  19     procedure, pass(a) :: makenull ! { dg-error "has no argument 'a'" }
  20     generic :: null2 => makenull
  21
  22   end type base_foo_type
  23
  24 contains
  25
  26   subroutine makenull(m)
  27     implicit none
  28     type(base_foo_type), intent(inout) :: m
  29
  30     m%nr=0
  31     m%nc=0
  32
  33   end subroutine makenull
  34
  35   subroutine foo_free(a,info)
  36     implicit none
  37     Type(base_foo_type), intent(inout)  :: A
  38     Integer, intent(out)        :: info
  39     integer             :: iret
  40     info  = 0
  41
  42
  43     if (allocated(a%iv1)) then
  44       deallocate(a%iv1,stat=iret)
  45       if (iret /= 0) info = max(info,2)
  46     endif
  47     if (allocated(a%iv2)) then
  48       deallocate(a%iv2,stat=iret)
  49       if (iret /= 0) info = max(info,3)
  50     endif
  51
  52     call a%makenull()
  53     call a%null2 () ! { dg-error "no matching specific binding" }
  54
  55     Return
  56   End Subroutine foo_free
  57
  58 end module foo_mod
  59
  60 ! { dg-final { cleanup-modules "foo_mod" } }