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
11module module_m
12  interface test
13     function test1( )  result( test )
14       integer ::  test
15     end function test1
16  end interface test
17end module module_m
18
19! -----
20
21module 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
28contains
29  subroutine setg1_p(array, index, val)
30    type(sidl_string_1d), intent(inout) :: array
31  end subroutine setg1_p
32end module sidl_string_array
33
34module 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
50end module s_Hard
51
52subroutine 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" }
56end subroutine initHard
57
58! -----
59
60  interface get
61    procedure get1
62  end interface
63
64  integer :: h
65  call set1 (get (h))
66
67contains
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
77end
78