Skip to content

Commit

Permalink
fix Windows bootstrap (#1107)
Browse files Browse the repository at this point in the history
  • Loading branch information
perazz authored Mar 11, 2025
2 parents ac06dfc + f2a2fbb commit 1ae7351
Show file tree
Hide file tree
Showing 3 changed files with 191 additions and 8 deletions.
8 changes: 3 additions & 5 deletions src/fpm_filesystem.F90
Original file line number Diff line number Diff line change
Expand Up @@ -7,7 +7,7 @@ module fpm_filesystem
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, split_first_last, dilate, str_begins_with_str
use fpm_strings, only: f_string, replace, string_t, split, split_lines_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
Expand Down Expand Up @@ -51,8 +51,6 @@ 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
Expand Down Expand Up @@ -319,7 +317,7 @@ function read_lines_expanded(filename) result(lines)
return
end if

call split_first_last(content, eol, first, last) ! TODO: \r (< macOS X), \n (>=macOS X/Linux/Unix), \r\n (Windows)
call split_lines_first_last(content, first, last)

! allocate lines from file content string
allocate (lines(size(first)))
Expand All @@ -344,7 +342,7 @@ function read_lines(filename) result(lines)
return
end if

call split_first_last(content, eol, first, last) ! TODO: \r (< macOS X), \n (>=macOS X/Linux/Unix), \r\n (Windows)
call split_lines_first_last(content, first, last)

! allocate lines from file content string
allocate (lines(size(first)))
Expand Down
47 changes: 46 additions & 1 deletion src/fpm_strings.f90
Original file line number Diff line number Diff line change
Expand Up @@ -42,7 +42,7 @@ module fpm_strings
implicit none

private
public :: f_string, lower, upper, split, split_first_last, str_ends_with, string_t, str_begins_with_str
public :: f_string, lower, upper, split, split_first_last, split_lines_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
Expand Down Expand Up @@ -551,6 +551,51 @@ pure subroutine split_first_last(string, set, first, last)

end subroutine split_first_last

!! Author: Federico Perini
!! Computes the first and last indices of lines in input string, delimited
!! by either CR, LF, or CRLF, and stores them into first and last output
!! arrays.
pure subroutine split_lines_first_last(string, first, last)
character(*), intent(in) :: string
integer, allocatable, intent(out) :: first(:)
integer, allocatable, intent(out) :: last(:)

integer, dimension(len(string) + 1) :: istart, iend
integer :: p, n, slen
character, parameter :: CR = achar(13)
character, parameter :: LF = new_line('A')

slen = len(string)

n = 0
if (slen > 0) then
p = 1
do while (p <= slen)

if (index(CR//LF, string(p:p)) == 0) then
n = n + 1
istart(n) = p
do while (p <= slen)
if (index(CR//LF, string(p:p)) /= 0) exit
p = p + 1
end do
iend(n) = p - 1
end if

! Handle Windows CRLF by skipping LF after CR
if (p < slen) then
if (string(p:p) == CR .and. string(p+1:p+1) == LF) p = p + 1
endif

p = p + 1
end do
end if

first = istart(:n)
last = iend(:n)

end subroutine split_lines_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
Expand Down
144 changes: 142 additions & 2 deletions test/fpm_test/test_filesystem.f90
Original file line number Diff line number Diff line change
@@ -1,8 +1,10 @@
module test_filesystem
use testsuite, only: new_unittest, unittest_t, error_t, test_failed
use fpm_filesystem, only: canon_path, is_dir, mkdir, os_delete_dir, &
join_path, is_absolute_path, get_home
join_path, is_absolute_path, get_home, &
delete_file, read_lines, get_temp_filename
use fpm_environment, only: OS_WINDOWS, get_os_type, os_is_unix
use fpm_strings, only: string_t, split_lines_first_last
implicit none
private

Expand All @@ -20,7 +22,9 @@ subroutine collect_filesystem(tests)
& new_unittest("canon-path", test_canon_path), &
& new_unittest("create-delete-directory", test_mkdir_rmdir), &
& new_unittest("test-is-absolute-path", test_is_absolute_path), &
& new_unittest("test-get-home", test_get_home) &
& new_unittest("test-get-home", test_get_home), &
& new_unittest("test-split-lines-first-last", test_split_lines_first_last), &
& new_unittest("test-crlf-lines", test_dir_with_crlf) &
]

end subroutine collect_filesystem
Expand Down Expand Up @@ -289,5 +293,141 @@ subroutine test_get_home(error)
end if

end subroutine test_get_home

! Test line splitting on MS windows
subroutine test_split_lines_first_last(error)
!> Error handling
type(error_t), allocatable, intent(out) :: error

character, parameter :: CR = achar(13)
character, parameter :: LF = new_line('A')
character(*), parameter :: CRLF = CR//LF
integer, allocatable :: first(:), last(:)

call split_lines_first_last(CR//LF//'line1'//CR//'line2'//LF//'line3'//CR//LF//'hello', first, last)
if (.not.(all(first==[3,9,15,22]) .and. all(last==[7,13,19,26]))) then
call test_failed(error, "Test split_lines_first_last #1 failed")
return
end if

call split_lines_first_last('single_line', first, last)
if (.not.(all(first==[1]) .and. all(last==[11]))) then
call test_failed(error, "Test split_lines_first_last #2 failed")
return
end if

call split_lines_first_last(CR//LF//CR//LF//'test', first, last)
if (.not.(all(first == [5]) .and. all(last == [8]))) then
call test_failed(error, "Test split_lines_first_last #3 failed")
return
end if

call split_lines_first_last('a'//CR//'b'//LF//'c'//CR//LF//'d', first, last)
if (.not.(all(first == [1, 3, 5, 8]) .and. all(last == [1, 3, 5, 8]))) then
call test_failed(error, "Test split_lines_first_last #4 failed")
return
end if

call split_lines_first_last('', first, last)
if (.not.(size(first) == 0 .and. size(last) == 0)) then
call test_failed(error, "Test split_lines_first_last #5 failed")
return
end if

call split_lines_first_last('build.f90'//CRLF//&
'dependency.f90'//CRLF//&
'example.f90'//CRLF//&
'executable.f90'//CRLF//&
'fortran.f90'//CRLF, &
first, last)

if (.not.(all(first == [1,12,28,41,57]) .and. all(last == [9,25,38,54,67]))) then
call test_failed(error, "Test split_lines_first_last #6 failed")
return
end if

end subroutine test_split_lines_first_last

! On MS windows, directory listings are printed to files with CR//LF endings.
! Check that the lines can be properly read back from such files.
subroutine test_dir_with_crlf(error)
type(error_t), allocatable, intent(out) :: error

character, parameter :: CR = achar(13)
character, parameter :: LF = new_line('A')
character(*), parameter :: CRLF = CR//LF

character(*), parameter :: test_lines = 'build.f90'//CRLF//&
'dependency.f90'//CRLF//&
'example.f90'//CRLF//&
'executable.f90'//CRLF//&
'fortran.f90'//CRLF

type(string_t), allocatable :: lines(:)
character(len=:), allocatable :: temp_file
character(256) :: msg
integer :: unit, i, ios

temp_file = get_temp_filename()

open(newunit=unit,file=temp_file,access='stream',action='write',iostat=ios)
if (ios/=0) then
call test_failed(error, "cannot create temporary file")
return
end if

write(unit,iostat=ios) test_lines
if (ios/=0) then
call test_failed(error, "cannot write to temporary file")
return
end if

close(unit,iostat=ios)
if (ios/=0) then
call test_failed(error, "cannot close temporary file")
return
end if

lines = read_lines(temp_file)

if (.not.allocated(lines)) then
write(msg, 1) 'no output'
call test_failed(error, msg)
return
end if

if (size(lines)/=5) then
write(msg, 1) 'wrong number of lines: expected ',5,', actual ',size(lines)
call test_failed(error, msg)
return
end if

if (lines(1)%s/='build.f90') then
call test_failed(error, "Failed reading file with CRLF: at build.f90")
return
end if
if (lines(2)%s/='dependency.f90') then
call test_failed(error, "Failed reading file with CRLF: at dependency.f90")
return
end if
if (lines(3)%s/='example.f90') then
call test_failed(error, "Failed reading file with CRLF: at example.f90")
return
end if
if (lines(4)%s/='executable.f90') then
call test_failed(error, "Failed reading file with CRLF: at executable.f90")
return
end if
if (lines(5)%s/='fortran.f90') then
call test_failed(error, "Failed reading file with CRLF: at fortran.f90")
return
end if

call delete_file(temp_file)

1 format("Failed reading file with CRLF: ",a,:,i0,:,a,:,i0)

end subroutine test_dir_with_crlf


end module test_filesystem

0 comments on commit 1ae7351

Please sign in to comment.