gcc/testsuite/gfortran.dg/bind_c_usage_13.f03

   1 ! { dg-do compile }
   2 ! { dg-options "-fdump-tree-original" }
   3 !
   4 ! PR fortran/34079
   5 ! Character bind(c) arguments shall not pass the length as additional argument
   6 !
   7
   8 subroutine multiArgTest()
   9   implicit none
  10 interface ! 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
  22 end interface
  23
  24 interface ! 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
  36 end interface
  37
  38 interface ! 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
  50 end interface
  51
  52 call mult_array    ("abc","ab")
  53 call multiso_array ("ABCDEF","ab")
  54 call multiso2_array("AbCdEfGhIj","ab")
  55
  56 call mult    ("u","x")
  57 call multiso ("v","x")
  58 call multiso2("w","x")
  59
  60 call mult_val    ("x","x")
  61 call multiso_val ("y","x")
  62 call multiso2_val("z","x")
  63 end subroutine multiArgTest
  64
  65 program test
  66 implicit none
  67
  68 interface ! 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
  80 end interface
  81
  82 interface ! 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
  94 end interface
  95
  96 interface ! 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
 108 end interface
 109
 110 call sub_array    ("abc")
 111 call subiso_array ("ABCDEF")
 112 call subiso2_array("AbCdEfGhIj")
 113
 114 call sub    ("u")
 115 call subiso ("v")
 116 call subiso2("w")
 117
 118 call sub_val    ("x")
 119 call subiso_val ("y")
 120 call subiso2_val("z")
 121 end 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" } }