gcc/testsuite/gfortran.dg/interface_35.f90

   1 ! { dg-do compile }
   2 ! { dg-options "-std=f2003" }
   3 !
   4 ! PR fortran/48112 (module_m)
   5 ! PR fortran/48279 (sidl_string_array, s_Hard)
   6 !
   7 ! Contributed by mhp77@gmx.at (module_m)
   8 ! and Adrian Prantl (sidl_string_array, s_Hard)
   9 !
  10
  11 module module_m
  12   interface test
  13      function test1( )  result( test )
  14        integer ::  test
  15      end function test1
  16   end interface test
  17 end module module_m
  18
  19 ! -----
  20
  21 module sidl_string_array
  22   type sidl_string_1d
  23   end type sidl_string_1d
  24   interface set
  25     module procedure &
  26       setg1_p
  27   end interface
  28 contains
  29   subroutine setg1_p(array, index, val)
  30     type(sidl_string_1d), intent(inout) :: array
  31   end subroutine setg1_p
  32 end module sidl_string_array
  33
  34 module s_Hard
  35   use sidl_string_array
  36   type :: s_Hard_t
  37      integer(8) :: dummy
  38   end type s_Hard_t
  39   interface set_d_interface
  40   end interface
  41   interface get_d_string
  42     module procedure get_d_string_p
  43   end interface
  44   contains ! Derived type member access functions
  45     type(sidl_string_1d) function get_d_string_p(s)
  46       type(s_Hard_t), intent(in) :: s
  47     end function get_d_string_p
  48     subroutine set_d_objectArray_p(s, d_objectArray)
  49     end subroutine set_d_objectArray_p
  50 end module s_Hard
  51
  52 subroutine initHard(h, ex)
  53   use s_Hard
  54   type(s_Hard_t), intent(inout) :: h
  55   call set(get_d_string(h), 0, 'Three') ! { dg-error "There is no specific subroutine for the generic" }
  56 end subroutine initHard
  57
  58 ! -----
  59
  60   interface get
  61     procedure get1
  62   end interface
  63
  64   integer :: h
  65   call set1 (get (h))
  66
  67 contains
  68
  69   subroutine set1 (a)
  70     integer, intent(in) :: a
  71   end subroutine
  72
  73   integer function get1 (s) ! { dg-error "Fortran 2008: Internal procedure .get1. in generic interface .get." }
  74     integer :: s
  75   end function
  76
  77 end