Add C wrapper for file listing

Author: Carlos Une

src/c.c

@@ -0,0 +1,22 @@
+/* FIXME: fpm --flag '-DENABLE_C_WRAPPER' currently doesn't work with .c files. Use #if..#endif below for the time being. */
+#if ((defined(_WIN32) && (defined(__MINGW32__) || defined(__MINGW64__))) || defined(__linux__) || defined(__APPLE__) || defined(__OpenBSD__))
+#define ENABLE_C_WRAPPER
+#endif
+
+#ifdef ENABLE_C_WRAPPER
+#include <sys/stat.h>
+#include <dirent.h>
+
+int 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;
+}
+
+#endif

src/fpm_filesystem.F90

@@ -7,8 +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_int8_t, c_int16_t, c_int32_t, c_int64_t, c_int128_t, c_char, c_ptr, c_int, c_loc, c_long, c_short, &
-        c_null_char, c_associated, c_f_pointer
+    use iso_c_binding, only: c_char, c_ptr, c_int, c_null_char, c_associated, c_f_pointer
     implicit none
     private
     public :: basename, canon_path, dirname, is_dir, join_path, number_of_rows, read_lines, list_files, env_variable, &
@@ -18,124 +17,8 @@ module fpm_filesystem
 
     integer, parameter :: LINE_BUFFER_LEN = 1000
 
-#if (defined(MINGW64))
-    type, bind(c) :: stat_t
-        integer(kind=c_int32_t) :: st_dev
-        integer(kind=c_int16_t) :: st_ino
-        integer(kind=c_int16_t) :: st_mode
-        integer(kind=c_int16_t) :: st_nlink
-
-        integer(kind=c_int16_t) :: st_uid
-        integer(kind=c_int16_t) :: st_gid
-
-        integer(kind=c_int32_t) :: st_rdev
-        integer(kind=c_int32_t) :: st_size
-
-        integer(kind=c_int64_t) :: st_atime
-        integer(kind=c_int64_t) :: st_mtime
-        integer(kind=c_int64_t) :: st_ctime
-    end type
-#elif (defined(MINGW32))
-    type, bind(c) :: stat_t
-        integer(kind=c_int32_t) :: st_dev
-        integer(kind=c_int16_t) :: st_ino
-        integer(kind=c_int16_t) :: st_mode
-        integer(kind=c_int16_t) :: st_nlink
-
-        integer(kind=c_int16_t) :: st_uid
-        integer(kind=c_int16_t) :: st_gid
-
-        integer(kind=c_int32_t) :: st_rdev
-        integer(kind=c_int32_t) :: st_size
-
-        integer(kind=c_int32_t) :: st_atime
-        integer(kind=c_int32_t) :: st_mtime
-        integer(kind=c_int32_t) :: st_ctime
-    end type
-#elif (defined(LINUX64))
-    type, bind(c) :: stat_t
-        integer(kind=c_int64_t) :: st_dev
-        integer(kind=c_int64_t) :: st_ino
-        integer(kind=c_int64_t) :: st_nlink
-        integer(kind=c_int32_t) :: st_mode
-
-        integer(kind=c_int32_t) :: st_uid
-        integer(kind=c_int32_t) :: st_gid
-        integer(kind=c_int32_t) :: pad0
-
-        integer(kind=c_int64_t) :: st_rdev
-        integer(kind=c_int64_t) :: st_size
-        integer(kind=c_int64_t) :: st_blksize
-        integer(kind=c_int64_t) :: st_blocks
-
-        integer(kind=c_int128_t) :: st_atime
-        integer(kind=c_int128_t) :: st_mtime
-        integer(kind=c_int128_t) :: st_ctime
-
-        integer(kind=c_int64_t) :: glibc_reserved4
-        integer(kind=c_int64_t) :: glibc_reserved5
-        integer(kind=c_int64_t) :: glibc_reserved6
-    end type
-#elif (defined(LINUX32))
-    type, bind(c) :: stat_t
-        integer(kind=c_int64_t) :: st_dev
-        integer(kind=c_int16_t) :: pad1
-        integer(kind=c_int32_t) :: st_ino
-        integer(kind=c_int32_t) :: st_mode
-        integer(kind=c_int32_t) :: st_nlink
-
-        integer(kind=c_int32_t) :: st_uid
-        integer(kind=c_int32_t) :: st_gid
-        integer(kind=c_int64_t) :: st_rdev
-        integer(kind=c_int16_t) :: pad2
-
-        integer(kind=c_int32_t) :: st_size
-        integer(kind=c_int32_t) :: st_blksize
-        integer(kind=c_int32_t) :: st_blocks
-
-        integer(kind=c_int64_t) :: st_atime
-        integer(kind=c_int64_t) :: st_mtime
-        integer(kind=c_int64_t) :: st_ctime
-
-        integer(kind=c_int32_t) :: glibc_reserved4
-        integer(kind=c_int32_t) :: glibc_reserved5
-    end type
-#endif
-
-#if (defined(MINGW64) || defined(MINGW32))
-    type, bind(c) :: dirent
-        integer(kind=c_long)  :: d_ino
-        integer(kind=c_short) :: d_reclen
-        integer(kind=c_short) :: d_namlen
-        character(len=1,kind=c_char) :: d_name(260)
-    end type
-#elif (defined(LINUX64))
-    type, bind(c) :: dirent
-        integer(kind=c_int64_t) :: d_ino
-        integer(kind=c_int64_t) :: d_off
-        integer(kind=c_int16_t) :: d_reclen
-        integer(kind=c_int8_t)  :: d_type
-        character(len=1,kind=c_char) :: d_name(256)
-    end type
-#elif (defined(LINUX32))
-    type, bind(c) :: dirent
-        integer(kind=c_int32_t) :: d_ino
-        integer(kind=c_int32_t) :: d_off
-        integer(kind=c_int16_t) :: d_reclen
-        integer(kind=c_int8_t)  :: d_type
-        character(len=1,kind=c_char) :: d_name(256)
-    end type
-#endif
-
-#if (defined(MINGW64) || defined(MINGW32) || defined(LINUX64) || defined(LINUX32))
+#ifdef ENABLE_C_WRAPPER
     interface
-        function c_stat(path, buf) result(r) bind(c, name="stat")
-            import c_char, c_ptr, c_int
-            character(kind=c_char), intent(in) :: path(*)
-            type(c_ptr), value :: buf
-            integer(kind=c_int) :: r
-        end function c_stat
-
         function c_opendir(dir) result(r) bind(c, name="opendir")
             import c_char, c_ptr
             character(kind=c_char), intent(in) :: dir(*)
@@ -153,6 +36,18 @@ function c_closedir(dir) result(r) bind(c, name="closedir")
             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="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
 
@@ -450,31 +345,43 @@ subroutine mkdir(dir)
     end if
 end subroutine mkdir
 
-
-#if (defined(MINGW64) || defined(MINGW32) || defined(LINUX64) || defined(LINUX32))
+#ifdef ENABLE_C_WRAPPER
 !> 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)
+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
-    type(dirent), pointer :: dir_entry_fortran
+    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 (.not. is_dir_c(dir(1:len_trim(dir))//c_null_char)) then
+    if (c_is_dir(dir(1:len_trim(dir))//c_null_char) .eq. 0) then
         allocate (files(0))
         return
     end if
@@ -493,8 +400,7 @@ recursive subroutine list_files(dir, files, recurse)
         if (.not. c_associated(dir_entry_c)) then
             exit
         else
-            call c_f_pointer(dir_entry_c, dir_entry_fortran)
-            string_fortran = f_string(dir_entry_fortran%d_name)
+            string_fortran = f_string(c_get_d_name(dir_entry_c))
 
             if ((string_fortran .eq. '.' .or. string_fortran .eq. '..')) then
                 cycle
@@ -507,7 +413,7 @@ recursive subroutine list_files(dir, files, recurse)
                 i = 1
             end if
 
-            files_tmp(i)%s = join_path(dir, string_fortran)
+            files_tmp(i)%s = dir // filesep // string_fortran
         end if
     end do
 
@@ -528,8 +434,8 @@ recursive subroutine list_files(dir, files, recurse)
             allocate(sub_dir_files(0))
 
             do i=1,size(files)
-                if (is_dir_c(files(i)%s//c_null_char)) then
-                    call list_files(files(i)%s, dir_files, recurse=.true.)
+                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
@@ -539,18 +445,6 @@ recursive subroutine list_files(dir, files, recurse)
     end if
 end subroutine list_files
 
-function is_dir_c(path) result(r)
-    character(kind=c_char), intent(in) :: path(*)
-    logical :: r
-    type(stat_t), target :: buf
-    integer(kind=c_int) :: exists
-    integer(kind=c_int), parameter :: S_IFMT  = 61440
-    integer(kind=c_int), parameter :: S_IFDIR = 16384
-
-    exists = c_stat(path, c_loc(buf))
-    r = exists .eq. 0 .and. iand(int(buf%st_mode, kind=c_int), S_IFMT) .eq. S_IFDIR
-end function is_dir_c
-
 #else
 !> Get file & directory names in directory `dir`.
 !!
@@ -616,8 +510,10 @@ recursive subroutine list_files(dir, files, recurse)
     end if
 
 end subroutine list_files
+
 #endif
 
+
 !> test if pathname already exists
 logical function exists(filename) result(r)
     character(len=*), intent(in) :: filename

src/fpm_strings.f90

@@ -29,6 +29,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
@@ -70,6 +71,10 @@ module fpm_strings
     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
@@ -125,6 +130,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