gcc/testsuite/gfortran.dg/c_char_tests_4.f90

   1 ! { dg-do run }
   2 !
   3 ! PR fortran/103828
   4 ! Check that we can pass many function args as C char, which are interoperable
   5 ! with both INTEGER(C_SIGNED_CHAR) and CHARACTER(C_CHAR).
   6
   7 program test
   8   use, intrinsic :: iso_c_binding, only : c_signed_char, c_char
   9   implicit none
  10
  11   interface
  12     ! In order to perform this test, we cheat and pretend to give each function
  13     ! the other one's prototype. It should still work, because all arguments
  14     ! are interoperable with C char.
  15
  16     subroutine test1 (a, b, c, d, e, f, g, h, i, j, k, l, m, n, o) bind(c, name='test_int')
  17       import c_char
  18       character(kind=c_char, len=1), value :: a, b, c, d, e, f, g, h, i, j, k, l, m, n, o
  19     end subroutine test1
  20
  21     subroutine test2 (a, b, c, d, e, f, g, h, i, j, k, l, m, n, o) bind(c, name='test_char')
  22       import c_signed_char
  23       integer(kind=c_signed_char), value :: a, b, c, d, e, f, g, h, i, j, k, l, m, n, o
  24     end subroutine test2
  25
  26   end interface
  27
  28   call test1('a', 'b', 'c', 'd', 'e', 'f', 'g', 'h', 'i', 'j', 'k', 'l', 'm', 'n', 'o')
  29   call test2(ichar('a', kind=c_signed_char), &
  30              ichar('b', kind=c_signed_char), &
  31              ichar('c', kind=c_signed_char), &
  32              ichar('d', kind=c_signed_char), &
  33              ichar('e', kind=c_signed_char), &
  34              ichar('f', kind=c_signed_char), &
  35              ichar('g', kind=c_signed_char), &
  36              ichar('h', kind=c_signed_char), &
  37              ichar('i', kind=c_signed_char), &
  38              ichar('j', kind=c_signed_char), &
  39              ichar('k', kind=c_signed_char), &
  40              ichar('l', kind=c_signed_char), &
  41              ichar('m', kind=c_signed_char), &
  42              ichar('n', kind=c_signed_char), &
  43              ichar('o', kind=c_signed_char))
  44
  45 end program test
  46
  47 subroutine test_int (a, b, c, d, e, f, g, h, i, j, k, l, m, n, o) bind(c)
  48   use, intrinsic :: iso_c_binding, only : c_signed_char
  49   implicit none
  50   integer(c_signed_char), value :: a, b, c, d, e, f, g, h, i, j, k, l, m, n, o
  51
  52   if (a /= iachar('a')) stop 1
  53   if (b /= iachar('b')) stop 2
  54   if (c /= iachar('c')) stop 3
  55   if (d /= iachar('d')) stop 4
  56   if (e /= iachar('e')) stop 5
  57   if (f /= iachar('f')) stop 6
  58   if (g /= iachar('g')) stop 7
  59   if (h /= iachar('h')) stop 8
  60   if (i /= iachar('i')) stop 9
  61   if (j /= iachar('j')) stop 10
  62   if (k /= iachar('k')) stop 11
  63   if (l /= iachar('l')) stop 12
  64   if (m /= iachar('m')) stop 13
  65   if (n /= iachar('n')) stop 14
  66   if (o /= iachar('o')) stop 15
  67 end subroutine
  68
  69 subroutine test_char (a, b, c, d, e, f, g, h, i, j, k, l, m, n, o) bind(c)
  70   use, intrinsic :: iso_c_binding, only : c_char
  71   implicit none
  72   character(kind=c_char, len=1), value :: a, b, c, d, e, f, g, h, i, j, k, l, m, n, o
  73
  74   if (a /= 'a') stop 101
  75   if (b /= 'b') stop 102
  76   if (c /= 'c') stop 103
  77   if (d /= 'd') stop 104
  78   if (e /= 'e') stop 105
  79   if (f /= 'f') stop 106
  80   if (g /= 'g') stop 107
  81   if (h /= 'h') stop 108
  82   if (i /= 'i') stop 109
  83   if (j /= 'j') stop 110
  84   if (k /= 'k') stop 111
  85   if (l /= 'l') stop 112
  86   if (m /= 'm') stop 113
  87   if (n /= 'n') stop 114
  88   if (o /= 'o') stop 115
  89 end subroutine
  90