1! { dg-do compile } 2! { dg-options "-fdump-tree-original -Wc-binding-type" } 3! 4! PR fortran/34079 5! Character bind(c) arguments shall not pass the length as additional argument 6! 7 8subroutine multiArgTest() 9 implicit none 10interface ! Array 11 subroutine multiso_array(x,y) bind(c) 12 use iso_c_binding 13 character(kind=c_char,len=1), dimension(*) :: x,y 14 end subroutine multiso_array 15 subroutine multiso2_array(x,y) bind(c) ! { dg-warning "may not be C interoperable" } 16 character(len=1), dimension(*) :: x,y 17 end subroutine multiso2_array 18 subroutine mult_array(x,y) 19 use iso_c_binding 20 character(kind=c_char,len=1), dimension(*) :: x,y 21 end subroutine mult_array 22end interface 23 24interface ! Scalar: call by reference 25 subroutine multiso(x,y) bind(c) 26 use iso_c_binding 27 character(kind=c_char,len=1) :: x,y 28 end subroutine multiso 29 subroutine multiso2(x,y) bind(c) ! { dg-warning "may not be C interoperable" } 30 character(len=1) :: x,y 31 end subroutine multiso2 32 subroutine mult(x,y) 33 use iso_c_binding 34 character(kind=c_char,len=1) :: x,y 35 end subroutine mult 36end interface 37 38interface ! Scalar: call by VALUE 39 subroutine multiso_val(x,y) bind(c) 40 use iso_c_binding 41 character(kind=c_char,len=1), value :: x,y 42 end subroutine multiso_val 43 subroutine multiso2_val(x,y) bind(c) ! { dg-warning "may not be C interoperable" } 44 character(len=1), value :: x,y 45 end subroutine multiso2_val 46 subroutine mult_val(x,y) 47 use iso_c_binding 48 character(kind=c_char,len=1), value :: x,y 49 end subroutine mult_val 50end interface 51 52call mult_array ("abc","ab") 53call multiso_array ("ABCDEF","ab") 54call multiso2_array("AbCdEfGhIj","ab") 55 56call mult ("u","x") 57call multiso ("v","x") 58call multiso2("w","x") 59 60call mult_val ("x","x") 61call multiso_val ("y","x") 62call multiso2_val("z","x") 63end subroutine multiArgTest 64 65program test 66implicit none 67 68interface ! Array 69 subroutine subiso_array(x) bind(c) 70 use iso_c_binding 71 character(kind=c_char,len=1), dimension(*) :: x 72 end subroutine subiso_array 73 subroutine subiso2_array(x) bind(c) ! { dg-warning "may not be C interoperable" } 74 character(len=1), dimension(*) :: x 75 end subroutine subiso2_array 76 subroutine sub_array(x) 77 use iso_c_binding 78 character(kind=c_char,len=1), dimension(*) :: x 79 end subroutine sub_array 80end interface 81 82interface ! Scalar: call by reference 83 subroutine subiso(x) bind(c) 84 use iso_c_binding 85 character(kind=c_char,len=1) :: x 86 end subroutine subiso 87 subroutine subiso2(x) bind(c) ! { dg-warning "may not be C interoperable" } 88 character(len=1) :: x 89 end subroutine subiso2 90 subroutine sub(x) 91 use iso_c_binding 92 character(kind=c_char,len=1) :: x 93 end subroutine sub 94end interface 95 96interface ! Scalar: call by VALUE 97 subroutine subiso_val(x) bind(c) 98 use iso_c_binding 99 character(kind=c_char,len=1), value :: x 100 end subroutine subiso_val 101 subroutine subiso2_val(x) bind(c) ! { dg-warning "may not be C interoperable" } 102 character(len=1), value :: x 103 end subroutine subiso2_val 104 subroutine sub_val(x) 105 use iso_c_binding 106 character(kind=c_char,len=1), value :: x 107 end subroutine sub_val 108end interface 109 110call sub_array ("abc") 111call subiso_array ("ABCDEF") 112call subiso2_array("AbCdEfGhIj") 113 114call sub ("u") 115call subiso ("v") 116call subiso2("w") 117 118call sub_val ("x") 119call subiso_val ("y") 120call subiso2_val("z") 121end program test 122 123! Double argument dump: 124! 125! { dg-final { scan-tree-dump "mult_array .&.abc..1..lb: 1 sz: 1., &.ab..1..lb: 1 sz: 1., 3, 2.;" "original" } } 126! { dg-final { scan-tree-dump "multiso_array .&.ABCDEF..1..lb: 1 sz: 1., &.ab..1..lb: 1 sz: 1..;" "original" } } 127! { dg-final { scan-tree-dump "multiso2_array .&.AbCdEfGhIj..1..lb: 1 sz: 1., &.ab..1..lb: 1 sz: 1..;" "original" } } 128! 129! { dg-final { scan-tree-dump "mult .&.u..1..lb: 1 sz: 1., &.x..1..lb: 1 sz: 1., 1, 1.;" "original" } } 130! { dg-final { scan-tree-dump "multiso .&.v..1..lb: 1 sz: 1., &.x..1..lb: 1 sz: 1..;" "original" } } 131! { dg-final { scan-tree-dump "multiso2 .&.w..1..lb: 1 sz: 1., &.x..1..lb: 1 sz: 1..;" "original" } } 132! 133! { dg-final { scan-tree-dump "mult_val ..x., .x., 1, 1.;" "original" } } 134! { dg-final { scan-tree-dump "multiso_val .121, 120.;" "original" } } 135! { dg-final { scan-tree-dump "multiso2_val ..z., .x..;" "original" } } 136! 137! Single argument dump: 138! 139! { dg-final { scan-tree-dump "sub_array .&.abc..1..lb: 1 sz: 1., 3.;" "original" } } 140! { dg-final { scan-tree-dump "subiso_array .&.ABCDEF..1..lb: 1 sz: 1..;" "original" } } 141! { dg-final { scan-tree-dump "subiso2_array .&.AbCdEfGhIj..1..lb: 1 sz: 1..;" "original" } } 142! 143! { dg-final { scan-tree-dump "sub .&.u..1..lb: 1 sz: 1., 1.;" "original" } } 144! { dg-final { scan-tree-dump "subiso .&.v..1..lb: 1 sz: 1..;" "original" } } 145! { dg-final { scan-tree-dump "subiso2 .&.w..1..lb: 1 sz: 1..;" "original" } } 146! 147! { dg-final { scan-tree-dump "sub_val ..x., 1.;" "original" } } 148! { dg-final { scan-tree-dump "subiso_val .121.;" "original" } } 149! { dg-final { scan-tree-dump "subiso2_val ..z..;" "original" } } 150! 151! { dg-final { cleanup-tree-dump "original" } } 152