list_files Subroutine

public recursive subroutine list_files(dir, files, recurse)

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

Arguments

Type IntentOptional Attributes Name
character(len=*), intent(in) :: dir
type(string_t), intent(out), allocatable :: files(:)
logical, intent(in), optional :: recurse

Source Code

recursive subroutine list_files(dir, files, recurse)
    character(len=*), intent(in) :: dir
    type(string_t), allocatable, intent(out) :: files(:)
    logical, intent(in), optional :: recurse

    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

    if (c_is_dir(dir(1:len_trim(dir))//c_null_char) == 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 == '.' .or. string_fortran == '..')) then
                cycle
            end if

            i = i + 1

            if (i > N_MAX) then
                files = [files, files_tmp]
                i = 1
            end if

            files_tmp(i)%s = join_path(dir, string_fortran)
        end if
    end do

    r = c_closedir(dir_handle)

    if (r /= 0) then
        print *, 'c_closedir() failed'
        error stop
    end if

    if (i > 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) /= 0) then
                    call list_files(files(i)%s, dir_files, recurse=.true.)
                    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