Принятый ответ содержит две ошибки (он передает неправильное значение длины строки в GETCWD
и оставляет в C_NULL_CHAR
). Этот ответ исправляет эти ошибки и делает интерфейс более удобным для использования с Fortran.
Основная идея та же самая: вызовите getcwd
или _getcwd
, используя C, и вызовите оболочку C, используя функции взаимодействия Fortran C. На стороне Фортрана для обработки длины строки используется подпрограмма-оболочка, поэтому ее не нужно передавать явно.
Кроме того, C_INT
и C_CHAR
не являются необходимыми, как целые числа по умолчанию и символы по умолчанию, которые нужны на стороне Фортрана (хотя на практике я не знаю ни одной системы, в которой C_CHAR
и символ по умолчанию различаются). Обертка также преобразует их. Кроме того, строка, возвращаемая из C, содержит завершающий символ C_NULL_CHAR
, который необходимо удалить, чтобы строку можно было использовать на стороне Fortran.
Код С:
#ifdef _WIN32
#include <direct.h>
#define GETCWD _getcwd
#else
#include <unistd.h>
#define GETCWD getcwd
#endif
/* Return 0 on success, 1 on error. */
int getCWDHelper(char *str, int len)
{
return GETCWD(str, len) != str;
}
Код Фортрана:
module cwd
use iso_c_binding, only: C_INT, C_CHAR, C_NULL_CHAR
implicit none
private
public :: getCWD
interface
function getCWDHelper(str, len) bind(C, name="getCWDHelper")
use iso_c_binding, only: C_INT, C_CHAR
integer(kind=C_INT) :: getCWDHelper
character(kind=C_CHAR), intent(out) :: str(*)
integer(kind=C_INT), value :: len
end function getCWDHelper
end interface
contains
! Writes the current working directory path into str.
! Returns 0 on success, or 1 on error.
function getCWD(str)
integer :: getCWD
character(*), intent(out) :: str
integer :: i, length
character(len=len(str), kind=C_CHAR) :: str_copy
! Call the C helper, passing the length as the correct int kind
getCWD = getCWDHelper(str_copy, len(str_copy, kind=C_INT))
if (getCWD /= 0) then
str = '' ! Error, clear the string
return
end if
! Copy the C_CHAR string to the output string,
! removing the C_NULL_CHAR and clearing the rest.
length = index(str_copy, C_NULL_CHAR) - 1
do i = 1, length
str(i:i) = char(ichar(str_copy(i:i)))
end do
str(length+1:) = ''
end function getCWD
end module
Тестовый код:
program test
use cwd, only: getCWD
implicit none
character(len=255) :: path
integer :: error
error = getCWD(path)
print *, error
if (error == 0) print *, path
end program
Сделать возвращаемое значение выделяемым и зациклить для получения достаточного размера мы оставляем читателю в качестве упражнения.
person
rtoijala
schedule
17.05.2019