Sample Fortran Wrappers

This chapter gives details of the generated code. It’s intended for users who want to understand the details of how the wrappers are created.

All of these examples are derived from tests in the regression directory.

No Arguments

C library function in clibrary.c:

void NoReturnNoArguments(void)
{
    strncpy(last_function_called, "Function1", MAXLAST);
    return;
}

clibrary.yaml:

- decl: void NoReturnNoArguments()

Fortran calls C via the following interface:

interface
    subroutine no_return_no_arguments() &
            bind(C, name="NoReturnNoArguments")
        implicit none
    end subroutine no_return_no_arguments
end interface

If wrapping a C++ library, a function with a C API will be created that Fortran can call.

void TUT_NoReturnNoArguments(void)
{
    // splicer begin function.NoReturnNoArguments
    tutorial::NoReturnNoArguments();
    // splicer end function.NoReturnNoArguments
}

Fortran usage:

use tutorial_mod
call no_return_no_arguments

The C++ usage is similar:

#include "tutorial.hpp"

tutorial::NoReturnNoArguments();

Numeric Types

PassByValue

C library function in clibrary.c:

double PassByValue(double arg1, int arg2)
{
    strncpy(last_function_called, "PassByValue", MAXLAST);
    return arg1 + arg2;
}

clibrary.yaml:

- decl: double PassByValue(double arg1, int arg2)

Both types are supported directly by the iso_c_binding module so there is no need for a Fortran function. The C function can be called directly by the Fortran interface using the bind(C) keyword.

Fortran calls C via the following interface:

interface
    function pass_by_value(arg1, arg2) &
            result(SHT_rv) &
            bind(C, name="PassByValue")
        use iso_c_binding, only : C_DOUBLE, C_INT
        implicit none
        real(C_DOUBLE), value, intent(IN) :: arg1
        integer(C_INT), value, intent(IN) :: arg2
        real(C_DOUBLE) :: SHT_rv
    end function pass_by_value
end interface

Fortran usage:

real(C_DOUBLE) :: rv_double
rv_double = pass_by_value(1.d0, 4)
call assert_true(rv_double == 5.d0)

PassByReference

C library function in clibrary.c:

void PassByReference(double *arg1, int *arg2)
{
    strncpy(last_function_called, "PassByReference", MAXLAST);
    *arg2 = *arg1;
}

clibrary.yaml:

- decl: void PassByReference(double *arg1+intent(in), int *arg2+intent(out))

Fortran calls C via the following interface:

interface
    subroutine pass_by_reference(arg1, arg2) &
            bind(C, name="PassByReference")
        use iso_c_binding, only : C_DOUBLE, C_INT
        implicit none
        real(C_DOUBLE), intent(IN) :: arg1
        integer(C_INT), intent(OUT) :: arg2
    end subroutine pass_by_reference
end interface

Example usage:

integer(C_INT) var
call pass_by_reference(3.14d0, var)
call assert_equals(3, var)

Sum

C++ library function from pointers.cpp:

void Sum(int len, const int *values, int *result)
{
    int sum = 0;
    for (int i=0; i < len; i++) {
	sum += values[i];
    }
    *result = sum;
    return;
}

pointers.yaml:

- decl: void Sum(int len +implied(size(values)),
                 int *values +rank(1)+intent(in),
                 int *result +intent(out))

The POI prefix to the function names is derived from the format field C_prefix which defaults to the first three letters of the library field, in this case pointers. This is a C++ file which provides a C API via extern "C".

wrappointers.cpp:

int POI_sumFixedArray(void)
{
    // splicer begin function.sumFixedArray
    int SHC_rv = sumFixedArray();
    return SHC_rv;
    // splicer end function.sumFixedArray
}

Fortran calls C via the following interface:

interface
    subroutine c_sum(len, values, result) &
            bind(C, name="POI_Sum")
        use iso_c_binding, only : C_INT
        implicit none
        integer(C_INT), value, intent(IN) :: len
        integer(C_INT), intent(IN) :: values(*)
        integer(C_INT), intent(OUT) :: result
    end subroutine c_sum
end interface

The Fortran wrapper:

interface
    function sum_fixed_array() &
            result(SHT_rv) &
            bind(C, name="POI_sumFixedArray")
        use iso_c_binding, only : C_INT
        implicit none
        integer(C_INT) :: SHT_rv
    end function sum_fixed_array
end interface

Example usage:

integer(C_INT) rv_int
call sum([1,2,3,4,5], rv_int)
call assert_true(rv_int .eq. 15, "sum")

truncate_to_int

Sometimes it is more convenient to have the wrapper allocate an intent(out) array before passing it to the C++ function. This can be accomplished by adding the deref(allocatable) attribute.

C++ library function from pointers.c:

void truncate_to_int(double *in, int *out, int size)
{
    int i;
    for(i = 0; i < size; i++) {
        out[i] = in[i];
    }
}

pointers.yaml:

- decl: void truncate_to_int(double * in     +intent(in)  +rank(1),
                             int *    out    +intent(out)
                                             +deref(allocatable)+dimension(size(in)),
                             int      sizein +implied(size(in)))

Fortran calls C via the following interface:

interface
    subroutine c_truncate_to_int(in, out, sizein) &
            bind(C, name="truncate_to_int")
        use iso_c_binding, only : C_DOUBLE, C_INT
        implicit none
        real(C_DOUBLE), intent(IN) :: in(*)
        integer(C_INT), intent(OUT) :: out(*)
        integer(C_INT), value, intent(IN) :: sizein
    end subroutine c_truncate_to_int
end interface

The Fortran wrapper:

subroutine truncate_to_int(in, out)
    use iso_c_binding, only : C_DOUBLE, C_INT
    real(C_DOUBLE), intent(IN) :: in(:)
    integer(C_INT), intent(OUT) :: out(:)
    integer(C_INT) :: SH_sizein
    ! splicer begin function.truncate_to_int
    SH_sizein = size(in,kind=C_INT)
    call c_truncate_to_int(in, out, SH_sizein)
    ! splicer end function.truncate_to_int
end subroutine truncate_to_int

Example usage:

integer(c_int), allocatable :: out_int(:)
call truncate_to_int([1.2d0, 2.3d0, 3.4d0, 4.5d0], out_int)

Numeric Pointers

getRawPtrToFixedArray

C++ library function from pointers.c:

void getRawPtrToFixedArray(int **count)
{
    *count = (int *) &global_fixed_array;
}

pointers.yaml:

- decl: void getRawPtrToFixedArray(int **count+intent(out)+deref(raw))

Fortran calls C via the following interface:

interface
    subroutine get_raw_ptr_to_fixed_array(count) &
            bind(C, name="getRawPtrToFixedArray")
        use iso_c_binding, only : C_PTR
        implicit none
        type(C_PTR), intent(OUT) :: count
    end subroutine get_raw_ptr_to_fixed_array
end interface

Example usage:

type(C_PTR) :: cptr_array
call get_raw_ptr_to_fixed_array(cptr_array)

getPtrToScalar

C++ library function from pointers.c:

void getPtrToScalar(int **nitems)
{
    *nitems = &global_int;
}

pointers.yaml:

- decl: void getPtrToScalar(int **nitems+intent(out))

This is a C file which provides the bufferify function.

wrappointers.c:

void POI_getPtrToScalar_bufferify(POI_SHROUD_array *SHT_nitems_cdesc)
{
    // splicer begin function.getPtrToScalar_bufferify
    int *nitems;
    getPtrToScalar(&nitems);
    SHT_nitems_cdesc->cxx.addr  = nitems;
    SHT_nitems_cdesc->cxx.idtor = 0;
    SHT_nitems_cdesc->addr.base = nitems;
    SHT_nitems_cdesc->type = SH_TYPE_INT;
    SHT_nitems_cdesc->elem_len = sizeof(int);
    SHT_nitems_cdesc->rank = 0;
    SHT_nitems_cdesc->size = 1;
    // splicer end function.getPtrToScalar_bufferify
}

Fortran calls C via the following interface:

interface
    subroutine c_get_ptr_to_scalar(nitems) &
            bind(C, name="getPtrToScalar")
        use iso_c_binding, only : C_PTR
        implicit none
        type(C_PTR), intent(OUT) :: nitems
    end subroutine c_get_ptr_to_scalar
end interface

The Fortran wrapper:

subroutine get_ptr_to_scalar(nitems)
    use iso_c_binding, only : C_INT, c_f_pointer
    integer(C_INT), intent(OUT), pointer :: nitems
    ! splicer begin function.get_ptr_to_scalar
    type(POI_SHROUD_array) :: SHT_nitems_cdesc
    call c_get_ptr_to_scalar_bufferify(SHT_nitems_cdesc)
    call c_f_pointer(SHT_nitems_cdesc%base_addr, nitems)
    ! splicer end function.get_ptr_to_scalar
end subroutine get_ptr_to_scalar

Assigning to iscalar will modify the C++ variable. Example usage:

integer(C_INT), pointer :: iscalar
call get_ptr_to_scalar(iscalar)
iscalar = 0

getPtrToDynamicArray

C++ library function from pointers.c:

void getPtrToDynamicArray(int **count, int *len)
{
    *count = (int *) &global_fixed_array;
    *len = sizeof(global_fixed_array)/sizeof(int);
}

pointers.yaml:

- decl: void getPtrToDynamicArray(int **count+intent(out)+dimension(ncount),
                                  int *ncount+intent(out)+hidden)

This is a C file which provides the bufferify function.

wrappointers.c:

void POI_getPtrToDynamicArray_bufferify(
    POI_SHROUD_array *SHT_count_cdesc)
{
    // splicer begin function.getPtrToDynamicArray_bufferify
    int *count;
    int ncount;
    getPtrToDynamicArray(&count, &ncount);
    SHT_count_cdesc->cxx.addr  = count;
    SHT_count_cdesc->cxx.idtor = 0;
    SHT_count_cdesc->addr.base = count;
    SHT_count_cdesc->type = SH_TYPE_INT;
    SHT_count_cdesc->elem_len = sizeof(int);
    SHT_count_cdesc->rank = 1;
    SHT_count_cdesc->shape[0] = ncount;
    SHT_count_cdesc->size = SHT_count_cdesc->shape[0];
    // splicer end function.getPtrToDynamicArray_bufferify
}

Fortran calls C via the following interface:

interface
    subroutine c_get_ptr_to_dynamic_array(count, ncount) &
            bind(C, name="getPtrToDynamicArray")
        use iso_c_binding, only : C_INT, C_PTR
        implicit none
        type(C_PTR), intent(OUT) :: count
        integer(C_INT), intent(OUT) :: ncount
    end subroutine c_get_ptr_to_dynamic_array
end interface

The Fortran wrapper:

subroutine get_ptr_to_dynamic_array(count)
    use iso_c_binding, only : C_INT, c_f_pointer
    integer(C_INT), intent(OUT), pointer :: count(:)
    ! splicer begin function.get_ptr_to_dynamic_array
    type(POI_SHROUD_array) :: SHT_count_cdesc
    call c_get_ptr_to_dynamic_array_bufferify(SHT_count_cdesc)
    call c_f_pointer(SHT_count_cdesc%base_addr, count, &
        SHT_count_cdesc%shape(1:1))
    ! splicer end function.get_ptr_to_dynamic_array
end subroutine get_ptr_to_dynamic_array

Assigning to iarray will modify the C++ variable. Example usage:

integer(C_INT), pointer :: iarray(:)
call get_ptr_to_dynamic_array(iarray)
iarray = 0

getRawPtrToInt2d

global_int2d is a two dimensional array of non-contiguous rows. C stores the address of each row. Shroud can only deal with this as a type(C_PTR) and expects the user to dereference the address.

C++ library function from pointers.c:

static int global_int2d_1[] = {1,2,3};
static int global_int2d_2[] = {4,5};
static int *global_int2d[] = {global_int2d_1, global_int2d_2};

void getRawPtrToInt2d(int ***arg)
{
    *arg = (int **) global_int2d;
}

pointers.yaml:

- decl: void getRawPtrToInt2d(int ***arg +intent(out))

Fortran calls C via the following interface:

interface
    subroutine get_raw_ptr_to_int2d(arg) &
            bind(C, name="getRawPtrToInt2d")
        use iso_c_binding, only : C_PTR
        implicit none
        type(C_PTR), intent(OUT) :: arg
    end subroutine get_raw_ptr_to_int2d
end interface

Example usage:

type(C_PTR) :: addr
type(C_PTR), pointer :: array2d(:)
integer(C_INT), pointer :: row1(:), row2(:)
integer total

call get_raw_ptr_to_int2d(addr)

! Dereference the pointers into two 1d arrays.
call c_f_pointer(addr, array2d, [2])
call c_f_pointer(array2d(1), row1, [3])
call c_f_pointer(array2d(2), row2, [2])

total = row1(1) + row1(2) + row1(3) + row2(1) + row2(2)
call assert_equals(15, total)

checkInt2d

Example of using the type(C_PTR) returned getRawPtrToInt2d.

pointers.yaml:

- decl: int checkInt2d(int **arg +intent(in))

Fortran calls C via the following interface. Note the use of VALUE attribute.

interface
    function check_int2d(arg) &
            result(SHT_rv) &
            bind(C, name="checkInt2d")
        use iso_c_binding, only : C_INT, C_PTR
        implicit none
        type(C_PTR), intent(IN), value :: arg
        integer(C_INT) :: SHT_rv
    end function check_int2d
end interface

Example usage:

type(C_PTR) :: addr
integer total

call get_raw_ptr_to_int2d(addr)
total = check_int2d(addr)
call assert_equals(15, total)

getMinMax

No Fortran function is created. Only an interface to a C wrapper which dereference the pointers so they can be treated as references.

C++ library function in tutorial.cpp:

void getMinMax(int &min, int &max)
{
  min = -1;
  max = 100;
}

tutorial.yaml:

- decl: void getMinMax(int &min +intent(out), int &max +intent(out))

The C wrapper:

void TUT_getMinMax(int * min, int * max)
{
    // splicer begin function.getMinMax
    tutorial::getMinMax(*min, *max);
    // splicer end function.getMinMax
}

Fortran calls C via the following interface:

interface
    subroutine get_min_max(min, max) &
            bind(C, name="TUT_getMinMax")
        use iso_c_binding, only : C_INT
        implicit none
        integer(C_INT), intent(OUT) :: min
        integer(C_INT), intent(OUT) :: max
    end subroutine get_min_max
end interface

Fortran usage:

call get_min_max(minout, maxout)
call assert_equals(-1, minout, "get_min_max minout")
call assert_equals(100, maxout, "get_min_max maxout")

returnIntPtrToScalar

pointers.yaml:

- decl: int *returnIntPtrToScalar(void)

Fortran calls C via the following interface:

interface
    function c_return_int_ptr_to_scalar() &
            result(SHT_rv) &
            bind(C, name="returnIntPtrToScalar")
        use iso_c_binding, only : C_PTR
        implicit none
        type(C_PTR) SHT_rv
    end function c_return_int_ptr_to_scalar
end interface

The Fortran wrapper:

function return_int_ptr_to_scalar() &
        result(SHT_rv)
    use iso_c_binding, only : C_INT, C_PTR, c_f_pointer
    integer(C_INT), pointer :: SHT_rv
    ! splicer begin function.return_int_ptr_to_scalar
    type(C_PTR) :: SHC_rv_ptr
    SHC_rv_ptr = c_return_int_ptr_to_scalar()
    call c_f_pointer(SHC_rv_ptr, SHT_rv)
    ! splicer end function.return_int_ptr_to_scalar
end function return_int_ptr_to_scalar

Example usage:

integer(C_INT), pointer :: irvscalar
irvscalar => return_int_ptr_to_scalar()

returnIntPtrToFixedArray

pointers.yaml:

- decl: int *returnIntPtrToFixedArray(void) +dimension(10)

This is a C file which provides the bufferify function.

wrappointers.c:

void POI_returnIntPtrToFixedArray_bufferify(
    POI_SHROUD_array *SHT_rv_cdesc)
{
    // splicer begin function.returnIntPtrToFixedArray_bufferify
    int * SHC_rv = returnIntPtrToFixedArray();
    SHT_rv_cdesc->cxx.addr  = SHC_rv;
    SHT_rv_cdesc->cxx.idtor = 0;
    SHT_rv_cdesc->addr.base = SHC_rv;
    SHT_rv_cdesc->type = SH_TYPE_INT;
    SHT_rv_cdesc->elem_len = sizeof(int);
    SHT_rv_cdesc->rank = 1;
    SHT_rv_cdesc->shape[0] = 10;
    SHT_rv_cdesc->size = SHT_rv_cdesc->shape[0];
    // splicer end function.returnIntPtrToFixedArray_bufferify
}

Fortran calls C via the following interface:

interface
    subroutine c_return_int_ptr_to_fixed_array_bufferify(SHT_rv) &
            bind(C, name="POI_returnIntPtrToFixedArray_bufferify")
        import :: POI_SHROUD_array
        implicit none
        type(POI_SHROUD_array), intent(OUT) :: SHT_rv
    end subroutine c_return_int_ptr_to_fixed_array_bufferify
end interface

The Fortran wrapper:

function return_int_ptr_to_fixed_array() &
        result(SHT_rv)
    use iso_c_binding, only : C_INT, c_f_pointer
    integer(C_INT), pointer :: SHT_rv(:)
    ! splicer begin function.return_int_ptr_to_fixed_array
    type(POI_SHROUD_array) :: SHT_rv_cdesc
    call c_return_int_ptr_to_fixed_array_bufferify(SHT_rv_cdesc)
    call c_f_pointer(SHT_rv_cdesc%base_addr, SHT_rv, &
        SHT_rv_cdesc%shape(1:1))
    ! splicer end function.return_int_ptr_to_fixed_array
end function return_int_ptr_to_fixed_array

Example usage:

integer(C_INT), pointer :: irvarray(:)
irvarray => return_int_ptr_to_fixed_array()

returnIntScalar

pointers.yaml:

- decl: int *returnIntScalar(void) +deref(scalar)

This is a C file which provides the bufferify function.

wrappointers.c:

int POI_returnIntScalar(void)
{
    // splicer begin function.returnIntScalar
    int * SHC_rv = returnIntScalar();
    return *SHC_rv;
    // splicer end function.returnIntScalar
}

Fortran calls C via the following interface:

interface
    function return_int_scalar() &
            result(SHT_rv) &
            bind(C, name="POI_returnIntScalar")
        use iso_c_binding, only : C_INT
        implicit none
        integer(C_INT) :: SHT_rv
    end function return_int_scalar
end interface

Example usage:

integer :: ivalue
ivalue = return_int_scalar()

returnIntPtrDimPointer

Return a Fortran pointer to an array. The length of the array is returned from C++ in the len argument. This argument sets the hidden attribute since it is not needed in the Fortran wrapper. It will be used in the c_f_pointer call to set the length of the array.

The input is in file ownership.yaml.

- decl: int * ReturnIntPtrDimPointer(int *len+intent(out)+hidden)
  fattrs:
    deref: pointer
    dimension: len

The C wrapper calls the C++ function from an extern C wrapper. In does not hide the len argument. This function does not use the deref attribute.

int * OWN_ReturnIntPtrDimPointer(int * len)
{
    // splicer begin function.ReturnIntPtrDimPointer
    int * SHC_rv = ReturnIntPtrDimPointer(len);
    return SHC_rv;
    // splicer end function.ReturnIntPtrDimPointer
}

The bufferify function passes an argument to contain the meta data of the array. It is written to wrapownership.cpp.

void OWN_ReturnIntPtrDimPointer_bufferify(
    OWN_SHROUD_array *SHT_rv_cdesc)
{
    // splicer begin function.ReturnIntPtrDimPointer_bufferify
    int len;
    int * SHC_rv = ReturnIntPtrDimPointer(&len);
    SHT_rv_cdesc->cxx.addr  = SHC_rv;
    SHT_rv_cdesc->cxx.idtor = 0;
    SHT_rv_cdesc->addr.base = SHC_rv;
    SHT_rv_cdesc->type = SH_TYPE_INT;
    SHT_rv_cdesc->elem_len = sizeof(int);
    SHT_rv_cdesc->rank = 1;
    SHT_rv_cdesc->shape[0] = len;
    SHT_rv_cdesc->size = SHT_rv_cdesc->shape[0];
    // splicer end function.ReturnIntPtrDimPointer_bufferify
}

Fortran calls the bufferify function in wrapfownership.f.

function return_int_ptr_dim_pointer() &
        result(SHT_rv)
    use iso_c_binding, only : C_INT, c_f_pointer
    integer(C_INT), pointer :: SHT_rv(:)
    ! splicer begin function.return_int_ptr_dim_pointer
    type(OWN_SHROUD_array) :: SHT_rv_cdesc
    call c_return_int_ptr_dim_pointer_bufferify(SHT_rv_cdesc)
    call c_f_pointer(SHT_rv_cdesc%base_addr, SHT_rv, &
        SHT_rv_cdesc%shape(1:1))
    ! splicer end function.return_int_ptr_dim_pointer
end function return_int_ptr_dim_pointer

Fortran usage:

integer(C_INT), pointer :: ivalue(:)
integer len

ivalue => return_int_ptr_dim_pointer()
len = size(ivalue)

returnIntPtrDimAlloc

Convert a pointer returned from C++ into a Fortran allocatable array. To do this, memory is allocated in Fortran then the C++ values are copied into it. The advantage is that the user does not have to worry about releasing the C++ memory. The length of the array is returned from C++ in the len argument. This argument sets the hidden attribute since it is not needed in the Fortran wrapper.

The input is in file ownership.yaml.

- decl: int * ReturnIntPtrDimAlloc(int *len+intent(out)+hidden)
  fattrs:
    deref: allocatable
    dimension: len

The C wrapper calls the C++ function from an extern C wrapper. In does not hide the len argument. This function does not use the deref attribute.

int * OWN_ReturnIntPtrDimAlloc(int * len)
{
    // splicer begin function.ReturnIntPtrDimAlloc
    int * SHC_rv = ReturnIntPtrDimAlloc(len);
    return SHC_rv;
    // splicer end function.ReturnIntPtrDimAlloc
}

The bufferify function passes an argument to contain the meta data of the array. It is written to wrapownership.cpp.

void OWN_ReturnIntPtrDimAlloc_bufferify(OWN_SHROUD_array *SHT_rv_cdesc)
{
    // splicer begin function.ReturnIntPtrDimAlloc_bufferify
    int len;
    int * SHC_rv = ReturnIntPtrDimAlloc(&len);
    SHT_rv_cdesc->cxx.addr  = SHC_rv;
    SHT_rv_cdesc->cxx.idtor = 0;
    SHT_rv_cdesc->addr.base = SHC_rv;
    SHT_rv_cdesc->type = SH_TYPE_INT;
    SHT_rv_cdesc->elem_len = sizeof(int);
    SHT_rv_cdesc->rank = 1;
    SHT_rv_cdesc->shape[0] = len;
    SHT_rv_cdesc->size = SHT_rv_cdesc->shape[0];
    // splicer end function.ReturnIntPtrDimAlloc_bufferify
}

Fortran calls the bufferify function in wrapfownership.f.

function return_int_ptr_dim_alloc() &
        result(SHT_rv)
    use iso_c_binding, only : C_INT, C_LOC, C_SIZE_T
    integer(C_INT), allocatable, target :: SHT_rv(:)
    ! splicer begin function.return_int_ptr_dim_alloc
    type(OWN_SHROUD_array) :: SHT_rv_cdesc
    call c_return_int_ptr_dim_alloc_bufferify(SHT_rv_cdesc)
    allocate(SHT_rv(SHT_rv_cdesc%shape(1)))
    call OWN_SHROUD_copy_array(SHT_rv_cdesc, C_LOC(SHT_rv), &
        size(SHT_rv, kind=C_SIZE_T))
    ! splicer end function.return_int_ptr_dim_alloc
end function return_int_ptr_dim_alloc

Fortran usage:

integer(C_INT), allocatable :: ivalue(:)
integer len

ivalue = return_int_ptr_dim_alloc()
len = size(ivalue)

Bool

checkBool

Assignments are done in the Fortran wrapper to convert between logical and logical(C_BOOL).

C library function in clibrary:

void checkBool(const bool arg1, bool *arg2, bool *arg3)
{
    strncpy(last_function_called, "checkBool", MAXLAST);
    *arg2 = ! arg1;
    *arg3 = ! *arg3;
    return;
}

clibrary.yaml:

- decl: void checkBool(const bool arg1,
                       bool *arg2+intent(out),
                       bool *arg3+intent(inout))

Fortran calls C via the following interface:

interface
    subroutine c_check_bool(arg1, arg2, arg3) &
            bind(C, name="checkBool")
        use iso_c_binding, only : C_BOOL
        implicit none
        logical(C_BOOL), value, intent(IN) :: arg1
        logical(C_BOOL), intent(OUT) :: arg2
        logical(C_BOOL), intent(INOUT) :: arg3
    end subroutine c_check_bool
end interface

The Fortran wrapper:

subroutine check_bool(arg1, arg2, arg3)
    use iso_c_binding, only : C_BOOL
    logical, value, intent(IN) :: arg1
    logical, intent(OUT) :: arg2
    logical, intent(INOUT) :: arg3
    ! splicer begin function.check_bool
    logical(C_BOOL) :: SHT_arg1_cxx
    logical(C_BOOL) :: SHT_arg2_cxx
    logical(C_BOOL) :: SHT_arg3_cxx
    SHT_arg1_cxx = arg1  ! coerce to C_BOOL
    SHT_arg3_cxx = arg3  ! coerce to C_BOOL
    call c_check_bool(SHT_arg1_cxx, SHT_arg2_cxx, SHT_arg3_cxx)
    arg2 = SHT_arg2_cxx  ! coerce to logical
    arg3 = SHT_arg3_cxx  ! coerce to logical
    ! splicer end function.check_bool
end subroutine check_bool

Fortran usage:

logical rv_logical, wrk_logical
rv_logical = .true.
wrk_logical = .true.
call check_bool(.true., rv_logical, wrk_logical)
call assert_false(rv_logical)
call assert_false(wrk_logical)

Character

acceptName

Pass a NULL terminated string to a C function. The string will be unchanged.

C library function in clibrary.c:

void acceptName(const char *name)
{
    strncpy(last_function_called, "acceptName", MAXLAST);
}

clibrary.yaml:

- decl: void acceptName(const char *name)

Fortran calls C via the following interface:

interface
    subroutine c_accept_name(name) &
            bind(C, name="acceptName")
        use iso_c_binding, only : C_CHAR
        implicit none
        character(kind=C_CHAR), intent(IN) :: name(*)
    end subroutine c_accept_name
end interface

The Fortran wrapper:

subroutine accept_name(name)
    use iso_c_binding, only : C_NULL_CHAR
    character(len=*), intent(IN) :: name
    ! splicer begin function.accept_name
    call c_accept_name(trim(name)//C_NULL_CHAR)
    ! splicer end function.accept_name
end subroutine accept_name

No C wrapper is required since the Fortran wrapper creates a NULL terminated string by calling the Fortran intrinsic function trim and concatenating C_NULL_CHAR (from iso_c_binding). This can be done since the argument name is const which sets the attribute intent(in).

Fortran usage:

call accept_name("spot")

returnOneName

Pass the pointer to a buffer which the C library will fill. The length of the string is implicitly known by the library to not exceed the library variable MAXNAME.

C library function in clibrary.c:

void returnOneName(char *name1)
{
  strcpy(name1, "bill");
}

clibrary.yaml:

- decl: void returnOneName(char *name1+intent(out)+charlen(MAXNAME))

The C wrapper:

void CLI_returnOneName_bufferify(char *name1, int SHT_name1_len)
{
    // splicer begin function.returnOneName_bufferify
    returnOneName(name1);
    ShroudStrBlankFill(name1, SHT_name1_len);
    // splicer end function.returnOneName_bufferify
}

Fortran calls C via the following interface:

interface
    subroutine c_return_one_name_bufferify(name1, SHT_name1_len) &
            bind(C, name="CLI_returnOneName_bufferify")
        use iso_c_binding, only : C_CHAR, C_INT
        implicit none
        character(kind=C_CHAR), intent(OUT) :: name1(*)
        integer(C_INT), value, intent(IN) :: SHT_name1_len
    end subroutine c_return_one_name_bufferify
end interface

The Fortran wrapper:

subroutine return_one_name(name1)
    use iso_c_binding, only : C_INT
    character(len=*), intent(OUT) :: name1
    ! splicer begin function.return_one_name
    integer(C_INT) SHT_name1_len
    SHT_name1_len = len(name1, kind=C_INT)
    call c_return_one_name_bufferify(name1, SHT_name1_len)
    ! splicer end function.return_one_name
end subroutine return_one_name

Fortran usage:

name1 = " "
call return_one_name(name1)
call assert_equals("bill", name1)

passCharPtr

The function passCharPtr(dest, src) is equivalent to the Fortran statement dest = src:

C++ library function in strings.cpp:

void passCharPtr(char *dest, const char *src)
{
    std::strcpy(dest, src);
}

strings.yaml:

- decl: void passCharPtr(char * dest+intent(out)+charlen(40),
                         const char *src)

The intent of dest must be explicit. It defaults to intent(inout) since it is a pointer. src is implied to be intent(in) since it is const. This single line will create five different wrappers.

The native C version. The only feature this provides to Fortran is the ability to call a C++ function by wrapping it in an extern "C" function. The user is responsible for providing the NULL termination. The result in str will also be NULL terminated instead of blank filled.:

void STR_passCharPtr(char * dest, const char * src)
{
    // splicer begin function.passCharPtr
    passCharPtr(dest, src);
    // splicer end function.passCharPtr
}

The C wrapper:

void STR_passCharPtr_bufferify(char *dest, int SHT_dest_len,
    const char * src)
{
    // splicer begin function.passCharPtr_bufferify
    passCharPtr(dest, src);
    ShroudStrBlankFill(dest, SHT_dest_len);
    // splicer end function.passCharPtr_bufferify
}

Fortran calls C via the following interface:

interface
    subroutine c_pass_char_ptr(dest, src) &
            bind(C, name="STR_passCharPtr")
        use iso_c_binding, only : C_CHAR
        implicit none
        character(kind=C_CHAR), intent(OUT) :: dest(*)
        character(kind=C_CHAR), intent(IN) :: src(*)
    end subroutine c_pass_char_ptr
end interface
interface
    subroutine c_pass_char_ptr_bufferify(dest, SHT_dest_len, src) &
            bind(C, name="STR_passCharPtr_bufferify")
        use iso_c_binding, only : C_CHAR, C_INT
        implicit none
        character(kind=C_CHAR), intent(OUT) :: dest(*)
        integer(C_INT), value, intent(IN) :: SHT_dest_len
        character(kind=C_CHAR), intent(IN) :: src(*)
    end subroutine c_pass_char_ptr_bufferify
end interface

The Fortran wrapper:

subroutine pass_char_ptr(dest, src)
    use iso_c_binding, only : C_INT, C_NULL_CHAR
    character(len=*), intent(OUT) :: dest
    character(len=*), intent(IN) :: src
    ! splicer begin function.pass_char_ptr
    integer(C_INT) SHT_dest_len
    SHT_dest_len = len(dest, kind=C_INT)
    call c_pass_char_ptr_bufferify(dest, SHT_dest_len, &
        trim(src)//C_NULL_CHAR)
    ! splicer end function.pass_char_ptr
end subroutine pass_char_ptr

The function can be called without the user aware that it is written in C++:

character(30) str
call pass_char_ptr(dest=str, src="mouse")

ImpliedTextLen

Pass the pointer to a buffer which the C library will fill. The length of the buffer is passed in ltext. Since Fortran knows the length of CHARACTER variable, the Fortran wrapper does not need to be explicitly told the length of the variable. Instead its value can be defined with the implied attribute.

This can be used to emulate the behavior of most Fortran compilers which will pass an additional, hidden argument which contains the length of a CHARACTER argument.

C library function in clibrary.c:

void ImpliedTextLen(char *text, int ltext)
{
    strncpy(text, "ImpliedTextLen", ltext);
    strncpy(last_function_called, "ImpliedTextLen", MAXLAST);
}

clibrary.yaml:

- decl: void ImpliedTextLen(char *text+intent(out)+charlen(MAXNAME),
                            int ltext+implied(len(text)))

The C wrapper:

void CLI_ImpliedTextLen_bufferify(char *text, int SHT_text_len,
    int ltext)
{
    // splicer begin function.ImpliedTextLen_bufferify
    ImpliedTextLen(text, ltext);
    ShroudStrBlankFill(text, SHT_text_len);
    // splicer end function.ImpliedTextLen_bufferify
}

Fortran calls C via the following interface:

interface
    subroutine c_implied_text_len_bufferify(text, SHT_text_len, &
            ltext) &
            bind(C, name="CLI_ImpliedTextLen_bufferify")
        use iso_c_binding, only : C_CHAR, C_INT
        implicit none
        character(kind=C_CHAR), intent(OUT) :: text(*)
        integer(C_INT), value, intent(IN) :: SHT_text_len
        integer(C_INT), value, intent(IN) :: ltext
    end subroutine c_implied_text_len_bufferify
end interface

The Fortran wrapper:

subroutine implied_text_len(text)
    use iso_c_binding, only : C_INT
    character(len=*), intent(OUT) :: text
    integer(C_INT) :: SH_ltext
    ! splicer begin function.implied_text_len
    integer(C_INT) SHT_text_len
    SHT_text_len = len(text, kind=C_INT)
    SH_ltext = len(text,kind=C_INT)
    call c_implied_text_len_bufferify(text, SHT_text_len, SH_ltext)
    ! splicer end function.implied_text_len
end subroutine implied_text_len

Fortran usage:

character(MAXNAME) name1
call implied_text_len(name1)
call assert_equals("ImpliedTextLen", name1)

acceptCharArrayIn

Arguments of type char ** are assumed to be a list of NULL terminated strings. In Fortran this pattern would be an array of CHARACTER where all strings are the same length. The Fortran variable is converted into the the C version by copying the data then releasing it at the end of the wrapper.

pointers.yaml:

- decl: void acceptCharArrayIn(char **names +intent(in))

This is a C file which provides the bufferify function.

wrappointers.c:

int POI_acceptCharArrayIn_bufferify(const char *names,
    size_t SHT_names_size, int SHT_names_len)
{
    // splicer begin function.acceptCharArrayIn_bufferify
    char **SHCXX_names = ShroudStrArrayAlloc(names, SHT_names_size,
        SHT_names_len);
    int SHC_rv = acceptCharArrayIn(SHCXX_names);
    ShroudStrArrayFree(SHCXX_names, SHT_names_size);
    return SHC_rv;
    // splicer end function.acceptCharArrayIn_bufferify
}

Most of the work is done by the helper function. This converts the Fortran array into NULL terminated strings by copying all of the values:


// helper ShroudStrArrayAlloc
// Copy src into new memory and null terminate.
static char **ShroudStrArrayAlloc(const char *src, int nsrc, int len)
{
   char **rv = malloc(sizeof(char *) * nsrc);
   const char *src0 = src;
   for(int i=0; i < nsrc; ++i) {
      int ntrim = ShroudLenTrim(src0, len);
      char *tgt = malloc(ntrim+1);
      memcpy(tgt, src0, ntrim);
      tgt[ntrim] = '\0';
      rv[i] = tgt;
      src0 += len;
   }
   return rv;
}

Fortran calls C via the following interface:

interface
    function c_accept_char_array_in(names) &
            result(SHT_rv) &
            bind(C, name="acceptCharArrayIn")
        use iso_c_binding, only : C_INT, C_PTR
        implicit none
        type(C_PTR), intent(IN) :: names(*)
        integer(C_INT) :: SHT_rv
    end function c_accept_char_array_in
end interface

The Fortran wrapper:

function accept_char_array_in(names) &
        result(SHT_rv)
    use iso_c_binding, only : C_INT, C_SIZE_T
    character(len=*), intent(IN) :: names(:)
    integer(C_INT) :: SHT_rv
    ! splicer begin function.accept_char_array_in
    SHT_rv = c_accept_char_array_in_bufferify(names, &
        size(names, kind=C_SIZE_T), len(names, kind=C_INT))
    ! splicer end function.accept_char_array_in
end function accept_char_array_in

Example usage:

character(10) :: in(3) = [ &
     "dog       ", &
     "cat       ", &
     "monkey    "  &
     ]
call accept_char_array_in(in)

std::string

acceptStringReference

C++ library function in strings.c:

void acceptStringReference(std::string & arg1)
{
    arg1.append("dog");
}

strings.yaml:

- decl: void acceptStringReference(std::string & arg1)

A reference defaults to intent(inout) and will add both the len and len_trim annotations.

Both generated functions will convert arg into a std::string, call the function, then copy the results back into the argument.

Which will call the C wrapper:

void STR_acceptStringReference(char * arg1)
{
    // splicer begin function.acceptStringReference
    std::string SHCXX_arg1(arg1);
    acceptStringReference(SHCXX_arg1);
    strcpy(arg1, SHCXX_arg1.c_str());
    // splicer end function.acceptStringReference
}

The C wrapper:

void STR_acceptStringReference_bufferify(char *arg1, int SHT_arg1_len)
{
    // splicer begin function.acceptStringReference_bufferify
    std::string SHCXX_arg1(arg1, ShroudLenTrim(arg1, SHT_arg1_len));
    acceptStringReference(SHCXX_arg1);
    ShroudStrCopy(arg1, SHT_arg1_len, SHCXX_arg1.data(),
        SHCXX_arg1.size());
    // splicer end function.acceptStringReference_bufferify
}

An interface for the native C function is also created:

interface
    subroutine c_accept_string_reference(arg1) &
            bind(C, name="STR_acceptStringReference")
        use iso_c_binding, only : C_CHAR
        implicit none
        character(kind=C_CHAR), intent(INOUT) :: arg1(*)
    end subroutine c_accept_string_reference
end interface

Fortran calls C via the following interface:

interface
    subroutine c_accept_string_reference_bufferify(arg1, &
            SHT_arg1_len) &
            bind(C, name="STR_acceptStringReference_bufferify")
        use iso_c_binding, only : C_CHAR, C_INT
        implicit none
        character(kind=C_CHAR), intent(INOUT) :: arg1(*)
        integer(C_INT), value, intent(IN) :: SHT_arg1_len
    end subroutine c_accept_string_reference_bufferify
end interface

The Fortran wrapper:

subroutine accept_string_reference(arg1)
    use iso_c_binding, only : C_INT
    character(len=*), intent(INOUT) :: arg1
    ! splicer begin function.accept_string_reference
    integer(C_INT) SHT_arg1_len
    SHT_arg1_len = len(arg1, kind=C_INT)
    call c_accept_string_reference_bufferify(arg1, SHT_arg1_len)
    ! splicer end function.accept_string_reference
end subroutine accept_string_reference

The important thing to notice is that the pure C version could do very bad things since it does not know how much space it has to copy into. The bufferify version knows the allocated length of the argument. However, since the input argument is a fixed length it may be too short for the new string value:

Fortran usage:

character(30) str
str = "cat"
call accept_string_reference(str)
call assert_true( str == "catdog")

char functions

getCharPtr1

Return a pointer and convert into an ALLOCATABLE CHARACTER variable. The Fortran application is responsible to release the memory. However, this may be done automatically by the Fortran runtime.

C++ library function in strings.cpp:

const char * getCharPtr1()
{
    return static_char;
}

strings.yaml:

- decl: const char * getCharPtr1()

The C wrapper copies all of the metadata into a SHROUD_array struct which is used by the Fortran wrapper:

void STR_getCharPtr1_bufferify(STR_SHROUD_array *SHT_rv_cdesc)
{
    // splicer begin function.getCharPtr1_bufferify
    const char * SHC_rv = getCharPtr1();
    SHT_rv_cdesc->cxx.addr = const_cast<char *>(SHC_rv);
    SHT_rv_cdesc->cxx.idtor = 0;
    SHT_rv_cdesc->addr.ccharp = SHC_rv;
    SHT_rv_cdesc->type = SH_TYPE_OTHER;
    SHT_rv_cdesc->elem_len = SHC_rv == nullptr ? 0 : std::strlen(SHC_rv);
    SHT_rv_cdesc->size = 1;
    SHT_rv_cdesc->rank = 0;
    // splicer end function.getCharPtr1_bufferify
}

Fortran calls C via the following interface:

interface
    subroutine c_get_char_ptr1_bufferify(SHT_rv) &
            bind(C, name="STR_getCharPtr1_bufferify")
        import :: STR_SHROUD_array
        implicit none
        type(STR_SHROUD_array), intent(OUT) :: SHT_rv
    end subroutine c_get_char_ptr1_bufferify
end interface

The Fortran wrapper uses the metadata in DSHF_rv to allocate a CHARACTER variable of the correct length. The helper function SHROUD_copy_string_and_free will copy the results of the C++ function into the return variable:

function get_char_ptr1() &
        result(SHT_rv)
    character(len=:), allocatable :: SHT_rv
    ! splicer begin function.get_char_ptr1
    type(STR_SHROUD_array) :: SHT_rv_cdesc
    call c_get_char_ptr1_bufferify(SHT_rv_cdesc)
    allocate(character(len=SHT_rv_cdesc%elem_len):: SHT_rv)
    call STR_SHROUD_copy_string_and_free(SHT_rv_cdesc, SHT_rv, &
        SHT_rv_cdesc%elem_len)
    ! splicer end function.get_char_ptr1
end function get_char_ptr1

Fortran usage:

character(len=:), allocatable :: str
str = get_char_ptr1()

getCharPtr2

If you know the maximum size of string that you expect the function to return, then the len attribute is used to declare the length. The explicit ALLOCATE is avoided but any result which is longer than the length will be silently truncated.

C++ library function in strings.cpp:

const char * getCharPtr2()
{
    return static_char;
}

strings.yaml:

- decl: const char * getCharPtr2() +len(30)

The C wrapper:

void STR_getCharPtr2_bufferify(char *SHC_rv, int SHT_rv_len)
{
    // splicer begin function.getCharPtr2_bufferify
    const char * SHCXX_rv = getCharPtr2();
    ShroudStrCopy(SHC_rv, SHT_rv_len, SHCXX_rv, -1);
    // splicer end function.getCharPtr2_bufferify
}

Fortran calls C via the following interface:

interface
    subroutine c_get_char_ptr2_bufferify(SHT_rv, SHT_rv_len) &
            bind(C, name="STR_getCharPtr2_bufferify")
        use iso_c_binding, only : C_CHAR, C_INT
        implicit none
        character(kind=C_CHAR), intent(OUT) :: SHT_rv(*)
        integer(C_INT), value, intent(IN) :: SHT_rv_len
    end subroutine c_get_char_ptr2_bufferify
end interface

The Fortran wrapper:

function get_char_ptr2() &
        result(SHT_rv)
    use iso_c_binding, only : C_INT
    character(len=30) :: SHT_rv
    ! splicer begin function.get_char_ptr2
    integer(C_INT) SHT_rv_len
    SHT_rv_len = len(SHT_rv, kind=C_INT)
    call c_get_char_ptr2_bufferify(SHT_rv, SHT_rv_len)
    ! splicer end function.get_char_ptr2
end function get_char_ptr2

Fortran usage:

character(30) str
str = get_char_ptr2()

getCharPtr3

Create a Fortran subroutine with an additional CHARACTER argument for the C function result. Any size character string can be returned limited by the size of the Fortran argument. The argument is defined by the F_string_result_as_arg format string.

C++ library function in strings.cpp:

const char * getCharPtr3()
{
    return static_char;
}

strings.yaml:

- decl: const char * getCharPtr3()
  format:
    F_string_result_as_arg: output

The C wrapper:

void STR_getCharPtr3_bufferify(char *output, int noutput)
{
    // splicer begin function.getCharPtr3_bufferify
    const char * SHC_rv = getCharPtr3();
    ShroudStrCopy(output, noutput, SHC_rv, -1);
    // splicer end function.getCharPtr3_bufferify
}

Fortran calls C via the following interface:

interface
    subroutine c_get_char_ptr3_bufferify(output, noutput) &
            bind(C, name="STR_getCharPtr3_bufferify")
        use iso_c_binding, only : C_CHAR, C_INT
        implicit none
        character(kind=C_CHAR), intent(OUT) :: output(*)
        integer(C_INT), value, intent(IN) :: noutput
    end subroutine c_get_char_ptr3_bufferify
end interface

The Fortran wrapper:

subroutine get_char_ptr3(output)
    character(*), intent(OUT) :: output
    ! splicer begin function.get_char_ptr3
    integer(C_INT) SHT_rv_len
    SHT_rv_len = len(output, kind=C_INT)
    call c_get_char_ptr3_bufferify(output, SHT_rv_len)
    ! splicer end function.get_char_ptr3
end subroutine get_char_ptr3

Fortran usage:

character(30) str
call get_char_ptrs(str)

string functions

getConstStringRefPure

C++ library function in strings.cpp:

const std::string& getConstStringRefPure()
{
    return static_str;
}

strings.yaml:

- decl: const string& getConstStringRefPure()

The C wrapper:

void STR_getConstStringRefPure_bufferify(STR_SHROUD_array *SHT_rv_cdesc)
{
    // splicer begin function.getConstStringRefPure_bufferify
    const std::string & SHCXX_rv = getConstStringRefPure();
    ShroudStrToArray(SHT_rv_cdesc, &SHCXX_rv, 0);
    // splicer end function.getConstStringRefPure_bufferify
}

The native C wrapper:

const char * STR_getConstStringRefPure(void)
{
    // splicer begin function.getConstStringRefPure
    const std::string & SHCXX_rv = getConstStringRefPure();
    const char * SHC_rv = SHCXX_rv.c_str();
    return SHC_rv;
    // splicer end function.getConstStringRefPure
}

Fortran calls C via the following interface:

interface
    subroutine c_get_const_string_ref_pure_bufferify(SHT_rv) &
            bind(C, name="STR_getConstStringRefPure_bufferify")
        import :: STR_SHROUD_array
        implicit none
        type(STR_SHROUD_array), intent(OUT) :: SHT_rv
    end subroutine c_get_const_string_ref_pure_bufferify
end interface

The Fortran wrapper:

function get_const_string_ref_pure() &
        result(SHT_rv)
    character(len=:), allocatable :: SHT_rv
    ! splicer begin function.get_const_string_ref_pure
    type(STR_SHROUD_array) :: SHT_rv_cdesc
    call c_get_const_string_ref_pure_bufferify(SHT_rv_cdesc)
    allocate(character(len=SHT_rv_cdesc%elem_len):: SHT_rv)
    call STR_SHROUD_copy_string_and_free(SHT_rv_cdesc, SHT_rv, &
        SHT_rv_cdesc%elem_len)
    ! splicer end function.get_const_string_ref_pure
end function get_const_string_ref_pure

Fortran usage:

str = 'XXXXXXXXXXXXXXXXXXXXXXXXXXXXXX'
str = get_const_string_ref_pure()
call assert_true( str == static_str, "getConstStringRefPure")

std::vector

vector_sum

C++ library function in vectors.cpp:

int vector_sum(const std::vector<int> &arg)
{
  int sum = 0;
  for(std::vector<int>::const_iterator it = arg.begin(); it != arg.end(); ++it) {
    sum += *it;
  }
  return sum;
}

vectors.yaml:

- decl: int vector_sum(const std::vector<int> &arg)

intent(in) is implied for the vector_sum argument since it is const. The Fortran wrapper passes the array and the size to C.

The C wrapper:

int VEC_vector_sum_bufferify(int *arg, size_t SHT_arg_size)
{
    // splicer begin function.vector_sum_bufferify
    const std::vector<int> SHCXX_arg(arg, arg + SHT_arg_size);
    int SHC_rv = vector_sum(SHCXX_arg);
    return SHC_rv;
    // splicer end function.vector_sum_bufferify
}

Fortran calls C via the following interface:

interface
    function c_vector_sum_bufferify(arg, SHT_arg_size) &
            result(SHT_rv) &
            bind(C, name="VEC_vector_sum_bufferify")
        use iso_c_binding, only : C_INT, C_SIZE_T
        implicit none
        integer(C_INT), intent(IN) :: arg(*)
        integer(C_SIZE_T), intent(IN), value :: SHT_arg_size
        integer(C_INT) :: SHT_rv
    end function c_vector_sum_bufferify
end interface

The Fortran wrapper:

function vector_sum(arg) &
        result(SHT_rv)
    use iso_c_binding, only : C_INT, C_SIZE_T
    integer(C_INT), intent(IN) :: arg(:)
    integer(C_INT) :: SHT_rv
    ! splicer begin function.vector_sum
    SHT_rv = c_vector_sum_bufferify(arg, size(arg, kind=C_SIZE_T))
    ! splicer end function.vector_sum
end function vector_sum

Fortran usage:

integer(C_INT) intv(5)
intv = [1,2,3,4,5]
irv = vector_sum(intv)
call assert_true(irv .eq. 15)

vector_iota_out

C++ library function in vectors.cpp accepts an empty vector then fills in some values. In this example, a Fortran array is passed in and will be filled.

void vector_iota_out(std::vector<int> &arg)
{
  for(unsigned int i=0; i < 5; i++) {
    arg.push_back(i + 1);
  }
  return;
}

vectors.yaml:

- decl: void vector_iota_out(std::vector<int> &arg+intent(out))

The C wrapper allocates a new std::vector instance which will be returned to the Fortran wrapper. Variable Darg will be filled with the meta data for the std::vector in a form that allows Fortran to access it. The value of Darg->cxx.idtor is computed by Shroud and used to release the memory (index of destructor).

void VEC_vector_iota_out_bufferify(VEC_SHROUD_array *SHT_arg_cdesc)
{
    // splicer begin function.vector_iota_out_bufferify
    std::vector<int> *SHCXX_arg = new std::vector<int>;
    vector_iota_out(*SHCXX_arg);
    SHT_arg_cdesc->cxx.addr  = SHCXX_arg;
    SHT_arg_cdesc->cxx.idtor = 1;
    SHT_arg_cdesc->addr.base = SHCXX_arg->empty() ? nullptr : &SHCXX_arg->front();
    SHT_arg_cdesc->type = SH_TYPE_INT;
    SHT_arg_cdesc->elem_len = sizeof(int);
    SHT_arg_cdesc->size = SHCXX_arg->size();
    SHT_arg_cdesc->rank = 1;
    SHT_arg_cdesc->shape[0] = SHT_arg_cdesc->size;
    // splicer end function.vector_iota_out_bufferify
}

Fortran calls C via the following interface:

interface
    subroutine c_vector_iota_out_bufferify(SHT_arg_cdesc) &
            bind(C, name="VEC_vector_iota_out_bufferify")
        import :: VEC_SHROUD_array
        implicit none
        type(VEC_SHROUD_array), intent(OUT) :: SHT_arg_cdesc
    end subroutine c_vector_iota_out_bufferify
end interface

The Fortran wrapper passes a SHROUD_array instance which will be filled by the C wrapper.

subroutine vector_iota_out(arg)
    use iso_c_binding, only : C_INT, C_LOC, C_SIZE_T
    integer(C_INT), intent(OUT), target :: arg(:)
    ! splicer begin function.vector_iota_out
    type(VEC_SHROUD_array) :: SHT_arg_cdesc
    call c_vector_iota_out_bufferify(SHT_arg_cdesc)
    call VEC_SHROUD_copy_array(SHT_arg_cdesc, C_LOC(arg), &
        size(arg,kind=C_SIZE_T))
    ! splicer end function.vector_iota_out
end subroutine vector_iota_out

Function SHROUD_copy_array_int copies the values into the user’s argument. If the argument is too short, not all values returned by the library function will be copied.

// helper copy_array
// Copy std::vector into array c_var(c_var_size).
// Then release std::vector.
// Called from Fortran.
void VEC_ShroudCopyArray(VEC_SHROUD_array *data, void *c_var, 
    size_t c_var_size)
{
    const void *cxx_var = data->addr.base;
    int n = c_var_size < data->size ? c_var_size : data->size;
    n *= data->elem_len;
    std::memcpy(c_var, cxx_var, n);
    VEC_SHROUD_memory_destructor(&data->cxx); // delete data->cxx.addr
}

Finally, the std::vector is released based on the value of idtor:

// Release library allocated memory.
void VEC_SHROUD_memory_destructor(VEC_SHROUD_capsule_data *cap)
{
    void *ptr = cap->addr;
    switch (cap->idtor) {
    case 0:   // --none--
    {
        // Nothing to delete
        break;
    }
    case 1:   // std_vector_int
    {
        std::vector<int> *cxx_ptr = 
            reinterpret_cast<std::vector<int> *>(ptr);
        delete cxx_ptr;
        break;
    }
    case 2:   // std_vector_double
    {
        std::vector<double> *cxx_ptr = 
            reinterpret_cast<std::vector<double> *>(ptr);
        delete cxx_ptr;
        break;
    }
    default:
    {
        // Unexpected case in destructor
        break;
    }
    }
    cap->addr = nullptr;
    cap->idtor = 0;  // avoid deleting again
}

Fortran usage:

integer(C_INT) intv(5)
intv(:) = 0
call vector_iota_out(intv)
call assert_true(all(intv(:) .eq. [1,2,3,4,5]))

vector_iota_out_alloc

C++ library function in vectors.cpp accepts an empty vector then fills in some values. In this example, the Fortran argument is ALLOCATABLE and will be sized based on the output of the library function.

void vector_iota_out_alloc(std::vector<int> &arg)
{
  for(unsigned int i=0; i < 5; i++) {
    arg.push_back(i + 1);
  }
  return;
}

The attribute +deref(allocatable) will cause the argument to be an ALLOCATABLE array.

vectors.yaml:

- decl: void vector_iota_out_alloc(std::vector<int> &arg+intent(out)+deref(allocatable))

The C wrapper:

void VEC_vector_iota_out_alloc_bufferify(
    VEC_SHROUD_array *SHT_arg_cdesc)
{
    // splicer begin function.vector_iota_out_alloc_bufferify
    std::vector<int> *SHCXX_arg = new std::vector<int>;
    vector_iota_out_alloc(*SHCXX_arg);
    SHT_arg_cdesc->cxx.addr  = SHCXX_arg;
    SHT_arg_cdesc->cxx.idtor = 1;
    SHT_arg_cdesc->addr.base = SHCXX_arg->empty() ? nullptr : &SHCXX_arg->front();
    SHT_arg_cdesc->type = SH_TYPE_INT;
    SHT_arg_cdesc->elem_len = sizeof(int);
    SHT_arg_cdesc->size = SHCXX_arg->size();
    SHT_arg_cdesc->rank = 1;
    SHT_arg_cdesc->shape[0] = SHT_arg_cdesc->size;
    // splicer end function.vector_iota_out_alloc_bufferify
}

Fortran calls C via the following interface:

interface
    subroutine c_vector_iota_out_alloc_bufferify(SHT_arg_cdesc) &
            bind(C, name="VEC_vector_iota_out_alloc_bufferify")
        import :: VEC_SHROUD_array
        implicit none
        type(VEC_SHROUD_array), intent(OUT) :: SHT_arg_cdesc
    end subroutine c_vector_iota_out_alloc_bufferify
end interface

The Fortran wrapper passes a SHROUD_array instance which will be filled by the C wrapper. After the function returns, the allocate statement allocates an array of the proper length.

subroutine vector_iota_out_alloc(arg)
    use iso_c_binding, only : C_INT, C_LOC, C_SIZE_T
    integer(C_INT), intent(OUT), allocatable, target :: arg(:)
    ! splicer begin function.vector_iota_out_alloc
    type(VEC_SHROUD_array) :: SHT_arg_cdesc
    call c_vector_iota_out_alloc_bufferify(SHT_arg_cdesc)
    allocate(arg(SHT_arg_cdesc%size))
    call VEC_SHROUD_copy_array(SHT_arg_cdesc, C_LOC(arg), &
        size(arg,kind=C_SIZE_T))
    ! splicer end function.vector_iota_out_alloc
end subroutine vector_iota_out_alloc

inta is intent(out), so it will be deallocated upon entry to vector_iota_out_alloc.

Fortran usage:

integer(C_INT), allocatable :: inta(:)
call vector_iota_out_alloc(inta)
call assert_true(allocated(inta))
call assert_equals(5 , size(inta))
call assert_true( all(inta == [1,2,3,4,5]), &
     "vector_iota_out_alloc value")

vector_iota_inout_alloc

C++ library function in vectors.cpp:

void vector_iota_inout_alloc(std::vector<int> &arg)
{
  for(unsigned int i=0; i < 5; i++) {
    arg.push_back(i + 11);
  }
  return;
}

vectors.yaml:

- decl: void vector_iota_out_alloc(std::vector<int> &arg+intent(inout)+deref(allocatable))

The C wrapper creates a new std::vector and initializes it to the Fortran argument.

void VEC_vector_iota_inout_alloc_bufferify(int *arg,
    size_t SHT_arg_size, VEC_SHROUD_array *SHT_arg_cdesc)
{
    // splicer begin function.vector_iota_inout_alloc_bufferify
    std::vector<int> *SHCXX_arg = new std::vector<int>(
        arg, arg + SHT_arg_size);
    vector_iota_inout_alloc(*SHCXX_arg);
    SHT_arg_cdesc->cxx.addr  = SHCXX_arg;
    SHT_arg_cdesc->cxx.idtor = 1;
    SHT_arg_cdesc->addr.base = SHCXX_arg->empty() ? nullptr : &SHCXX_arg->front();
    SHT_arg_cdesc->type = SH_TYPE_INT;
    SHT_arg_cdesc->elem_len = sizeof(int);
    SHT_arg_cdesc->size = SHCXX_arg->size();
    SHT_arg_cdesc->rank = 1;
    SHT_arg_cdesc->shape[0] = SHT_arg_cdesc->size;
    // splicer end function.vector_iota_inout_alloc_bufferify
}

Fortran calls C via the following interface:

interface
    subroutine c_vector_iota_inout_alloc_bufferify(arg, &
            SHT_arg_size, SHT_arg_cdesc) &
            bind(C, name="VEC_vector_iota_inout_alloc_bufferify")
        use iso_c_binding, only : C_INT, C_SIZE_T
        import :: VEC_SHROUD_array
        implicit none
        integer(C_INT), intent(IN) :: arg(*)
        integer(C_SIZE_T), intent(IN), value :: SHT_arg_size
        type(VEC_SHROUD_array), intent(OUT) :: SHT_arg_cdesc
    end subroutine c_vector_iota_inout_alloc_bufferify
end interface

The Fortran wrapper will deallocate the argument after returning since it is intent(inout). The in values are now stored in the std::vector. A new array is allocated to the current size of the std::vector. Fortran has no reallocate statement. Finally, the new values are copied into the Fortran array and the std::vector is released.

subroutine vector_iota_inout_alloc(arg)
    use iso_c_binding, only : C_INT, C_LOC, C_SIZE_T
    integer(C_INT), intent(INOUT), allocatable, target :: arg(:)
    ! splicer begin function.vector_iota_inout_alloc
    type(VEC_SHROUD_array) :: SHT_arg_cdesc
    call c_vector_iota_inout_alloc_bufferify(arg, &
        size(arg, kind=C_SIZE_T), SHT_arg_cdesc)
    if (allocated(arg)) deallocate(arg)
    allocate(arg(SHT_arg_cdesc%size))
    call VEC_SHROUD_copy_array(SHT_arg_cdesc, C_LOC(arg), &
        size(arg,kind=C_SIZE_T))
    ! splicer end function.vector_iota_inout_alloc
end subroutine vector_iota_inout_alloc

inta is intent(inout), so it will NOT be deallocated upon entry to vector_iota_inout_alloc. Fortran usage:

call vector_iota_inout_alloc(inta)
call assert_true(allocated(inta))
call assert_equals(10 , size(inta))
call assert_true( all(inta == [1,2,3,4,5,11,12,13,14,15]), &
     "vector_iota_inout_alloc value")
deallocate(inta)

Void Pointers

passAssumedType

C library function in clibrary.c:

int passAssumedType(void *arg)
{
    strncpy(last_function_called, "passAssumedType", MAXLAST);
    return *(int *) arg;
}

clibrary.yaml:

- decl: int passAssumedType(void *arg+assumedtype)

Fortran calls C via the following interface:

interface
    function pass_assumed_type(arg) &
            result(SHT_rv) &
            bind(C, name="passAssumedType")
        use iso_c_binding, only : C_INT
        implicit none
        type(*) :: arg
        integer(C_INT) :: SHT_rv
    end function pass_assumed_type
end interface

Fortran usage:

use iso_c_binding, only : C_INT
integer(C_INT) rv_int
rv_int = pass_assumed_type(23_C_INT)

As a reminder, 23_C_INT creates an integer(C_INT) constant.

Note

Assumed-type was introduced in Fortran 2018.

passAssumedTypeDim

C library function in clibrary.c:

void passAssumedTypeDim(void *arg)
{
    strncpy(last_function_called, "passAssumedTypeDim", MAXLAST);
}

clibrary.yaml:

- decl: int passAssumedTypeDim(void *arg+assumedtype+rank(1))

Fortran calls C via the following interface:

interface
    subroutine pass_assumed_type_dim(arg) &
            bind(C, name="passAssumedTypeDim")
        implicit none
        type(*) :: arg(*)
    end subroutine pass_assumed_type_dim
end interface

Example usage:

use iso_c_binding, only : C_INT, C_DOUBLE
integer(C_INT) int_array(10)
real(C_DOUBLE) double_array(2,5)
call pass_assumed_type_dim(int_array)
call pass_assumed_type_dim(double_array)

Note

Assumed-type was introduced in Fortran 2018.

passVoidStarStar

C library function in clibrary.c:

void passVoidStarStar(void *in, void **out)
{
    strncpy(last_function_called, "passVoidStarStar", MAXLAST);
    *out = in;
}

clibrary.yaml:

- decl: void passVoidStarStar(void *in+intent(in), void **out+intent(out))

Fortran calls C via the following interface:

interface
    subroutine pass_void_star_star(in, out) &
            bind(C, name="passVoidStarStar")
        use iso_c_binding, only : C_PTR
        implicit none
        type(C_PTR), value, intent(IN) :: in
        type(C_PTR), intent(OUT) :: out
    end subroutine pass_void_star_star
end interface

Example usage:

use iso_c_binding, only : C_INT, C_NULL_PTR, c_associated
integer(C_INT) int_var
cptr1 = c_loc(int_var)
cptr2 = C_NULL_PTR
call pass_void_star_star(cptr1, cptr2)
call assert_true(c_associated(cptr1, cptr2))

Function Pointers

callback1

C++ library function in tutorial.cpp:

int callback1(int in, int (*incr)(int))
{
  return incr(in);
}

tutorial.yaml:

- decl: int callback1(int in, int (*incr)(int));

The C wrapper:

int TUT_callback1(int in, int ( * incr)(int))
{
    // splicer begin function.callback1
    int SHC_rv = tutorial::callback1(in, incr);
    return SHC_rv;
    // splicer end function.callback1
}

Creates the abstract interface:

abstract interface
    function callback1_incr(arg0) bind(C)
        use iso_c_binding, only : C_INT
        implicit none
        integer(C_INT), value :: arg0
        integer(C_INT) :: callback1_incr
    end function callback1_incr
end interface

Fortran calls C via the following interface:

interface
    function callback1(in, incr) &
            result(SHT_rv) &
            bind(C, name="TUT_callback1")
        use iso_c_binding, only : C_INT
        import :: callback1_incr
        implicit none
        integer(C_INT), value, intent(IN) :: in
        procedure(callback1_incr) :: incr
        integer(C_INT) :: SHT_rv
    end function callback1
end interface

Fortran usage:

module worker
  use iso_c_binding
contains
  subroutine userincr(i) bind(C)
    integer(C_INT), value :: i
    ! do work of callback
  end subroutine user

  subroutine work
    call callback1(1, userincr)
  end subroutine work
end module worker

callback1c

C library function in clibrary.c:

void callback1(int type, void (*incr)(void))
{
  // Use type to decide how to call incr
}

clibrary.yaml:

- decl: int callback1(int type, void (*incr)()+external)

Creates the abstract interface:

abstract interface
    subroutine callback1_incr() bind(C)
        implicit none
    end subroutine callback1_incr
end interface

Fortran calls C via the following interface:

interface
    subroutine c_callback1(type, incr) &
            bind(C, name="callback1")
        use iso_c_binding, only : C_INT
        import :: callback1_incr
        implicit none
        integer(C_INT), value, intent(IN) :: type
        procedure(callback1_incr) :: incr
    end subroutine c_callback1
end interface

The Fortran wrapper. By using external no abstract interface is used:

subroutine callback1(type, incr)
    use iso_c_binding, only : C_INT
    integer(C_INT), value, intent(IN) :: type
    external :: incr
    ! splicer begin function.callback1
    call c_callback1(type, incr)
    ! splicer end function.callback1
end subroutine callback1

Fortran usage:

module worker
  use iso_c_binding
contains
  subroutine userincr_int(i) bind(C)
    integer(C_INT), value :: i
    ! do work of callback
  end subroutine user_int

  subroutine userincr_double(i) bind(C)
    real(C_DOUBLE), value :: i
    ! do work of callback
  end subroutine user_int

  subroutine work
    call callback1c(1, userincr_int)
    call callback1c(1, userincr_double)
  end subrouine work
end module worker

Struct

Struct creating is described in Fortran Structs.

passStruct1

C library function in struct.c:

int passStruct1(const Cstruct1 *s1)
{
    strncpy(last_function_called, "passStruct1", MAXLAST);
    return s1->ifield;
}

struct.yaml:

- decl: int passStruct1(Cstruct1 *s1)

Fortran calls C via the following interface:

interface
    function pass_struct1(arg) &
            result(SHT_rv) &
            bind(C, name="passStruct1")
        use iso_c_binding, only : C_INT
        import :: cstruct1
        implicit none
        type(cstruct1), intent(IN) :: arg
        integer(C_INT) :: SHT_rv
    end function pass_struct1
end interface

Fortran usage:

type(cstruct1) str1
str1%ifield = 12
str1%dfield = 12.6
call assert_equals(12, pass_struct1(str1), "passStruct1")

passStructByValue

C library function in struct.c:

int passStructByValue(Cstruct1 arg)
{
  int rv = arg.ifield * 2;
  // Caller will not see changes.
  arg.ifield += 1;
  return rv;
}

struct.yaml:

- decl: double passStructByValue(struct1 arg)

Fortran calls C via the following interface:

interface
    function pass_struct_by_value(arg) &
            result(SHT_rv) &
            bind(C, name="passStructByValue")
        use iso_c_binding, only : C_INT
        import :: cstruct1
        implicit none
        type(cstruct1), value, intent(IN) :: arg
        integer(C_INT) :: SHT_rv
    end function pass_struct_by_value
end interface

Fortran usage:

type(cstruct1) str1
str1%ifield = 2_C_INT
str1%dfield = 2.0_C_DOUBLE
rvi = pass_struct_by_value(str1)
call assert_equals(4, rvi, "pass_struct_by_value")
! Make sure str1 was passed by value.
call assert_equals(2_C_INT, str1%ifield, "pass_struct_by_value ifield")
call assert_equals(2.0_C_DOUBLE, str1%dfield, "pass_struct_by_value dfield")

Class Type

constructor and destructor

The C++ header file from classes.hpp.

class Class1
{
public:
    int m_flag;
    int m_test;
    Class1()         : m_flag(0), m_test(0)    {};
    Class1(int flag) : m_flag(flag), m_test(0) {};
};

classes.yaml:

declarations:
- decl: class Class1
  declarations:
  - decl: Class1()
    format:
      function_suffix: _default
  - decl: Class1(int flag)
    format:
    function_suffix: _flag
  - decl: ~Class1() +name(delete)

A C wrapper function is created for each constructor and the destructor.

The C wrappers:

CLA_Class1 * CLA_Class1_ctor_default(CLA_Class1 * SHC_rv)
{
    // splicer begin class.Class1.method.ctor_default
    classes::Class1 *SHCXX_rv = new classes::Class1();
    SHC_rv->addr = static_cast<void *>(SHCXX_rv);
    SHC_rv->idtor = 1;
    return SHC_rv;
    // splicer end class.Class1.method.ctor_default
}
CLA_Class1 * CLA_Class1_ctor_flag(int flag, CLA_Class1 * SHC_rv)
{
    // splicer begin class.Class1.method.ctor_flag
    classes::Class1 *SHCXX_rv = new classes::Class1(flag);
    SHC_rv->addr = static_cast<void *>(SHCXX_rv);
    SHC_rv->idtor = 1;
    return SHC_rv;
    // splicer end class.Class1.method.ctor_flag
}
void CLA_Class1_delete(CLA_Class1 * self)
{
    classes::Class1 *SH_this = static_cast<classes::Class1 *>
        (self->addr);
    // splicer begin class.Class1.method.delete
    delete SH_this;
    self->addr = nullptr;
    // splicer end class.Class1.method.delete
}

The corresponding Fortran interfaces:

interface
    function c_class1_ctor_default(SHT_rv) &
            result(SHT_prv) &
            bind(C, name="CLA_Class1_ctor_default")
        use iso_c_binding, only : C_PTR
        import :: CLA_SHROUD_capsule_data
        implicit none
        type(CLA_SHROUD_capsule_data), intent(OUT) :: SHT_rv
        type(C_PTR) :: SHT_prv
    end function c_class1_ctor_default
end interface
interface
    function c_class1_ctor_flag(flag, SHT_rv) &
            result(SHT_prv) &
            bind(C, name="CLA_Class1_ctor_flag")
        use iso_c_binding, only : C_INT, C_PTR
        import :: CLA_SHROUD_capsule_data
        implicit none
        integer(C_INT), value, intent(IN) :: flag
        type(CLA_SHROUD_capsule_data), intent(OUT) :: SHT_rv
        type(C_PTR) :: SHT_prv
    end function c_class1_ctor_flag
end interface
interface
    subroutine c_class1_delete(self) &
            bind(C, name="CLA_Class1_delete")
        import :: CLA_SHROUD_capsule_data
        implicit none
        type(CLA_SHROUD_capsule_data), intent(INOUT) :: self
    end subroutine c_class1_delete
end interface

And the Fortran wrappers:

function class1_ctor_default() &
        result(SHT_rv)
    use iso_c_binding, only : C_PTR
    type(class1) :: SHT_rv
    type(C_PTR) :: SHT_prv
    ! splicer begin class.Class1.method.ctor_default
    SHT_prv = c_class1_ctor_default(SHT_rv%cxxmem)
    ! splicer end class.Class1.method.ctor_default
end function class1_ctor_default
function class1_ctor_flag(flag) &
        result(SHT_rv)
    use iso_c_binding, only : C_INT, C_PTR
    integer(C_INT), value, intent(IN) :: flag
    type(class1) :: SHT_rv
    type(C_PTR) :: SHT_prv
    ! splicer begin class.Class1.method.ctor_flag
    SHT_prv = c_class1_ctor_flag(flag, SHT_rv%cxxmem)
    ! splicer end class.Class1.method.ctor_flag
end function class1_ctor_flag
subroutine class1_delete(obj)
    class(class1) :: obj
    ! splicer begin class.Class1.method.delete
    call c_class1_delete(obj%cxxmem)
    ! splicer end class.Class1.method.delete
end subroutine class1_delete

The Fortran shadow class adds the type-bound method for the destructor:

type, bind(C) :: SHROUD_class1_capsule
    type(C_PTR) :: addr = C_NULL_PTR  ! address of C++ memory
    integer(C_INT) :: idtor = 0       ! index of destructor
end type SHROUD_class1_capsule

type class1
    type(SHROUD_class1_capsule) :: cxxmem
contains
    procedure :: delete => class1_delete
end type class1

The constructors are not type-bound procedures. But they are combined into a generic interface.

interface class1
    module procedure class1_ctor_default
    module procedure class1_ctor_flag
end interface class1

A class instance is created and destroy from Fortran as:

use classes_mod
type(class1) obj

obj = class1()
call obj%delete

Corresponding C++ code:

include <classes.hpp>

classes::Class1 * obj = new classes::Class1;

delete obj;

Getter and Setter

The C++ header file from classes.hpp.

class Class1
{
public:
    int m_flag;
    int m_test;
};

classes.yaml:

declarations:
- decl: class Class1
  declarations:
  - decl: int m_flag +readonly;
  - decl: int m_test +name(test);

A C wrapper function is created for each getter and setter. If the readonly attribute is added, then only a getter is created. In this case m_ is a convention used to designate member variables. The Fortran attribute is renamed as test to avoid cluttering the Fortran API with this convention.

The C wrappers:

int CLA_Class1_get_m_flag(CLA_Class1 * self)
{
    classes::Class1 *SH_this = static_cast<classes::Class1 *>
        (self->addr);
    // splicer begin class.Class1.method.get_m_flag
    // skip call c_getter
    return SH_this->m_flag;
    // splicer end class.Class1.method.get_m_flag
}
int CLA_Class1_get_test(CLA_Class1 * self)
{
    classes::Class1 *SH_this = static_cast<classes::Class1 *>
        (self->addr);
    // splicer begin class.Class1.method.get_test
    // skip call c_getter
    return SH_this->m_test;
    // splicer end class.Class1.method.get_test
}
void CLA_Class1_set_test(CLA_Class1 * self, int val)
{
    classes::Class1 *SH_this = static_cast<classes::Class1 *>
        (self->addr);
    // splicer begin class.Class1.method.set_test
    // skip call c_setter
    SH_this->m_test = val;
    // splicer end class.Class1.method.set_test
}

The corresponding Fortran interfaces:

interface
    function c_class1_get_m_flag(self) &
            result(SHT_rv) &
            bind(C, name="CLA_Class1_get_m_flag")
        use iso_c_binding, only : C_INT
        import :: CLA_SHROUD_capsule_data
        implicit none
        type(CLA_SHROUD_capsule_data), intent(IN) :: self
        integer(C_INT) :: SHT_rv
    end function c_class1_get_m_flag
end interface
interface
    function c_class1_get_test(self) &
            result(SHT_rv) &
            bind(C, name="CLA_Class1_get_test")
        use iso_c_binding, only : C_INT
        import :: CLA_SHROUD_capsule_data
        implicit none
        type(CLA_SHROUD_capsule_data), intent(IN) :: self
        integer(C_INT) :: SHT_rv
    end function c_class1_get_test
end interface
interface
    subroutine c_class1_set_test(self, val) &
            bind(C, name="CLA_Class1_set_test")
        use iso_c_binding, only : C_INT
        import :: CLA_SHROUD_capsule_data
        implicit none
        type(CLA_SHROUD_capsule_data), intent(IN) :: self
        integer(C_INT), value, intent(IN) :: val
    end subroutine c_class1_set_test
end interface

And the Fortran wrappers:

function class1_get_m_flag(obj) &
        result(SHT_rv)
    use iso_c_binding, only : C_INT
    class(class1) :: obj
    integer(C_INT) :: SHT_rv
    ! splicer begin class.Class1.method.get_m_flag
    SHT_rv = c_class1_get_m_flag(obj%cxxmem)
    ! splicer end class.Class1.method.get_m_flag
end function class1_get_m_flag
function class1_get_test(obj) &
        result(SHT_rv)
    use iso_c_binding, only : C_INT
    class(class1) :: obj
    integer(C_INT) :: SHT_rv
    ! splicer begin class.Class1.method.get_test
    SHT_rv = c_class1_get_test(obj%cxxmem)
    ! splicer end class.Class1.method.get_test
end function class1_get_test
subroutine class1_set_test(obj, val)
    use iso_c_binding, only : C_INT
    class(class1) :: obj
    integer(C_INT), value, intent(IN) :: val
    ! splicer begin class.Class1.method.set_test
    call c_class1_set_test(obj%cxxmem, val)
    ! splicer end class.Class1.method.set_test
end subroutine class1_set_test

The Fortran shadow class adds the type-bound methods:

type class1
    type(SHROUD_class1_capsule) :: cxxmem
contains
    procedure :: get_m_flag => class1_get_m_flag
    procedure :: get_test => class1_get_test
    procedure :: set_test => class1_set_test
end type class1

The class variables can be used as:

use classes_mod
type(class1) obj
integer iflag

obj = class1()
call obj%set_test(4)
iflag = obj%get_test()

Corresponding C++ code:

include <classes.hpp>
classes::Class1 obj = new * classes::Class1;
obj->m_test = 4;
int iflag = obj->m_test;

Struct as a Class

While C does not support object-oriented programming directly, it can be emulated by using structs. The ‘base class’ struct is Cstruct_as_clss. It is subclassed by Cstruct_as_subclass which explicitly duplicates the members of C_struct_as_class. The C header file from struct.h.

struct Cstruct_as_class {
    int x1;
    int y1;
};
typedef struct Cstruct_as_class Cstruct_as_class;

/* The first members match Cstruct_as_class */
struct Cstruct_as_subclass {
    int x1;
    int y1;
    int z1;
};
typedef struct Cstruct_as_subclass Cstruct_as_subclass;

The C ‘constructor’ returns a pointer to an instance of the object.

Cstruct_as_class *Create_Cstruct_as_class(void);
Cstruct_as_class *Create_Cstruct_as_class_args(int x, int y);

The ‘methods’ pass an instance of the class as an explicit this object.

int Cstruct_as_class_sum(const Cstruct_as_class *point);

The methods are wrapped in classes.yaml:

declarations:
- decl: struct Cstruct_as_class {
          int x1;
          int y1;
        };
  options:
    wrap_struct_as: class

- decl: Cstruct_as_class *Create_Cstruct_as_class(void)
  options:
    class_ctor: Cstruct_as_class
- decl: Cstruct_as_class *Create_Cstruct_as_class_args(int x, int y)
  options:
    class_ctor: Cstruct_as_class

- decl: int Cstruct_as_class_sum(const Cstruct_as_class *point +pass)
  options:
    class_method: Cstruct_as_class
  format:
    F_name_function: sum

- decl: struct Cstruct_as_subclass {
          int x1;
          int y1;
          int z1;
        };
  options:
    wrap_struct_as: class
    class_baseclass: Cstruct_as_class
- decl: Cstruct_as_subclass *Create_Cstruct_as_subclass_args(int x, int y, int z)
  options:
    wrap_python: False
    class_ctor: Cstruct_as_subclass

This uses several options to creates the class features for the struct: wrap_struct_as, class_ctor, class_method.

    type cstruct_as_class
        type(STR_SHROUD_capsule_data) :: cxxmem
        ! splicer begin class.Cstruct_as_class.component_part
        ! splicer end class.Cstruct_as_class.component_part
    contains
        procedure :: get_x1 => cstruct_as_class_get_x1
        procedure :: set_x1 => cstruct_as_class_set_x1
        procedure :: get_y1 => cstruct_as_class_get_y1
        procedure :: set_y1 => cstruct_as_class_set_y1
        procedure :: sum => cstruct_as_class_sum
        ! splicer begin class.Cstruct_as_class.type_bound_procedure_part
        ! splicer end class.Cstruct_as_class.type_bound_procedure_part
    end type cstruct_as_class

The subclass is created using the Fortran EXTENDS keyword. No additional members are added. The cxxmem field from cstruct_as_class will now point to an instance of the C struct Cstruct_as_subclass.

    type, extends(cstruct_as_class) :: cstruct_as_subclass
        ! splicer begin class.Cstruct_as_subclass.component_part
        ! splicer end class.Cstruct_as_subclass.component_part
    contains
        procedure :: get_x1 => cstruct_as_subclass_get_x1
        procedure :: set_x1 => cstruct_as_subclass_set_x1
        procedure :: get_y1 => cstruct_as_subclass_get_y1
        procedure :: set_y1 => cstruct_as_subclass_set_y1
        procedure :: get_z1 => cstruct_as_subclass_get_z1
        procedure :: set_z1 => cstruct_as_subclass_set_z1
        ! splicer begin class.Cstruct_as_subclass.type_bound_procedure_part
        ! splicer end class.Cstruct_as_subclass.type_bound_procedure_part
    end type cstruct_as_subclass

The C wrapper to construct the struct-as-class. It calls the C function and fills in the fields for the shadow struct.

STR_Cstruct_as_class * STR_Create_Cstruct_as_class(
    STR_Cstruct_as_class * SHC_rv)
{
    // splicer begin function.Create_Cstruct_as_class
    Cstruct_as_class * SHCXX_rv = Create_Cstruct_as_class();
    SHC_rv->addr = SHCXX_rv;
    SHC_rv->idtor = 0;
    return SHC_rv;
    // splicer end function.Create_Cstruct_as_class
}

A Fortran generic interface is created for the class:

interface cstruct_as_class
    module procedure create_cstruct_as_class
    module procedure create_cstruct_as_class_args
end interface cstruct_as_class

And the Fortran constructor call the C wrapper function.

function create_cstruct_as_class() &
        result(SHT_rv)
    use iso_c_binding, only : C_PTR
    type(cstruct_as_class) :: SHT_rv
    type(C_PTR) :: SHT_prv
    ! splicer begin function.create_cstruct_as_class
    SHT_prv = c_create_cstruct_as_class(SHT_rv%cxxmem)
    ! splicer end function.create_cstruct_as_class
end function create_cstruct_as_class

The class can be used as:

type(cstruct_as_class) point1, point2
type(cstruct_as_subclass) subpoint1

call set_case_name("test_struct_class")

! F_name_associated is blank so the associated function is not created.
! Instead look at pointer directly.
! call assert_false(point1%associated())
call assert_false(c_associated(point1%cxxmem%addr))

point1 = Cstruct_as_class()
call assert_equals(0, point1%get_x1())
call assert_equals(0, point1%get_y1())

point2 = Cstruct_as_class(1, 2)
call assert_equals(1, point2%get_x1())
call assert_equals(2, point2%get_y1())

call assert_equals(3, cstruct_as_class_sum(point2))
call assert_equals(3, point2%sum())

subpoint1 = Cstruct_as_subclass(1, 2, 3)
call assert_equals(1, subpoint1%get_x1())
call assert_equals(2, subpoint1%get_y1())
call assert_equals(3, subpoint1%get_z1())
call assert_equals(3, subpoint1%sum())

Default Value Arguments

The default values are provided in the function declaration.

C++ library function in tutorial.cpp:

double UseDefaultArguments(double arg1 = 3.1415, bool arg2 = true);

tutorial.yaml:

- decl: double UseDefaultArguments(double arg1 = 3.1415, bool arg2 = true)
  default_arg_suffix:
  -
  -  _arg1
  -  _arg1_arg2

A C++ wrapper is created which calls the C++ function with no arguments with default values and then adds a wrapper with an explicit argument for each default value argument. In this case, three wrappers are created. Since the C++ compiler provides the default value, it is necessary to create each wrapper.

wrapTutorial.cpp:

double TUT_UseDefaultArguments(void)
{
    // splicer begin function.UseDefaultArguments
    double SHC_rv = tutorial::UseDefaultArguments();
    return SHC_rv;
    // splicer end function.UseDefaultArguments
}
double TUT_UseDefaultArguments_arg1(double arg1)
{
    // splicer begin function.UseDefaultArguments_arg1
    double SHC_rv = tutorial::UseDefaultArguments(arg1);
    return SHC_rv;
    // splicer end function.UseDefaultArguments_arg1
}
double TUT_UseDefaultArguments_arg1_arg2(double arg1, bool arg2)
{
    // splicer begin function.UseDefaultArguments_arg1_arg2
    double SHC_rv = tutorial::UseDefaultArguments(arg1, arg2);
    return SHC_rv;
    // splicer end function.UseDefaultArguments_arg1_arg2
}

This creates three corresponding Fortran interfaces:

interface
    function c_use_default_arguments() &
            result(SHT_rv) &
            bind(C, name="TUT_UseDefaultArguments")
        use iso_c_binding, only : C_DOUBLE
        implicit none
        real(C_DOUBLE) :: SHT_rv
    end function c_use_default_arguments
end interface
interface
    function c_use_default_arguments_arg1(arg1) &
            result(SHT_rv) &
            bind(C, name="TUT_UseDefaultArguments_arg1")
        use iso_c_binding, only : C_DOUBLE
        implicit none
        real(C_DOUBLE), value, intent(IN) :: arg1
        real(C_DOUBLE) :: SHT_rv
    end function c_use_default_arguments_arg1
end interface
interface
    function c_use_default_arguments_arg1_arg2(arg1, arg2) &
            result(SHT_rv) &
            bind(C, name="TUT_UseDefaultArguments_arg1_arg2")
        use iso_c_binding, only : C_BOOL, C_DOUBLE
        implicit none
        real(C_DOUBLE), value, intent(IN) :: arg1
        logical(C_BOOL), value, intent(IN) :: arg2
        real(C_DOUBLE) :: SHT_rv
    end function c_use_default_arguments_arg1_arg2
end interface

In many case the interfaces would be enough to call the routines. However, in order to have a generic interface, there must be explicit Fortran wrappers:

function use_default_arguments() &
        result(SHT_rv)
    use iso_c_binding, only : C_DOUBLE
    real(C_DOUBLE) :: SHT_rv
    ! splicer begin function.use_default_arguments
    SHT_rv = c_use_default_arguments()
    ! splicer end function.use_default_arguments
end function use_default_arguments
function use_default_arguments_arg1(arg1) &
        result(SHT_rv)
    use iso_c_binding, only : C_DOUBLE
    real(C_DOUBLE), value, intent(IN) :: arg1
    real(C_DOUBLE) :: SHT_rv
    ! splicer begin function.use_default_arguments_arg1
    SHT_rv = c_use_default_arguments_arg1(arg1)
    ! splicer end function.use_default_arguments_arg1
end function use_default_arguments_arg1
function use_default_arguments_arg1_arg2(arg1, arg2) &
        result(SHT_rv)
    use iso_c_binding, only : C_BOOL, C_DOUBLE
    real(C_DOUBLE), value, intent(IN) :: arg1
    logical, value, intent(IN) :: arg2
    real(C_DOUBLE) :: SHT_rv
    ! splicer begin function.use_default_arguments_arg1_arg2
    logical(C_BOOL) :: SHT_arg2_cxx
    SHT_arg2_cxx = arg2  ! coerce to C_BOOL
    SHT_rv = c_use_default_arguments_arg1_arg2(arg1, SHT_arg2_cxx)
    ! splicer end function.use_default_arguments_arg1_arg2
end function use_default_arguments_arg1_arg2

The Fortran generic interface adds the ability to call any of the functions by the C++ function name:

interface use_default_arguments
    module procedure use_default_arguments
    module procedure use_default_arguments_arg1
    module procedure use_default_arguments_arg1_arg2
end interface use_default_arguments

Usage:

real(C_DOUBLE) rv
rv = use_default_arguments()
rv = use_default_arguments(1.d0)
rv = use_default_arguments(1.d0, .false.)

Generic Real

C library function in clibrary.c:

void GenericReal(double arg)
{
    global_double = arg;
    return;
}

generic.yaml:

- decl: void GenericReal(double arg)
  fortran_generic:
  - decl: (float arg)
    function_suffix: float
  - decl: (double arg)
    function_suffix: double

Fortran calls C via the following interface:

interface
    subroutine c_generic_real(arg) &
            bind(C, name="GenericReal")
        use iso_c_binding, only : C_DOUBLE
        implicit none
        real(C_DOUBLE), value, intent(IN) :: arg
    end subroutine c_generic_real
end interface

There is a single interface since there is a single C function. A generic interface is created for each declaration in the fortran_generic block.

interface generic_real
    module procedure generic_real_float
    module procedure generic_real_double
end interface generic_real

A Fortran wrapper is created for each declaration in the fortran_generic block. The argument is explicitly converted to a C_DOUBLE before calling the C function in generic_real_float. There is no conversion necessary in generic_real_double.

subroutine generic_real_float(arg)
    use iso_c_binding, only : C_DOUBLE, C_FLOAT
    real(C_FLOAT), value, intent(IN) :: arg
    ! splicer begin function.generic_real_float
    call c_generic_real(real(arg, C_DOUBLE))
    ! splicer end function.generic_real_float
end subroutine generic_real_float
subroutine generic_real_double(arg)
    use iso_c_binding, only : C_DOUBLE
    real(C_DOUBLE), value, intent(IN) :: arg
    ! splicer begin function.generic_real_double
    call c_generic_real(arg)
    ! splicer end function.generic_real_double
end subroutine generic_real_double

The function can be called via the generic interface with either type. If the specific function is called, the correct type must be passed.

call generic_real(0.0)
call generic_real(0.0d0)

call generic_real_float(0.0)
call generic_real_double(0.0d0)

In C, the compiler will promote the argument.

GenericReal(0.0f);
GenericReal(0.0);