I recently started experimenting with the Nvidia nvfortran
compiler. I have some code that make use of the C-Fortran interop features and the CFI_cdesc_t
descriptor. I immediately noticed some peculiar behavior, and would like to hear with this community what your opinion are.
I have a C++ routine that print the type of a C-interop array from Fortran:
#include <ISO_Fortran_binding.h>
#include <iostream>
#include <cassert>
extern "C" {
void check_array(CFI_cdesc_t* data) {
std::cout << "data->type: " << static_cast<int>(data->type) << std::endl;
// Some implementations does noty differ between different identical integer types
if (data->type == CFI_type_int) {
std::cout << "Type: int" << std::endl;
}
if (data->type == CFI_type_long) {
std::cout << "Type: long" << std::endl;
}
if (data->type == CFI_type_long_long) {
std::cout << "Type: long long" << std::endl;
}
if (data->type == CFI_type_int32_t) {
std::cout << "Type: int32_t" << std::endl;
}
if (data->type == CFI_type_int64_t) {
std::cout << "Type: int64_t" << std::endl;
}
if (data->type == CFI_type_float) {
std::cout << "Type: float" << std::endl;
}
if (data->type == CFI_type_double) {
std::cout << "Type: double" << std::endl;
}
}
}
With the accompanying Fortran program:
PROGRAM main
USE, INTRINSIC :: ISO_C_BINDING
USE, INTRINSIC :: ISO_FORTRAN_ENV
IMPLICIT NONE
INTERFACE
SUBROUTINE check_array(res) BIND(C)
TYPE(*), INTENT(in) :: res(:)
END SUBROUTINE check_array
END INTERFACE
INTEGER :: default_integer(1)
INTEGER(c_int) :: c_int_integer(1)
INTEGER(c_long) :: c_long_integer(1)
INTEGER(c_long_long) :: c_long_long_integer(1)
INTEGER(c_int32_t) :: c_int32_t_integer(1)
INTEGER(c_int64_t) :: c_int64_t_integer(1)
INTEGER(int32) :: int32_integer(1)
INTEGER(int64) :: int64_integer(1)
WRITE(*, '("Size of default_integer: ", I0)') C_SIZEOF(default_integer(1))
CALL check_array(default_integer)
WRITE(*, '()')
WRITE(*, '("Size of c_int_integer: ", I0)') C_SIZEOF(c_int_integer(1))
CALL check_array(c_int_integer)
WRITE(*, '()')
WRITE(*, '("Size of c_long_integer: ", I0)') C_SIZEOF(c_long_integer(1))
CALL check_array(c_long_integer)
WRITE(*, '()')
WRITE(*, '("Size of c_long_long_integer: ", I0)') C_SIZEOF(c_long_long_integer(1))
CALL check_array(c_long_long_integer)
WRITE(*, '()')
WRITE(*, '("Size of c_int32_t_integer: ", I0)') C_SIZEOF(c_int32_t_integer(1))
CALL check_array(c_int32_t_integer)
WRITE(*, '()')
WRITE(*, '("Size of c_int64_t: ", I0)') C_SIZEOF(c_int64_t_integer(1))
CALL check_array(c_int64_t_integer)
WRITE(*, '()')
WRITE(*, '("Size of int32_integer: ", I0)') C_SIZEOF(int32_integer(1))
CALL check_array(int32_integer)
WRITE(*, '()')
WRITE(*, '("Size of int64_integer: ", I0)') C_SIZEOF(int64_integer(1))
CALL check_array(int64_integer)
WRITE(*, '()')
END PROGRAM main
Basically, I tried compilers from GNU, Intel, NAG and Nvidia. They fall in two categories: GNU, Intel and NAG gives output like:
Size of default_integer: 4
data->type: 1025
Type: int
Type: int32_t
Size of c_int_integer: 4
data->type: 1025
Type: int
Type: int32_t
Size of c_long_integer: 8
data->type: 2049
Type: long
Type: long long
Type: int64_t
Size of c_long_long_integer: 8
data->type: 2049
Type: long
Type: long long
Type: int64_t
Size of c_int32_t_integer: 4
data->type: 1025
Type: int
Type: int32_t
Size of c_int64_t: 8
data->type: 2049
Type: long
Type: long long
Type: int64_t
Size of int32_integer: 4
data->type: 1025
Type: int
Type: int32_t
Size of int64_integer: 8
data->type: 2049
Type: long
Type: long long
Type: int64_t
This example is output from Gfortran/G++ version 12. Besides the actual value of the data->type
which is implementation dependent, both Intel and NAG gives the same output. The key of this is that the c_int
kind, which should be interoperable with int
in C is of type CFI_type_int
and CFI_type_int32_t
at the same time, because CFI_type_int == CFI_type_int32_t
.
With nvfortran
and nvc++
I get a different result:
Size of default_integer: 4
data->type: 9
Type: int32_t
Size of c_int_integer: 4
data->type: 9
Type: int32_t
Size of c_long_integer: 8
data->type: 10
Type: int64_t
Size of c_long_long_integer: 8
data->type: 10
Type: int64_t
Size of c_int32_t_integer: 4
data->type: 9
Type: int32_t
Size of c_int64_t: 8
data->type: 10
Type: int64_t
Size of int32_integer: 4
data->type: 9
Type: int32_t
Size of int64_integer: 8
data->type: 10
Type: int64_t
As you see, the different integers from Fortran all map to either int32_t or int64_t. So if I have a check in my program:
assert (data->type == CFI_type_int);
this will always fail.
I find it peculiar that the type you get when you pass an c_int
from Fortran to C is not equal to CFI_type_int
… Any opinions on this?
An additional observation is that the header file ISO_Fortran_binding.h
provided by the Nvidia nvfortran
compiler is very similar to that from the (new) Flang compiler in the LLVM repo. All the symbols and definitions seem to be the same. I do not have access to the new Flang right away, if any of you have it it would be interesting if you could run my example.