gcc/testsuite/gfortran.dg/use_26.f90

   1 ! { dg-do compile }
   2 !
   3 ! PR fortran/45836
   4 ! The B_TYPE_INSTANCE%SIZERETURN() typebound function used to be rejected on a
   5 ! type mismatch because the function was resolved to A's SIZERETURN instead of
   6 ! B's because of the ambiguity of the SIZERETURN name in the MAIN namespace.
   7 !
   8 ! Original testcase by someone <ortp21@gmail.com>
   9
  10 module A
  11 implicit none
  12     type :: a_type
  13     private
  14         integer :: size = 1
  15     contains
  16         procedure :: sizeReturn
  17     end type a_type
  18     contains
  19         function sizeReturn( a_type_ )
  20             implicit none
  21             integer :: sizeReturn
  22             class(a_type) :: a_type_
  23
  24             sizeReturn = a_type_%size
  25         end function sizeReturn
  26 end module A
  27
  28 module B
  29 implicit none
  30     type :: b_type
  31     private
  32         integer :: size = 2
  33     contains
  34         procedure :: sizeReturn
  35     end type b_type
  36     contains
  37         function sizeReturn( b_type_ )
  38             implicit none
  39             integer :: sizeReturn
  40             class(b_type) :: b_type_
  41
  42             sizeReturn = b_type_%size
  43         end function sizeReturn
  44 end module B
  45
  46 program main
  47
  48   call test1
  49   call test2
  50
  51 contains
  52
  53   subroutine test1
  54     use A
  55     use B
  56     implicit none
  57     type(a_type) :: a_type_instance
  58     type(b_type) :: b_type_instance
  59
  60     print *, a_type_instance%sizeReturn()
  61     print *, b_type_instance%sizeReturn()
  62   end subroutine test1
  63
  64   subroutine test2
  65     use B
  66     use A
  67     implicit none
  68     type(a_type) :: a_type_instance
  69     type(b_type) :: b_type_instance
  70
  71     print *, a_type_instance%sizeReturn()
  72     print *, b_type_instance%sizeReturn()
  73   end subroutine test2
  74 end program main
  75
  76