1! PR92482
2! { dg-do compile }
3!
4! TS 29113
5! C1255 (R1230) If proc-language-binding-spec is specified for a procedure,
6! each dummy argument shall be an interoperable procedure (15.3.7)
7! or a variable that is interoperable (15.3.5, 15.3.6), assumed shape,
8! assumed rank, assumed type, of assumed character length, or has the
9! ALLOCATABLE or POINTER attribute. If proc-language-binding-spec is
10! specified for a function, the function result shall be an interoperable
11! scalar variable.
12
13module m
14
15  interface
16
17    ! dummy is interoperable procedure
18    subroutine s1 (x) bind (c)
19      use ISO_C_BINDING
20      implicit none
21      interface
22        function x (a, b) bind (c)
23          use ISO_C_BINDING
24          integer(C_INT) :: a, b
25          integer(C_INT) :: x
26        end function
27      end interface
28    end subroutine
29
30    ! dummy is interoperable variable
31    subroutine s2 (x) bind (c)
32      use ISO_C_BINDING
33      implicit none
34      integer(C_INT) :: x
35    end subroutine
36
37    ! dummy is assumed-shape array variable
38    subroutine s3 (x) bind (c)
39      use ISO_C_BINDING
40      implicit none
41      integer(C_INT) :: x(:)
42    end subroutine
43
44    ! dummy is an assumed-rank array variable
45    subroutine s4 (x) bind (c)
46      use ISO_C_BINDING
47      implicit none
48      integer(C_INT) :: x(..)
49    end subroutine
50
51    ! dummy is assumed-type variable
52    subroutine s5 (x) bind (c)
53      use ISO_C_BINDING
54      implicit none
55      type(*) :: x
56    end subroutine
57
58    ! dummy is assumed length character variable
59    subroutine s6 (x) bind (c)
60      use ISO_C_BINDING
61      implicit none
62      character(len=*) :: x
63    end subroutine
64
65    ! dummy has allocatable or pointer attribute
66    subroutine s7 (x, y) bind (c)
67      use ISO_C_BINDING
68      implicit none
69      integer(C_INT), allocatable :: x
70      integer(C_INT), pointer :: y
71    end subroutine
72
73    ! function result shall be an interoperable scalar variable
74    function f (x) bind (c)
75      use ISO_C_BINDING
76      implicit none
77      integer(C_INT) :: x
78      integer(C_INT) :: f
79    end function
80
81  end interface
82end module
83
84