Skip to content

Commit 868212e

Browse files
author
Carlos Une
committed
Optimize the file listing routine.
1 parent 5617e65 commit 868212e

File tree

1 file changed

+241
-1
lines changed

1 file changed

+241
-1
lines changed

‎src/fpm_filesystem.f90

Lines changed: 241 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -7,6 +7,8 @@ module fpm_filesystem
77
OS_CYGWIN, OS_SOLARIS, OS_FREEBSD, OS_OPENBSD
88
use fpm_environment, only: separator, get_env
99
use fpm_strings, only: f_string, replace, string_t, split
10+
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, &
11+
c_null_char, c_associated, c_f_pointer
1012
implicit none
1113
private
1214
public :: basename, canon_path, dirname, is_dir, join_path, number_of_rows, read_lines, list_files, env_variable, &
@@ -16,6 +18,143 @@ module fpm_filesystem
1618

1719
integer, parameter :: LINE_BUFFER_LEN = 1000
1820

21+
#if (defined(MINGW64))
22+
type, bind(c) :: stat_t
23+
integer(kind=c_int32_t) :: st_dev
24+
integer(kind=c_int16_t) :: st_ino
25+
integer(kind=c_int16_t) :: st_mode
26+
integer(kind=c_int16_t) :: st_nlink
27+
28+
integer(kind=c_int16_t) :: st_uid
29+
integer(kind=c_int16_t) :: st_gid
30+
31+
integer(kind=c_int32_t) :: st_rdev
32+
integer(kind=c_int32_t) :: st_size
33+
34+
integer(kind=c_int64_t) :: st_atime
35+
integer(kind=c_int64_t) :: st_mtime
36+
integer(kind=c_int64_t) :: st_ctime
37+
end type
38+
#elif (defined(MINGW32))
39+
type, bind(c) :: stat_t
40+
integer(kind=c_int32_t) :: st_dev
41+
integer(kind=c_int16_t) :: st_ino
42+
integer(kind=c_int16_t) :: st_mode
43+
integer(kind=c_int16_t) :: st_nlink
44+
45+
integer(kind=c_int16_t) :: st_uid
46+
integer(kind=c_int16_t) :: st_gid
47+
48+
integer(kind=c_int32_t) :: st_rdev
49+
integer(kind=c_int32_t) :: st_size
50+
51+
integer(kind=c_int32_t) :: st_atime
52+
integer(kind=c_int32_t) :: st_mtime
53+
integer(kind=c_int32_t) :: st_ctime
54+
end type
55+
#elif (defined(LINUX64))
56+
type, bind(c) :: stat_t
57+
integer(kind=c_int64_t) :: st_dev
58+
integer(kind=c_int64_t) :: st_ino
59+
integer(kind=c_int64_t) :: st_nlink
60+
integer(kind=c_int32_t) :: st_mode
61+
62+
integer(kind=c_int32_t) :: st_uid
63+
integer(kind=c_int32_t) :: st_gid
64+
integer(kind=c_int32_t) :: pad0
65+
66+
integer(kind=c_int64_t) :: st_rdev
67+
integer(kind=c_int64_t) :: st_size
68+
integer(kind=c_int64_t) :: st_blksize
69+
integer(kind=c_int64_t) :: st_blocks
70+
71+
integer(kind=c_int128_t) :: st_atime
72+
integer(kind=c_int128_t) :: st_mtime
73+
integer(kind=c_int128_t) :: st_ctime
74+
75+
integer(kind=c_int64_t) :: glibc_reserved4
76+
integer(kind=c_int64_t) :: glibc_reserved5
77+
integer(kind=c_int64_t) :: glibc_reserved6
78+
end type
79+
#elif (defined(LINUX32))
80+
type, bind(c) :: stat_t
81+
integer(kind=c_int64_t) :: st_dev
82+
integer(kind=c_int16_t) :: pad1
83+
integer(kind=c_int32_t) :: st_ino
84+
integer(kind=c_int32_t) :: st_mode
85+
integer(kind=c_int32_t) :: st_nlink
86+
87+
integer(kind=c_int32_t) :: st_uid
88+
integer(kind=c_int32_t) :: st_gid
89+
integer(kind=c_int64_t) :: st_rdev
90+
integer(kind=c_int16_t) :: pad2
91+
92+
integer(kind=c_int32_t) :: st_size
93+
integer(kind=c_int32_t) :: st_blksize
94+
integer(kind=c_int32_t) :: st_blocks
95+
96+
integer(kind=c_int64_t) :: st_atime
97+
integer(kind=c_int64_t) :: st_mtime
98+
integer(kind=c_int64_t) :: st_ctime
99+
100+
integer(kind=c_int32_t) :: glibc_reserved4
101+
integer(kind=c_int32_t) :: glibc_reserved5
102+
end type
103+
#endif
104+
105+
#if (defined(MINGW64) || defined(MINGW32))
106+
type, bind(c) :: dirent
107+
integer(kind=c_long) :: d_ino
108+
integer(kind=c_short) :: d_reclen
109+
integer(kind=c_short) :: d_namlen
110+
character(len=1,kind=c_char) :: d_name(260)
111+
end type
112+
#elif (defined(LINUX64))
113+
type, bind(c) :: dirent
114+
integer(kind=c_int64_t) :: d_ino
115+
integer(kind=c_int64_t) :: d_off
116+
integer(kind=c_int16_t) :: d_reclen
117+
integer(kind=c_int8_t) :: d_type
118+
character(len=1,kind=c_char) :: d_name(256)
119+
end type
120+
#elif (defined(LINUX32))
121+
type, bind(c) :: dirent
122+
integer(kind=c_int32_t) :: d_ino
123+
integer(kind=c_int32_t) :: d_off
124+
integer(kind=c_int16_t) :: d_reclen
125+
integer(kind=c_int8_t) :: d_type
126+
character(len=1,kind=c_char) :: d_name(256)
127+
end type
128+
#endif
129+
130+
#if (defined(MINGW64) || defined(MINGW32) || defined(LINUX64) || defined(LINUX32))
131+
interface
132+
function c_stat(path, buf) result(r) bind(c, name="stat")
133+
import c_char, c_ptr, c_int
134+
character(kind=c_char), intent(in) :: path(*)
135+
type(c_ptr), value :: buf
136+
integer(kind=c_int) :: r
137+
end function c_stat
138+
139+
function c_opendir(dir) result(r) bind(c, name="opendir")
140+
import c_char, c_ptr
141+
character(kind=c_char), intent(in) :: dir(*)
142+
type(c_ptr) :: r
143+
end function c_opendir
144+
145+
function c_readdir(dir) result(r) bind(c, name="readdir")
146+
import c_ptr
147+
type(c_ptr), intent(in), value :: dir
148+
type(c_ptr) :: r
149+
end function c_readdir
150+
151+
function c_closedir(dir) result(r) bind(c, name="closedir")
152+
import c_ptr, c_int
153+
type(c_ptr), intent(in), value :: dir
154+
integer(kind=c_int) :: r
155+
end function c_closedir
156+
end interface
157+
#endif
19158

20159
contains
21160

@@ -312,6 +451,107 @@ subroutine mkdir(dir)
312451
end subroutine mkdir
313452

314453

454+
#if (defined(MINGW64) || defined(MINGW32) || defined(LINUX64) || defined(LINUX32))
455+
!> Get file & directory names in directory `dir` using iso_c_binding.
456+
!!
457+
!! - File/directory names return are relative to cwd, ie. preprended with `dir`
458+
!! - Includes files starting with `.` except current directory and parent directory
459+
!!
460+
recursive subroutine list_files(dir, files, recurse)
461+
character(len=*), intent(in) :: dir
462+
type(string_t), allocatable, intent(out) :: files(:)
463+
logical, intent(in), optional :: recurse
464+
465+
integer :: i
466+
type(string_t), allocatable :: dir_files(:)
467+
type(string_t), allocatable :: sub_dir_files(:)
468+
469+
type(c_ptr) :: dir_handle
470+
type(c_ptr) :: dir_entry_c
471+
type(dirent), pointer :: dir_entry_fortran
472+
character(len=:), allocatable :: string_fortran
473+
integer, parameter :: N_MAX = 256
474+
type(string_t) :: files_tmp(N_MAX)
475+
integer(kind=c_int) :: r
476+
477+
if (.not. is_dir_c(dir(1:len_trim(dir))//c_null_char)) then
478+
allocate (files(0))
479+
return
480+
end if
481+
482+
dir_handle = c_opendir(dir(1:len_trim(dir))//c_null_char)
483+
if (.not. c_associated(dir_handle)) then
484+
print *, 'c_opendir() failed'
485+
error stop
486+
end if
487+
488+
i = 0
489+
allocate(files(0))
490+
491+
do
492+
dir_entry_c = c_readdir(dir_handle)
493+
if (.not. c_associated(dir_entry_c)) then
494+
exit
495+
else
496+
call c_f_pointer(dir_entry_c, dir_entry_fortran)
497+
string_fortran = f_string(dir_entry_fortran%d_name)
498+
499+
if ((string_fortran .eq. '.' .or. string_fortran .eq. '..')) then
500+
cycle
501+
end if
502+
503+
i = i + 1
504+
505+
if (i .gt. N_MAX) then
506+
files = [files, files_tmp]
507+
i = 1
508+
end if
509+
510+
files_tmp(i)%s = join_path(dir, string_fortran)
511+
end if
512+
end do
513+
514+
r = c_closedir(dir_handle)
515+
516+
if (r .ne. 0) then
517+
print *, 'c_closedir() failed'
518+
error stop
519+
end if
520+
521+
if (i .gt. 0) then
522+
files = [files, files_tmp(1:i)]
523+
end if
524+
525+
if (present(recurse)) then
526+
if (recurse) then
527+
528+
allocate(sub_dir_files(0))
529+
530+
do i=1,size(files)
531+
if (is_dir_c(files(i)%s//c_null_char)) then
532+
call list_files(files(i)%s, dir_files, recurse=.true.)
533+
sub_dir_files = [sub_dir_files, dir_files]
534+
end if
535+
end do
536+
537+
files = [files, sub_dir_files]
538+
end if
539+
end if
540+
end subroutine list_files
541+
542+
function is_dir_c(path) result(r)
543+
character(kind=c_char), intent(in) :: path(*)
544+
logical :: r
545+
type(stat_t), target :: buf
546+
integer(kind=c_int) :: exists
547+
integer(kind=c_int), parameter :: S_IFMT = 61440
548+
integer(kind=c_int), parameter :: S_IFDIR = 16384
549+
550+
exists = c_stat(path, c_loc(buf))
551+
r = exists .eq. 0 .and. iand(int(buf%st_mode, kind=c_int), S_IFMT) .eq. S_IFDIR
552+
end function is_dir_c
553+
554+
#else
315555
!> Get file & directory names in directory `dir`.
316556
!!
317557
!! - File/directory names return are relative to cwd, ie. preprended with `dir`
@@ -376,7 +616,7 @@ recursive subroutine list_files(dir, files, recurse)
376616
end if
377617

378618
end subroutine list_files
379-
619+
#endif
380620

381621
!> test if pathname already exists
382622
logical function exists(filename) result(r)

0 commit comments

Comments
 (0)