gcc/testsuite/gfortran.dg/c_char_tests_3.f90

   1 ! { dg-do run }
   2 ! { dg-additional-sources c_char_tests_3_c.c }
   3 !
   4 ! PR fortran/103828
   5 ! Check that we can pass many function args as C char, which are interoperable
   6 ! with both INTEGER(C_SIGNED_CHAR) and CHARACTER(C_CHAR).
   7
   8 subroutine test_int (a, b, c, d, e, f, g, h, i, j, k, l, m, n, o) bind(c)
   9   use, intrinsic :: iso_c_binding
  10   implicit none
  11   integer(c_signed_char), value :: a, b, c, d, e, f, g, h, i, j, k, l, m, n, o
  12
  13   if (a /= iachar('a')) stop 1
  14   if (b /= iachar('b')) stop 2
  15   if (c /= iachar('c')) stop 3
  16   if (d /= iachar('d')) stop 4
  17   if (e /= iachar('e')) stop 5
  18   if (f /= iachar('f')) stop 6
  19   if (g /= iachar('g')) stop 7
  20   if (h /= iachar('h')) stop 8
  21   if (i /= iachar('i')) stop 9
  22   if (j /= iachar('j')) stop 10
  23   if (k /= iachar('k')) stop 11
  24   if (l /= iachar('l')) stop 12
  25   if (m /= iachar('m')) stop 13
  26   if (n /= iachar('n')) stop 14
  27   if (o /= iachar('o')) stop 15
  28 end subroutine
  29
  30 subroutine test_char (a, b, c, d, e, f, g, h, i, j, k, l, m, n, o) bind(c)
  31   use, intrinsic :: iso_c_binding
  32   implicit none
  33   character(kind=c_char, len=1), value :: a, b, c, d, e, f, g, h, i, j, k, l, m, n, o
  34
  35   if (a /= 'a') stop 101
  36   if (b /= 'b') stop 102
  37   if (c /= 'c') stop 103
  38   if (d /= 'd') stop 104
  39   if (e /= 'e') stop 105
  40   if (f /= 'f') stop 106
  41   if (g /= 'g') stop 107
  42   if (h /= 'h') stop 108
  43   if (i /= 'i') stop 109
  44   if (j /= 'j') stop 110
  45   if (k /= 'k') stop 111
  46   if (l /= 'l') stop 112
  47   if (m /= 'm') stop 113
  48   if (n /= 'n') stop 114
  49   if (o /= 'o') stop 115
  50 end subroutine
  51