| ! PR 101305 |
| ! PR 100917 |
| ! xfailed due to PR 101308 |
| ! { dg-do run { xfail *-*-* } } |
| ! { dg-additional-sources "typecodes-scalar-basic-c.c dump-descriptors.c" } |
| ! { dg-additional-options "-g" } |
| ! |
| ! This program tests that kind constants in the ISO_C_BINDING |
| ! module result in the right type field in arguments passed by descriptor, |
| ! also matching the size of the corresponding C type. We use pointers |
| ! to force the use of a descriptor. |
| ! |
| ! Some types are tested in their own testcases to allow conditionalization |
| ! for target-specific support or xfailing to track bugs. |
| |
| module mm |
| use iso_c_binding |
| |
| type, bind (c) :: s |
| integer(C_INT) :: i, j |
| end type |
| end module |
| |
| program testit |
| use iso_c_binding |
| use mm |
| implicit none |
| |
| interface |
| |
| subroutine ctest_int1 (arg_int, arg_short, arg_long, arg_long_long, & |
| arg_signed_char) bind (c) |
| use iso_c_binding |
| integer(C_INT), pointer :: arg_int |
| integer(C_SHORT), pointer :: arg_short |
| integer(C_LONG), pointer :: arg_long |
| integer(C_LONG_LONG), pointer :: arg_long_long |
| integer(C_SIGNED_CHAR), pointer :: arg_signed_char |
| end subroutine |
| |
| subroutine ctest_int2 (arg_int8, arg_int16, arg_int32, arg_int64) bind (c) |
| use iso_c_binding |
| integer(C_INT8_T), pointer :: arg_int8 |
| integer(C_INT16_T), pointer :: arg_int16 |
| integer(C_INT32_T), pointer :: arg_int32 |
| integer(C_INT64_T), pointer :: arg_int64 |
| end subroutine |
| |
| subroutine ctest_int3 (arg_least8, arg_least16, arg_least32, & |
| arg_least64) bind (c) |
| use iso_c_binding |
| integer(C_INT_LEAST8_T), pointer :: arg_least8 |
| integer(C_INT_LEAST16_T), pointer :: arg_least16 |
| integer(C_INT_LEAST32_T), pointer :: arg_least32 |
| integer(C_INT_LEAST64_T), pointer :: arg_least64 |
| end subroutine |
| |
| subroutine ctest_int4 (arg_fast8, arg_fast16, arg_fast32, & |
| arg_fast64) bind (c) |
| use iso_c_binding |
| integer(C_INT_FAST8_T), pointer :: arg_fast8 |
| integer(C_INT_FAST16_T), pointer :: arg_fast16 |
| integer(C_INT_FAST32_T), pointer :: arg_fast32 |
| integer(C_INT_FAST64_T), pointer :: arg_fast64 |
| end subroutine |
| |
| subroutine ctest_int5 (arg_size, arg_intmax, arg_intptr, & |
| arg_ptrdiff) bind (c) |
| use iso_c_binding |
| integer(C_SIZE_T), pointer :: arg_size |
| integer(C_INTMAX_T), pointer :: arg_intmax |
| integer(C_INTPTR_T), pointer :: arg_intptr |
| integer(C_PTRDIFF_T), pointer :: arg_ptrdiff |
| end subroutine |
| |
| subroutine ctest_real (arg_float, arg_double) bind (c) |
| use iso_c_binding |
| real(C_FLOAT), pointer :: arg_float |
| real(C_DOUBLE), pointer :: arg_double |
| end subroutine |
| |
| subroutine ctest_complex (arg_float_complex, arg_double_complex) & |
| bind (c) |
| use iso_c_binding |
| complex(C_FLOAT_COMPLEX), pointer :: arg_float_complex |
| complex(C_DOUBLE_COMPLEX), pointer :: arg_double_complex |
| end subroutine |
| |
| subroutine ctest_misc (arg_bool, arg_cptr, arg_cfunptr, arg_struct) & |
| bind (c) |
| use iso_c_binding |
| use mm |
| logical(C_BOOL), pointer :: arg_bool |
| type(C_PTR), pointer :: arg_cptr |
| type(C_FUNPTR), pointer :: arg_cfunptr |
| type(s), pointer :: arg_struct |
| end subroutine |
| |
| end interface |
| |
| integer(C_INT), pointer :: var_int |
| integer(C_SHORT), pointer :: var_short |
| integer(C_LONG), pointer :: var_long |
| integer(C_LONG_LONG), pointer :: var_long_long |
| integer(C_SIGNED_CHAR), pointer :: var_signed_char |
| integer(C_INT8_T), pointer :: var_int8 |
| integer(C_INT16_T), pointer :: var_int16 |
| integer(C_INT32_T), pointer :: var_int32 |
| integer(C_INT64_T), pointer :: var_int64 |
| integer(C_INT_LEAST8_T), pointer :: var_least8 |
| integer(C_INT_LEAST16_T), pointer :: var_least16 |
| integer(C_INT_LEAST32_T), pointer :: var_least32 |
| integer(C_INT_LEAST64_T), pointer :: var_least64 |
| integer(C_INT_FAST8_T), pointer :: var_fast8 |
| integer(C_INT_FAST16_T), pointer :: var_fast16 |
| integer(C_INT_FAST32_T), pointer :: var_fast32 |
| integer(C_INT_FAST64_T), pointer :: var_fast64 |
| integer(C_SIZE_T), pointer :: var_size |
| integer(C_INTMAX_T), pointer :: var_intmax |
| integer(C_INTPTR_T), pointer :: var_intptr |
| integer(C_PTRDIFF_T), pointer :: var_ptrdiff |
| real(C_FLOAT), pointer :: var_float |
| real(C_DOUBLE), pointer :: var_double |
| complex(C_FLOAT_COMPLEX), pointer :: var_float_complex |
| complex(C_DOUBLE_COMPLEX), pointer :: var_double_complex |
| logical(C_BOOL), pointer :: var_bool |
| type(C_PTR), pointer :: var_cptr |
| type(C_FUNPTR), pointer :: var_cfunptr |
| type(s), pointer :: var_struct |
| |
| nullify (var_int, var_short, var_long, var_long_long, var_signed_char) |
| call ctest_int1 (var_int, var_short, var_long, var_long_long, & |
| var_signed_char) |
| |
| nullify (var_int8, var_int16, var_int32, var_int64) |
| call ctest_int2 (var_int8, var_int16, var_int32, var_int64) |
| |
| nullify (var_least8, var_least16, var_least32, var_least64) |
| call ctest_int3 (var_least8, var_least16, var_least32, var_least64) |
| |
| nullify (var_fast8, var_fast16, var_fast32, var_fast64) |
| call ctest_int4 (var_fast8, var_fast16, var_fast32, var_fast64) |
| |
| nullify (var_size, var_intmax, var_intptr, var_ptrdiff) |
| call ctest_int5 (var_size, var_intmax, var_intptr, var_ptrdiff) |
| |
| nullify (var_float, var_double) |
| call ctest_real (var_float, var_double) |
| |
| nullify (var_float_complex, var_double_complex) |
| call ctest_complex (var_float_complex, var_double_complex) |
| |
| nullify (var_bool, var_cptr, var_cfunptr, var_struct) |
| call ctest_misc (var_bool, var_cptr, var_cfunptr, var_struct) |
| |
| ! FIXME: how do you pass something that corresponds to CFI_type_other? |
| ! The Fortran front end complains if you try to pass something that |
| ! isn't interoperable, such as a derived type object without bind(c). |
| |
| end program |