gcc/testsuite/gfortran.dg/host_assoc_types_2.f90

   1 ! { dg-do compile }
   2 ! Tests the fix for PR33945, the host association of overloaded_type_s
   3 ! would be incorrectly blocked by the use associated overloaded_type.
   4 !
   5 ! Contributed by Jonathan Hogg  <J.Hogg@rl.ac.uk>
   6 !
   7 module dtype
   8    implicit none
   9
  10    type overloaded_type
  11       double precision :: part
  12    end type
  13
  14    interface overloaded_sub
  15       module procedure overloaded_sub_d
  16    end interface
  17
  18 contains
  19    subroutine overloaded_sub_d(otype)
  20       type(overloaded_type), intent(in) :: otype
  21
  22       print *, "d type = ", otype%part
  23    end subroutine
  24 end module
  25
  26 module stype
  27    implicit none
  28
  29    type overloaded_type
  30       real :: part
  31    end type
  32
  33    interface overloaded_sub
  34       module procedure overloaded_sub_s
  35    end interface
  36
  37 contains
  38    subroutine overloaded_sub_s(otype)
  39       type(overloaded_type), intent(in) :: otype
  40
  41       print *, "s type = ", otype%part
  42    end subroutine
  43 end module
  44
  45 program test
  46    use stype, overloaded_type_s => overloaded_type
  47    use dtype, overloaded_type_d => overloaded_type
  48    implicit none
  49
  50    type(overloaded_type_s) :: sval
  51    type(overloaded_type_d) :: dval
  52
  53    sval%part = 1
  54    dval%part = 2
  55
  56    call fred(sval, dval)
  57
  58 contains
  59    subroutine fred(sval, dval)
  60       use stype
  61
  62       type(overloaded_type_s), intent(in) :: sval  ! This caused an error
  63       type(overloaded_type_d), intent(in) :: dval
  64
  65       call overloaded_sub(sval)
  66       call overloaded_sub(dval)
  67    end subroutine
  68 end program