创建一个返回char*的C函数的FORTRAN接口

Mik*_*ler 11 c fortran interface char fortran-iso-c-binding

现在,我已经对此持续了大约一个星期,并且在论坛之后搜索了论坛,以便清楚地解释如何从C发送char*到FORTRAN.为了让事情更令人沮丧,从FORTRAN向C发送char*参数是直截了当的......

从FORTRAN发送char*参数到C(这很好):

// The C header declaration (using __cdecl in a def file):
extern "C" double GetLoggingValue(char* name);
Run Code Online (Sandbox Code Playgroud)

来自FORTRAN:

! The FORTRAN interface:
INTERFACE
    REAL(8) FUNCTION GetLoggingValue [C, ALIAS: '_GetLoggingValue'] (name)
        USE ISO_C_BINDING       
        CHARACTER(LEN=1, KIND=C_CHAR), DIMENSION(*),    INTENT(IN) :: name                  
    END FUNCTION GetLoggingValue
END INTERFACE

! Calling the function:
GetLoggingValue(user_name)
Run Code Online (Sandbox Code Playgroud)

当尝试使用类似逻辑从C返回char*时,我遇到问题后出现问题.我觉得应该尝试的一个尝试是:

// The C declaration header (using __cdecl in a def file):
extern "C" const char* GetLastErrorMessage();
Run Code Online (Sandbox Code Playgroud)

和FORTRAN接口:

INTERFACE
    FUNCTION GetLastErrorMessage [C, ALIAS: '_GetLastErrorMessage'] ()
        USE ISO_C_BINDING   
        CHARACTER(LEN=1, KIND=C_CHAR), DIMENSION(255), :: GetLastErrorMessage
    END FUNCTION GetLastErrorMessage
END INTERFACE
Run Code Online (Sandbox Code Playgroud)

(我不能真正使用DIMENSION(*),所以我已经超大到255.)

应该返回一个指向255个C风格字符数组的指针 - 但如果确实如此,我就无法将其转换为有意义的字符串.在实践中,它返回一组随机字符,从Wingdings到'bell'字符......

我也试图回来:

  • 指向CHARACTER的指针(LEN = 255,KIND = C_CHAR).
  • 字面上的字符(LEN = 255,KIND = C_CHAR).
  • 一个INTEGER(C_SIZE_T),并试图将其精炼成指向字符串数组的指针.
  • 一个人物.
  • 等等

如果有人能给我一个如何做到这一点的例子,我将非常感激......

最好的祝福,

麦克风

har*_*dkl 14

对于C交互,动态长度的字符串总是有点棘手.一种可能的解决方案是使用指针.

首先是一个简单的例子,你必须将一个空字符终止的字符串移交给一个C函数.如果你真的只传入了字符串,你必须确保用c_null_char来完成它,因此这个方向非常简单.以下是LuaFortran界面的示例:

subroutine flu_getfield(L, index, k)
  type(flu_State)  :: L
  integer          :: index
  character(len=*) :: k

  integer(kind=c_int) :: c_index
  character(len=len_trim(k)+1) :: c_k

  c_k = trim(k) // c_null_char
  c_index = index
  call lua_getfield(L%state, c_index, c_k)
end subroutine flu_getfield
Run Code Online (Sandbox Code Playgroud)

而lua_getfield 的界面如下所示:

subroutine lua_getfield(L, index, k) bind(c, name="lua_getfield")
  use, intrinsic :: iso_c_binding
  type(c_ptr), value :: L
  integer(kind=c_int), value :: index
  character(kind=c_char), dimension(*) :: k
end subroutine lua_getfield
Run Code Online (Sandbox Code Playgroud)

而C-Code接口是:

void lua_getfield (lua_State *L, int idx, const char *k)
Run Code Online (Sandbox Code Playgroud)

现在是一个更复杂的案例,我们必须处理来自C的具有动态长度的返回字符串.到目前为止我发现的最便携的解决方案是使用指针.这是一个带指针的示例,其中字符串由C-Routine(也来自上面提到的Aotus库)给出:

function flu_tolstring(L, index, len) result(string)
  type(flu_State) :: L
  integer :: index
  integer :: len
  character,pointer,dimension(:) :: string

  integer :: string_shape(1)
  integer(kind=c_int) :: c_index
  integer(kind=c_size_t) :: c_len
  type(c_ptr) :: c_string

  c_index = index
  c_string = lua_tolstring(L%state, c_index, c_len)
  len = int(c_len,kind=kind(len))
  string_shape(1) = len
  call c_f_pointer(c_string, string, string_shape)
end function flu_tolstring
Run Code Online (Sandbox Code Playgroud)

其中lua_tolstring具有以下接口:

function lua_tolstring(L, index, len) bind(c, name="lua_tolstring")
  use, intrinsic :: iso_c_binding
  type(c_ptr), value :: L
  integer(kind=c_int), value :: index
  integer(kind=c_size_t) :: len
  type(c_ptr) :: lua_tolstring
end function lua_tolstring
Run Code Online (Sandbox Code Playgroud)

最后,这里尝试阐明如何将c_ptr解释为Fortran字符串:假设您有一个指向字符串的c_ptr:

type(c_ptr) :: a_c_string
Run Code Online (Sandbox Code Playgroud)

并且它的长度由具有以下类型的len变量给出:

integer(kind=c_size_t) :: stringlen
Run Code Online (Sandbox Code Playgroud)

您希望在Fortran中指向字符串的指针中获取此字符串:

character,pointer,dimension(:) :: string
Run Code Online (Sandbox Code Playgroud)

所以你做了映射:

call c_f_pointer(a_c_string, string, [ stringlen ])
Run Code Online (Sandbox Code Playgroud)


Mik*_*ler 5

感谢heraldkl给我解决这个非常令人沮丧的问题.我发布了我最终实现的内容,它将指针转换为接口的角色,这意味着最终的应用程序可以调用C函数而无需了解指针转换:

C函数:

// The C declaration header (using __cdecl in a def file):
extern "C" const char* GetLastErrorMessage();
Run Code Online (Sandbox Code Playgroud)

FORTRAN接口模块:

MODULE mINTERFACES

USE ISO_C_BINDING

INTERFACE
    FUNCTION GetLastErrorMessagePtr [C, ALIAS: '_GetLastErrorMessage'] ()
        USE ISO_C_BINDING   
    TYPE(C_PTR) :: GetLastErrorMessagePtr                   
    END FUNCTION GetLastErrorMessagePtr
END INTERFACE

CONTAINS    ! this must be after all INTERFACE definitions

FUNCTION GetLastErrorMessage()
    USE ISO_C_BINDING   
    CHARACTER*255 :: GetLastErrorMessage
    CHARACTER, POINTER, DIMENSION(:) :: last_message_array
    CHARACTER*255 last_message
    INTEGER message_length

    CALL C_F_POINTER(GetLastErrorMessagePtr(), last_message_array, [ 255 ])

    DO 10 i=1, 255
        last_message(i:i+1) = last_message_array(i)
10  CONTINUE

    message_length = LEN_TRIM(last_message(1:INDEX(last_message, CHAR(0))))

    GetLastErrorMessage = last_message(1:message_length-1)

END FUNCTION GetLastErrorMessage
Run Code Online (Sandbox Code Playgroud)

并从FORTRAN程序调用此函数:

USE MINTERFACES

PRINT *, "--> GetLastErrorMessage:      '", TRIM(GetLastErrorMessage()), "'"
Run Code Online (Sandbox Code Playgroud)

我再次感谢heraldkl提供这个解决方案 - 我不知道如何在没有他输入的情况下做到这一点.


Pap*_*Pap 5

该线程有些旧,但是由于我有类似的问题(可能还会有其他问题),所以我还是发布了答案。

如果由于某种原因C字符串为空,则上面发布的代码将导致分段错误。此外,由于Fortran 2003/2008支持返回可分配实体的函数,因此无需返回255个字符的字符串(使用前可能需要对其进行修剪)。使用上面发布的所有信息,我得到了以下函数,该函数获取一个C字符串(指针),并返回相应的Fortran字符串。如果C字符串为null,则返回“ NULL”,类似于在类似情况下打印的C的“(null)”:

function C_to_F_string(c_string_pointer) result(f_string)
use, intrinsic :: iso_c_binding, only: c_ptr,c_f_pointer,c_char,c_null_char
type(c_ptr), intent(in) :: c_string_pointer
character(len=:), allocatable :: f_string
character(kind=c_char), dimension(:), pointer :: char_array_pointer => null()
character(len=255) :: aux_string
integer :: i,length
call c_f_pointer(c_string_pointer,char_array_pointer,[255])
if (.not.associated(char_array_pointer)) then
  allocate(character(len=4)::f_string); f_string="NULL"; return
end if
aux_string=" "
do i=1,255
  if (char_array_pointer(i)==c_null_char) then
    length=i-1; exit
  end if
  aux_string(i:i)=char_array_pointer(i)
end do
allocate(character(len=length)::f_string)
f_string=aux_string(1:length)
end function C_to_F_string
Run Code Online (Sandbox Code Playgroud)