Hello,
For illustration purpose I wanted to change the lower bound of an already allocated array, by using the C interoperabily and by directly modifying the array descriptor from C (I know we are not supposed to do that, but it is also supposed to work).
It works as expected if I pass directly the allocatable array to a C routine.
But for some reason, on the C side I want to encapsulate the array descriptor in another structure, and on the Fortran side manipulate only an opaque handle to this structure. But then it doesn’t work and I don’t get why… On the C side I can check that the address of the array descriptor is the right one, so what goes wrong?
I’ve made a MRE:
The Fortran part:
PROGRAM foo
USE iso_c_binding
implicit none
INTERFACE
subroutine fcsetlb(a,lb) bind(C)
import c_float, c_int
real(c_float), allocatable, intent(inout) :: a(:)
integer(c_int), intent(in) :: lb
end subroutine
subroutine fcbind(h,a) bind(C)
import c_ptr, c_float
type(c_ptr), intent(inout) :: h
real(c_float), allocatable, intent(in) :: a(:)
end subroutine
subroutine fcsetlb_h(h,lb) bind(C)
import c_ptr, c_int
type(c_ptr), intent(inout) :: h
integer(c_int), intent(in) :: lb
end subroutine
END INTERFACE
real, allocatable :: a(:)
type(c_ptr) :: h
allocate( a(10) )
print*, "=== SETTING THE LB DIRECTLY ==="
call fcsetlb(a,5)
print*, "F: visible lower bound =", lbound(a)
print*, "=== SETTING THE LB THROUGH A HANDLE ==="
call fcbind(h,a) ! h is a handle to a C structure that encapsulates the array
call fcsetlb_h(h,-5)
print*, "F: visible lower bound =", lbound(a)
END
The C(++) part:
#include <cstdlib>
#include <cstdio>
#include <ISO_Fortran_binding.h>
// receives a pointer to the array descriptor and updates the LB
extern "C"
void fcsetlb(CFI_cdesc_t* a, int* lb) {
a->dim[0].lower_bound = *lb;
printf(" C: address of the array descriptor = %p\n",a);
printf(" C: lower bound component set to %d\n", a->dim[0].lower_bound);
}
// structure that encapsulates a pointer to the array descriptor
struct fooh {
CFI_cdesc_t* a;
};
// allocates the structure, and binds the array descriptor to it
extern "C"
void fcbind(fooh** h, CFI_cdesc_t* a) {
*h = (fooh*)malloc(sizeof(fooh));
(*h)->a = a;
}
// receives a handle to the structure and updates the LB of the binded array descriptor
extern "C"
void fcsetlb_h(fooh** h, int* lb) {
(*h)->a->dim[0].lower_bound = *lb;
printf(" C: address of the array descriptor = %p\n",(*h)->a);
printf(" C: lower bound component set to %d\n", (*h)->a->dim[0].lower_bound);
}
The output:
$ g++ -c ccc.cpp && gfortran -c fff.f90 && g++ ccc.o fff.o -lgfortran && ./a.out
=== SETTING THE LB DIRECTLY ===
C: address of the array descriptor = 0x7ffee2110880
C: lower bound component set to 5
F: visible lower bound = 5
=== SETTING THE LB THROUGH A HANDLE ===
C: address of the array descriptor = 0x7ffee2110880
C: lower bound component set to -5
F: visible lower bound = 5
iMac:FCVEC pierre$