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