1! { dg-do compile }
2!
3! TS 29113
4! C1255 (R1230) If proc-language-binding-spec is specified for a procedure,
5! each dummy argument shall be an interoperable procedure (15.3.7)
6! or a variable that is interoperable (15.3.5, 15.3.6), assumed shape,
7! assumed rank, assumed type, of assumed character length, or has the
8! ALLOCATABLE or POINTER attribute. If proc-language-binding-spec is
9! specified for a function, the function result shall be an interoperable
10! scalar variable.
11!
12! This file contains code that is expected to produce errors.
13
14
15module m1
16   ! type to use for examples below
17  type t
18    integer :: foo
19    real :: bar
20  end type
21end module
22
23module m2
24
25  interface
26
27    ! dummy is a procedure that is not interoperable
28    subroutine s1 (x) bind (c)
29      use ISO_C_BINDING
30      use m1
31      implicit none
32      interface
33        function x (a, b) bind (c)  ! { dg-error "not C interoperable" }
34          use ISO_C_BINDING
35          use m1
36          integer(C_INT) :: a
37          class(t) :: b  !
38          integer(C_INT) :: x
39        end function
40      end interface
41    end subroutine
42
43    ! dummy is of a type that is not interoperable
44    subroutine s2 (x) bind (c)  ! { dg-error "not C interoperable" }
45      use ISO_C_BINDING
46      use m1
47      implicit none
48      class(t) :: x
49    end subroutine
50
51    ! dummy is an array that is not of interoperable type and not
52    ! assumed-shape or assumed-rank
53    subroutine s3 (x) bind (c)  ! { dg-error "not C interoperable" }
54      use ISO_C_BINDING
55      use m1
56      implicit none
57      class(t) :: x(3, 3)
58    end subroutine
59
60    subroutine s4 (n, x) bind (c)  ! { dg-error "not C interoperable" }
61      use ISO_C_BINDING
62      use m1
63      implicit none
64      integer(C_INT) :: n
65      class(t) :: x(n)
66    end subroutine
67
68    ! This fails with a bogus error even without C binding.
69    subroutine s5 (x) bind (c)  ! { dg-error "not C interoperable" }
70      use ISO_C_BINDING
71      use m1
72      implicit none
73      class(t) :: x(*)  ! { dg-bogus "not yet been implemented" "pr46991" }
74                        ! { dg-bogus "has no IMPLICIT type" "pr46991" { target "*-*-*" } 68 }
75    end subroutine
76
77    subroutine s5a (x)
78      use ISO_C_BINDING
79      use m1
80      implicit none
81      class(t) :: x(*)  ! { dg-bogus "not yet been implemented" "pr46991" }
82                        ! { dg-bogus "has no IMPLICIT type" "pr46991" { target "*-*-*" } 76 }
83    end subroutine
84
85    ! function result is not a scalar
86    function f (x) bind (c)  ! { dg-error "not C interoperable" }
87      use ISO_C_BINDING
88      use m1
89      implicit none
90      integer(C_INT) :: x
91      type(t) :: f
92    end function
93
94    ! function result is a type that is not interoperable
95    function g (x) bind (c)  ! { dg-error "BIND\\(C\\)" }
96      use ISO_C_BINDING
97      use m1
98      implicit none
99      integer(C_INT) :: x
100      integer(C_INT), allocatable :: g
101    end function
102
103  end interface
104
105end module
106
107