fix Windows bootstrap (#1107)

Author: perazz

src/fpm_filesystem.F90

@@ -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
@@ -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
@@ -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)))
@@ -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)))

src/fpm_strings.f90

@@ -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
@@ -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

test/fpm_test/test_filesystem.f90

@@ -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
 
@@ -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
@@ -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