gcc/testsuite/gfortran.dg/submodule_32.f08

   1 ! { dg-do run }
   2 !
   3 ! Test the fix for PR86863, where the Type Bound Procedures were
   4 ! not flagged as subroutines thereby causing an error at the call
   5 ! statements.
   6 !
   7 ! Contributed by Damian Rouson  <damian@sourceryinstitute.org>
   8 !
   9 module foo
  10   implicit none
  11   integer :: flag = 0
  12   type bar
  13   contains
  14     procedure, nopass :: foobar
  15     procedure, nopass :: barfoo
  16   end type
  17 contains
  18   subroutine foobar
  19     flag = 1
  20   end subroutine
  21   subroutine barfoo
  22     flag = 0
  23   end subroutine
  24 end module
  25
  26 module foobartoo
  27   implicit none
  28   interface
  29     module subroutine set(object)
  30       use foo
  31       implicit none
  32       type(bar) object
  33     end subroutine
  34     module subroutine unset(object)
  35       use foo
  36       implicit none
  37       type(bar) object
  38     end subroutine
  39   end interface
  40 contains
  41   module procedure unset
  42     use foo, only : bar
  43     call object%barfoo
  44   end procedure
  45 end module
  46
  47 submodule(foobartoo) subfoobar
  48 contains
  49   module procedure set
  50     use foo, only : bar
  51     call object%foobar
  52   end procedure
  53 end submodule
  54
  55   use foo
  56   use foobartoo
  57   type(bar) :: obj
  58   call set(obj)
  59   if (flag .ne. 1) stop 1
  60   call unset(obj)
  61   if (flag .ne. 0) stop 2
  62 end