diff options
| -rw-r--r-- | src/c.c | 41 | ||||
| -rw-r--r-- | src/fpm_filesystem.F90 (renamed from src/fpm_filesystem.f90) | 136 | ||||
| -rw-r--r-- | src/fpm_strings.f90 | 32 |
3 files changed, 209 insertions, 0 deletions
@@ -0,0 +1,41 @@ +#include <sys/stat.h> +#include <dirent.h> + +#ifdef __APPLE__ +DIR * opendir$INODE64( const char * dirName ); +struct dirent * readdir$INODE64( DIR * dir ); +#endif + +int c_is_dir(const char *path) +{ + struct stat m; + int r = stat(path, &m); + return r == 0 && S_ISDIR(m.st_mode); +} + +const char *get_d_name(struct dirent *d) +{ + return (const char *) d->d_name; +} + + + +DIR *c_opendir(const char *dirname){ + +#ifdef __APPLE__ + return opendir$INODE64(dirname); +#else + return opendir(dirname); +#endif + +} + +struct dirent *c_readdir(DIR *dirp){ + +#ifdef __APPLE__ + return readdir$INODE64(dirp); +#else + return readdir(dirp); +#endif + +}
\ No newline at end of file diff --git a/src/fpm_filesystem.f90 b/src/fpm_filesystem.F90 index 2a32b54..e5cfa9d 100644 --- a/src/fpm_filesystem.f90 +++ b/src/fpm_filesystem.F90 @@ -7,6 +7,7 @@ module fpm_filesystem OS_CYGWIN, OS_SOLARIS, OS_FREEBSD, OS_OPENBSD use fpm_environment, only: separator, get_env use fpm_strings, only: f_string, replace, string_t, split + use iso_c_binding, only: c_char, c_ptr, c_int, c_null_char, c_associated, c_f_pointer use fpm_error, only : fpm_stop implicit none private @@ -17,6 +18,39 @@ module fpm_filesystem integer, parameter :: LINE_BUFFER_LEN = 1000 +#ifndef FPM_BOOTSTRAP + interface + function c_opendir(dir) result(r) bind(c, name="c_opendir") + import c_char, c_ptr + character(kind=c_char), intent(in) :: dir(*) + type(c_ptr) :: r + end function c_opendir + + function c_readdir(dir) result(r) bind(c, name="c_readdir") + import c_ptr + type(c_ptr), intent(in), value :: dir + type(c_ptr) :: r + end function c_readdir + + function c_closedir(dir) result(r) bind(c, name="closedir") + import c_ptr, c_int + type(c_ptr), intent(in), value :: dir + integer(kind=c_int) :: r + end function c_closedir + + function c_get_d_name(dir) result(r) bind(c, name="get_d_name") + import c_ptr + type(c_ptr), intent(in), value :: dir + type(c_ptr) :: r + end function c_get_d_name + + function c_is_dir(path) result(r) bind(c, name="c_is_dir") + import c_char, c_int + character(kind=c_char), intent(in) :: path(*) + integer(kind=c_int) :: r + end function c_is_dir + end interface +#endif contains @@ -311,7 +345,107 @@ subroutine mkdir(dir) end if end subroutine mkdir +#ifndef FPM_BOOTSTRAP +!> Get file & directory names in directory `dir` using iso_c_binding. +!! +!! - File/directory names return are relative to cwd, ie. preprended with `dir` +!! - Includes files starting with `.` except current directory and parent directory +!! +recursive subroutine list_files(dir, files, recurse, separator) + character(len=*), intent(in) :: dir + type(string_t), allocatable, intent(out) :: files(:) + logical, intent(in), optional :: recurse + character(len=1), optional :: separator + + integer :: i + type(string_t), allocatable :: dir_files(:) + type(string_t), allocatable :: sub_dir_files(:) + + type(c_ptr) :: dir_handle + type(c_ptr) :: dir_entry_c + character(len=:,kind=c_char), allocatable :: fortran_name + character(len=:), allocatable :: string_fortran + integer, parameter :: N_MAX = 256 + type(string_t) :: files_tmp(N_MAX) + integer(kind=c_int) :: r + character(len=1) :: filesep + + if (present(separator)) then + filesep = separator + else + select case (get_os_type()) + case default + filesep = '/' + case (OS_WINDOWS) + filesep = '\' + end select + end if + + if (c_is_dir(dir(1:len_trim(dir))//c_null_char) .eq. 0) then + allocate (files(0)) + return + end if + + dir_handle = c_opendir(dir(1:len_trim(dir))//c_null_char) + if (.not. c_associated(dir_handle)) then + print *, 'c_opendir() failed' + error stop + end if + + i = 0 + allocate(files(0)) + do + dir_entry_c = c_readdir(dir_handle) + if (.not. c_associated(dir_entry_c)) then + exit + else + string_fortran = f_string(c_get_d_name(dir_entry_c)) + + if ((string_fortran .eq. '.' .or. string_fortran .eq. '..')) then + cycle + end if + + i = i + 1 + + if (i .gt. N_MAX) then + files = [files, files_tmp] + i = 1 + end if + + files_tmp(i)%s = dir // filesep // string_fortran + end if + end do + + r = c_closedir(dir_handle) + + if (r .ne. 0) then + print *, 'c_closedir() failed' + error stop + end if + + if (i .gt. 0) then + files = [files, files_tmp(1:i)] + end if + + if (present(recurse)) then + if (recurse) then + + allocate(sub_dir_files(0)) + + do i=1,size(files) + if (c_is_dir(files(i)%s//c_null_char) .ne. 0) then + call list_files(files(i)%s, dir_files, recurse=.true., separator=filesep) + sub_dir_files = [sub_dir_files, dir_files] + end if + end do + + files = [files, sub_dir_files] + end if + end if +end subroutine list_files + +#else !> Get file & directory names in directory `dir`. !! !! - File/directory names return are relative to cwd, ie. preprended with `dir` @@ -376,6 +510,8 @@ recursive subroutine list_files(dir, files, recurse) end subroutine list_files +#endif + !> test if pathname already exists logical function exists(filename) result(r) diff --git a/src/fpm_strings.f90 b/src/fpm_strings.f90 index ee5c20a..ba76d15 100644 --- a/src/fpm_strings.f90 +++ b/src/fpm_strings.f90 @@ -31,6 +31,7 @@ module fpm_strings use iso_fortran_env, only: int64 +use iso_c_binding, only: c_char, c_ptr, c_int, c_null_char, c_associated, c_f_pointer, c_size_t implicit none private @@ -73,6 +74,10 @@ interface string_t module procedure new_string_t end interface string_t +interface f_string + module procedure f_string, f_string_cptr, f_string_cptr_n +end interface f_string + contains !> test if a CHARACTER string ends with a specified suffix @@ -128,6 +133,33 @@ function f_string(c_string) end function f_string +!> return Fortran character variable when given a null-terminated c_ptr +function f_string_cptr(cptr) result(s) + type(c_ptr), intent(in), value :: cptr + character(len=:,kind=c_char), allocatable :: s + + interface + function c_strlen(s) result(r) bind(c, name="strlen") + import c_size_t, c_ptr + type(c_ptr), intent(in), value :: s + integer(kind=c_size_t) :: r + end function + end interface + + s = f_string_cptr_n(cptr, c_strlen(cptr)) +end function + +!> return Fortran character variable when given a null-terminated c_ptr and its length +function f_string_cptr_n(cptr, n) result(s) + type(c_ptr), intent(in), value :: cptr + integer(kind=c_size_t), intent(in) :: n + character(len=n,kind=c_char) :: s + character(len=n,kind=c_char), pointer :: sptr + + call c_f_pointer(cptr, sptr) + s = sptr +end function + !> Hash a character(*) string of default kind pure function fnv_1a_char(input, seed) result(hash) character(*), intent(in) :: input |