Calling C from Fortran: Passing Vector of Strings from C to Fortran

Dear all,

I have the following C function:

void foo_c(char ***names, size_t *names_n,
                            int *ierr);

I want to call this function from Fortran.

So I created a module called foo_interface.f90 and put following code init.

INTERFACE
FUNCTION foo_c(names, names_n, ierr) RESULT( ans ) &
  & BIND( C, NAME="foo_c")
  USE ISO_C_BINDING, ONLY : C_PTR, C_INT, C_SIZE_T
  TYPE( C_PTR ), INTENT( IN ) :: names
  INTEGER( C_SIZE_T ), INTENT( OUT ) :: names_n
  INTEGER( C_INT ), INTENT(OUT) :: ierr
  TYPE( C_PTR ) :: ans
END FUNCTION foo_c
END INTERFACE

PUBLIC :: foo_c

I define following subroutine which calls foo_c as follows:

FUNCTION call_foo_c(names, names_n) RESULT( ans )
  CHARACTER( LEN = 120 ), ALLOCATABLE, INTENT( OUT ) :: names( : )
  INTEGER, INTENT( OUT ) :: names_n
  INTEGER ::  ans

  ! Internal variables
  character(len=1,kind=C_char), pointer :: names_(:,:)
  TYPE( C_PTR ) :: cstring, C_VOID
  INTEGER( C_SIZE_T ) :: names_n_
  INTEGER( I4B ) :: I
  INTEGER( C_INT ) :: ierr  
  
  C_VOID = foo_c( cstring, names_n_, ierr )
  names_n = names_n_
  ALLOCATE( names( names_n ) )
  DO i=1, names_n; names( i ) = ''; END DO

  ans = INT( ierr, KIND=I4B)

  !! CALL c_f_pointer( cstring, names_, [names_n, ??<-- what should be the shape?? ] )

  !! How to copy data inside name(:)????
END FUNCTION model_list

I am able to get correct values of names_n, but I am do not. know how to get a vector of strings? Please help me.

Regards
Vikas

In my opinion, the three arguments should be declared as TYPE( C_PTR ), because the three are C pointers.
And foo_c should be declared as a Fortran subroutine (the C function returns void).

names could be a C pointer toward an array of C pointers toward C character strings.

FWIW, if we know the names_n and err arguments are scalars I believe the following is a valid Fortran interface,

interface
! void demo(size_t *names_n, int *err);
subroutine demo(names_n, err) bind(c,name="demo")
  use, intrinsic :: iso_c_binding, only: c_int, c_size_t
  integer(c_size_t), intent(inout) :: names_n
  integer(c_int), intent(inout) :: err
end subroutine
end interface

and there is no need to accept the arguments names_n, and err as type(c_ptr) (although that should also work, but involves two extra calls to c_f_pointer). The intent can be restricted if more is known about the procedure behavior.

@vickysharma0812, Is there anything else known about the value in names? Currently, your interface assumes the strings will fit into fixed-length records of 120 characters.

names returns the vector of strings; some thing like following:

char names[][] = {
"hello",
"world"
"ss"};

So names has different length along columns.

@ivanpribec
I can understand your code. I am sorry, but it is not related to what I have asked.

Regards
Vikas

I was merely replying to @vmagnin’s suggestion. But I look forward to the definite answer about what to do with the first argument in your function.

1 Like

@vickysharma0812 ,

So is this Homework assignment as suggested by the thread category? Assuming as such, readers are likely to provide clues to help the student figure out the solution(s) by themselves. In this particular case, the clues will probably be along the lines of Fortran lacking “jagged arrays” and what it can mean in terms of copying the data from the C pointer to a C char [][]` array obtained by the function call.

Depending on what your assignment requires, you may be able to pursue other options as shown here: Iso_c_binding: interface to a C function returning a string - #13 by FortranFan

Here is how I would do it. Similar code has worked for me in
the past.

Subroutine foo(names, names_n, ierr)

  USE ISO_C_BINDING

  Integer , Parameter :: MAX_STRING_LEN = 120
  Character(LEN=MAX_STRING_LEN), ALLOCATABLE, Intent(INOUT) :: names(:)
  Integer,                                    Intent(INOUT) :: names_n
  Integer,                                    Intent(INOUT) :: ierr


  Integer           :: i, inull, iend
  Integer(C_SIZE_T) :: names_n_c
  Integer(C_INT)    :: ierr_c
  Type(C_PTR)       :: names_c

  Type(C_PTR),                 Pointer :: cstring_p(:)
  Character(MAX_STRING_LEN+1), Pointer :: string_p

  Interface

    Subroutine foo_c(names, names_n, ierr) BIND(C,name="foo_c")

      IMPORT :: C_PTR, C_SIZE_T, C_INT

      Type(C_PTR),       Intent(INOUT) :: names
      Integer(C_SIZE_T), Intent(INOUT) :: names_n
      Integer(C_INT),    Intent(INOUT) :: ierr

    End Subroutine foo_c

  End Interface

  names_c = C_NULL_PTR
  names_n = 0

  Call foo_c(names_c, names_n_c, ierr_c)

  ierr    = ierr_c
  names_n = INT(names_n_c)
  If (C_ASSOCIATED(names_c)) Then
    CALL C_F_POINTER(names_c, cstring_p,[names_n])
    ALLOCATE(names(names_n))
    NULLIFY(string_p)
   Do i=1,names_n
      names(i) = REPEAT(" ",MAX_STRING_LEN)
      If (C_ASSOCIATED(cstring_p(i))) Then
        Call C_F_POINTER(cstring_p(i), string_p)
        inull = INDEX(string_p,C_NULL_CHAR)
        iend  = LEN_TRIM(string_p)
        If (inull /= 0) iend = inull-1
        iend = MAX(1,iend)
        names(i) = string_p(1:iend)
        NULLIFY(string_p)
      End If
    End Do
  End If
  Do i=1, names_n
    cstring_p(i) = C_NULL_PTR
  End Do

End Subroutine foo