gcc/testsuite/gfortran.dg/module_procedure_6.f90

   1 ! { dg-do run }
   2 !
   3 ! Test the fix for the testcase in comment 24 of PR96320, which used to
   4 ! fail with the message: ‘set_user_defined’ must be a module procedure or
   5 ! an external procedure with an explicit interface at (1)
   6 !
   7 ! Contributed by Damian Rouson  <damian@sourceryinstitute.org>
   8 !
   9 module hole_interface
  10   type hole_t
  11     integer :: user_defined
  12     real :: hole_diameter
  13   contains
  14     procedure set_user_defined
  15     procedure set_diameter
  16   end type
  17
  18   interface
  19     module subroutine set_diameter (this, diameter)
  20       class(hole_t) :: this
  21       real :: diameter
  22     end subroutine
  23
  24     module subroutine set_user_defined(this, user_defined)
  25       class(hole_t) :: this
  26       integer :: user_defined
  27     end subroutine
  28   end interface
  29
  30 contains
  31   module procedure set_user_defined
  32     this%user_defined = user_defined
  33   end procedure
  34
  35   module procedure set_diameter
  36     this%hole_diameter = diameter
  37     if (this%user_defined .lt. 0) then
  38       call this%set_user_defined (0)
  39     end if
  40   end procedure
  41 end module
  42
  43   use hole_interface ! Error was here
  44   type (hole_t) :: ht = hole_t (-1, 0.0)
  45   call ht%set_diameter(1.0)
  46   if ((ht%user_defined .ne. 0) .and. (ht%hole_diameter .ne. 1.0)) stop 1
  47   call ht%set_user_defined (5)
  48   if ((ht%user_defined .ne. 5) .and. (ht%hole_diameter .ne. 1.0)) stop 2
  49   call ht%set_diameter(2.0)
  50   if ((ht%user_defined .ne. 5) .and. (ht%hole_diameter .ne. 2.0)) stop 3
  51 end