diff --git a/src/fpm_filesystem.F90 b/src/fpm_filesystem.F90 index ca521346b3..6d65154df1 100644 --- a/src/fpm_filesystem.F90 +++ b/src/fpm_filesystem.F90 @@ -2,11 +2,12 @@ !! module fpm_filesystem use,intrinsic :: iso_fortran_env, only : stdin=>input_unit, stdout=>output_unit, stderr=>error_unit + use,intrinsic :: iso_c_binding, only: c_new_line use fpm_environment, only: get_os_type, & OS_UNKNOWN, OS_LINUX, OS_MACOS, OS_WINDOWS, & OS_CYGWIN, OS_SOLARIS, OS_FREEBSD, OS_OPENBSD use fpm_environment, only: separator, get_env, os_is_unix - use fpm_strings, only: f_string, replace, string_t, split, dilate, str_begins_with_str + use fpm_strings, only: f_string, replace, string_t, split, split_first_last, dilate, str_begins_with_str 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, error_t, fatal_error implicit none @@ -50,6 +51,8 @@ end function c_is_dir end interface #endif + character(*), parameter :: eol = new_line('a') !! End of line + contains !> Extract filename from path with/without suffix @@ -302,37 +305,71 @@ integer function number_of_rows(s) result(nrows) end function number_of_rows !> read lines into an array of TYPE(STRING_T) variables expanding tabs -function read_lines_expanded(fh) result(lines) - integer, intent(in) :: fh +function read_lines_expanded(filename) result(lines) + character(len=*), intent(in) :: filename type(string_t), allocatable :: lines(:) integer :: i - integer :: iostat - character(len=:),allocatable :: line_buffer_read + character(len=:), allocatable :: content + integer, allocatable :: first(:), last(:) + + content = read_text_file(filename) + if (len(content) == 0) then + allocate (lines(0)) + return + end if + + call split_first_last(content, eol, first, last) ! TODO: \r (< macOS X), \n (>=macOS X/Linux/Unix), \r\n (Windows) - allocate(lines(number_of_rows(fh))) - do i = 1, size(lines) - call getline(fh, line_buffer_read, iostat) - lines(i)%s = dilate(line_buffer_read) + ! allocate lines from file content string + allocate (lines(size(first))) + do i = 1, size(first) + allocate(lines(i)%s, source=dilate(content(first(i):last(i)))) end do end function read_lines_expanded !> read lines into an array of TYPE(STRING_T) variables -function read_lines(fh) result(lines) - integer, intent(in) :: fh +function read_lines(filename) result(lines) + character(len=*), intent(in) :: filename type(string_t), allocatable :: lines(:) integer :: i - integer :: iostat + character(len=:), allocatable :: content + integer, allocatable :: first(:), last(:) - allocate(lines(number_of_rows(fh))) - do i = 1, size(lines) - call getline(fh, lines(i)%s, iostat) + content = read_text_file(filename) + if (len(content) == 0) then + allocate (lines(0)) + return + end if + + call split_first_last(content, eol, first, last) ! TODO: \r (< macOS X), \n (>=macOS X/Linux/Unix), \r\n (Windows) + + ! allocate lines from file content string + allocate (lines(size(first))) + do i = 1, size(first) + allocate(lines(i)%s, source=content(first(i):last(i))) end do end function read_lines +!> read text file into a string +function read_text_file(filename) result(string) + character(len=*), intent(in) :: filename + character(len=:), allocatable :: string + integer :: fh, length + + open (newunit=fh, file=filename, status='old', action='read', & + access='stream', form='unformatted') + inquire (fh, size=length) + allocate (character(len=length) :: string) + if (length == 0) return + read (fh) string + close (fh) + +end function read_text_file + !> Create a directory. Create subdirectories as needed subroutine mkdir(dir, echo) character(len=*), intent(in) :: dir @@ -480,9 +517,8 @@ recursive subroutine list_files(dir, files, recurse) call fpm_stop(2,'*list_files*:directory listing failed') end if - open (newunit=fh, file=temp_file, status='old') - files = read_lines(fh) - close(fh,status="delete") + files = read_lines(temp_file) + call delete_file(temp_file) do i=1,size(files) files(i)%s = join_path(dir,files(i)%s) @@ -678,7 +714,7 @@ subroutine getline(unit, line, iostat, iomsg) !> Error message character(len=:), allocatable, optional :: iomsg - integer, parameter :: BUFFER_SIZE = 32768 + integer, parameter :: BUFFER_SIZE = 1024 character(len=BUFFER_SIZE) :: buffer character(len=256) :: msg integer :: size diff --git a/src/fpm_source_parsing.f90 b/src/fpm_source_parsing.f90 index f303a1c2cf..59f8fd4d33 100644 --- a/src/fpm_source_parsing.f90 +++ b/src/fpm_source_parsing.f90 @@ -82,9 +82,7 @@ function parse_f_source(f_filename,error) result(f_source) f_source%file_name = f_filename - open(newunit=fh,file=f_filename,status='old') - file_lines = read_lines_expanded(fh) - close(fh) + file_lines = read_lines_expanded(f_filename) ! for efficiency in parsing make a lowercase left-adjusted copy of the file ! Need a copy because INCLUDE (and #include) file arguments are case-sensitive @@ -427,9 +425,7 @@ function parse_c_source(c_filename,error) result(c_source) allocate(c_source%modules_provided(0)) allocate(c_source%parent_modules(0)) - open(newunit=fh,file=c_filename,status='old') - file_lines = read_lines(fh) - close(fh) + file_lines = read_lines(c_filename) ! Ignore empty files, returned as FPM_UNIT_UNKNOWN if (len_trim(file_lines) < 1) then diff --git a/src/fpm_strings.f90 b/src/fpm_strings.f90 index e7c92beaf2..bf43a4b53b 100644 --- a/src/fpm_strings.f90 +++ b/src/fpm_strings.f90 @@ -13,6 +13,8 @@ !! - [[LOWER]] Changes a string to lowercase over optional specified column range !!### Parsing and joining !! - [[SPLIT]] parse string on delimiter characters and store tokens into an allocatable array +!! - [[SPLIT_FIRST_LAST]] Computes the first and last indices of tokens in input string, delimited by the characters in set, +!! and stores them into first and last output arrays. !! - [[STRING_CAT]] Concatenate an array of **type(string_t)** into a single **CHARACTER** variable !! - [[JOIN]] append an array of **CHARACTER** variables into a single **CHARACTER** variable !!### Testing @@ -40,7 +42,7 @@ module fpm_strings implicit none private -public :: f_string, lower, upper, split, str_ends_with, string_t, str_begins_with_str +public :: f_string, lower, upper, split, split_first_last, str_ends_with, string_t, str_begins_with_str public :: to_fortran_name, is_fortran_name public :: string_array_contains, string_cat, len_trim, operator(.in.), fnv_1a public :: replace, resize, str, join, glob @@ -518,6 +520,73 @@ subroutine split(input_line,array,delimiters,order,nulls) enddo end subroutine split +!! Author: Milan Curcic +!! Computes the first and last indices of tokens in input string, delimited +!! by the characters in set, and stores them into first and last output +!! arrays. +pure subroutine split_first_last(string, set, first, last) + character(*), intent(in) :: string + character(*), intent(in) :: set + integer, allocatable, intent(out) :: first(:) + integer, allocatable, intent(out) :: last(:) + + integer, dimension(len(string) + 1) :: istart, iend + integer :: p, n, slen + + slen = len(string) + + n = 0 + if (slen > 0) then + p = 0 + do while (p < slen) + n = n + 1 + istart(n) = min(p + 1, slen) + call split_pos(string, set, p) + iend(n) = p - 1 + end do + end if + + first = istart(:n) + last = iend(:n) + +end subroutine split_first_last + +!! Author: Milan Curcic +!! If back is absent, computes the leftmost token delimiter in string whose +!! position is > pos. If back is present and true, computes the rightmost +!! token delimiter in string whose position is < pos. The result is stored +!! in pos. +pure subroutine split_pos(string, set, pos, back) + character(*), intent(in) :: string + character(*), intent(in) :: set + integer, intent(in out) :: pos + logical, intent(in), optional :: back + + logical :: backward + integer :: result_pos, bound + + if (len(string) == 0) then + pos = 1 + return + end if + + !TODO use optval when implemented in stdlib + !backward = optval(back, .false.) + backward = .false. + if (present(back)) backward = back + + if (backward) then + bound = min(len(string), max(pos - 1, 0)) + result_pos = scan(string(:bound), set, back=.true.) + else + result_pos = scan(string(min(pos + 1, len(string)):), set) + pos + if (result_pos < pos + 1) result_pos = len(string) + 1 + end if + + pos = result_pos + +end subroutine split_pos + !> Returns string with characters in charset replaced with target_char. pure function replace(string, charset, target_char) result(res) character(*), intent(in) :: string @@ -1371,7 +1440,7 @@ subroutine remove_newline_characters(string) integer :: feed,length - character(*), parameter :: CRLF = new_line('a')//achar(13) + character(*), parameter :: CRLF = achar(13)//new_line('a') character(*), parameter :: SPACE = ' ' call remove_characters_in_set(string%s,set=CRLF,replace_with=SPACE)