From d71a3ffd7bacdf59163afda89549998283d497df Mon Sep 17 00:00:00 2001 From: Federico Perini Date: Tue, 11 Mar 2025 03:29:20 -0500 Subject: [PATCH 01/14] expand tabs reading directory to avoid CRLF issues --- src/fpm_filesystem.F90 | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/fpm_filesystem.F90 b/src/fpm_filesystem.F90 index a0066708d7..f65204f1f6 100644 --- a/src/fpm_filesystem.F90 +++ b/src/fpm_filesystem.F90 @@ -517,7 +517,7 @@ recursive subroutine list_files(dir, files, recurse) call fpm_stop(2,'*list_files*:directory listing failed') end if - files = read_lines(temp_file) + files = read_lines_expanded(temp_file) call delete_file(temp_file) do i=1,size(files) From e6108d1d5147039281c490849d148ebdd5b6baee Mon Sep 17 00:00:00 2001 From: Federico Perini Date: Tue, 11 Mar 2025 03:39:45 -0500 Subject: [PATCH 02/14] add test --- src/fpm_filesystem.F90 | 2 +- test/fpm_test/test_filesystem.f90 | 82 ++++++++++++++++++++++++++++++- 2 files changed, 81 insertions(+), 3 deletions(-) diff --git a/src/fpm_filesystem.F90 b/src/fpm_filesystem.F90 index f65204f1f6..a0066708d7 100644 --- a/src/fpm_filesystem.F90 +++ b/src/fpm_filesystem.F90 @@ -517,7 +517,7 @@ recursive subroutine list_files(dir, files, recurse) call fpm_stop(2,'*list_files*:directory listing failed') end if - files = read_lines_expanded(temp_file) + files = read_lines(temp_file) call delete_file(temp_file) do i=1,size(files) diff --git a/test/fpm_test/test_filesystem.f90 b/test/fpm_test/test_filesystem.f90 index ad6e86d853..8c30c5ba95 100644 --- a/test/fpm_test/test_filesystem.f90 +++ b/test/fpm_test/test_filesystem.f90 @@ -1,7 +1,8 @@ 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 implicit none private @@ -20,7 +21,8 @@ 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-crlf-lines", test_dir_with_crlf) & ] end subroutine collect_filesystem @@ -289,5 +291,81 @@ subroutine test_get_home(error) end if end subroutine test_get_home + + ! On MS windows, + 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 + 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 + call test_failed(error, "Failed reading file with CRLF: no output") + return + end if + + if (size(lines)/=5) then + call test_failed(error, "Failed reading file with CRLF: wrong number of lines") + return + end if + + if (lines(1)/='build.f90') then + call test_failed(error, "Failed reading file with CRLF: at build.f90") + return + end if + if (lines(2)/='dependency.f90') then + call test_failed(error, "Failed reading file with CRLF: at dependency.f90") + return + end if + if (lines(3)/='example.f90') then + call test_failed(error, "Failed reading file with CRLF: at example.f90") + return + end if + if (lines(4)/='executable.f90') then + call test_failed(error, "Failed reading file with CRLF: at executable.f90") + return + end if + if (lines(5)/='fortran.f90') then + call test_failed(error, "Failed reading file with CRLF: at fortran.f90") + return + end if + + call delete_dile(temp_file) + + end subroutine test_dir_with_crlf + end module test_filesystem From 7e578a47b2bc3bba80d9781669645497fd49113c Mon Sep 17 00:00:00 2001 From: Federico Perini Date: Tue, 11 Mar 2025 03:43:20 -0500 Subject: [PATCH 03/14] Update test_filesystem.f90 --- test/fpm_test/test_filesystem.f90 | 1 + 1 file changed, 1 insertion(+) diff --git a/test/fpm_test/test_filesystem.f90 b/test/fpm_test/test_filesystem.f90 index 8c30c5ba95..7a540935bd 100644 --- a/test/fpm_test/test_filesystem.f90 +++ b/test/fpm_test/test_filesystem.f90 @@ -4,6 +4,7 @@ module test_filesystem 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 implicit none private From 6f54b500f0cd714acb97266722f1b25ee6fd9c3c Mon Sep 17 00:00:00 2001 From: Federico Perini Date: Tue, 11 Mar 2025 03:50:17 -0500 Subject: [PATCH 04/14] Update test_filesystem.f90 --- test/fpm_test/test_filesystem.f90 | 12 ++++++------ 1 file changed, 6 insertions(+), 6 deletions(-) diff --git a/test/fpm_test/test_filesystem.f90 b/test/fpm_test/test_filesystem.f90 index 7a540935bd..8e3a0b3972 100644 --- a/test/fpm_test/test_filesystem.f90 +++ b/test/fpm_test/test_filesystem.f90 @@ -343,28 +343,28 @@ subroutine test_dir_with_crlf(error) return end if - if (lines(1)/='build.f90') then + 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)/='dependency.f90') then + 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)/='example.f90') then + 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)/='executable.f90') then + 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)/='fortran.f90') then + if (lines(5)%s/='fortran.f90') then call test_failed(error, "Failed reading file with CRLF: at fortran.f90") return end if - call delete_dile(temp_file) + call delete_file(temp_file) end subroutine test_dir_with_crlf From db457718a30619be3b61b82208cd6ce7357200a5 Mon Sep 17 00:00:00 2001 From: Federico Perini Date: Tue, 11 Mar 2025 04:02:28 -0500 Subject: [PATCH 05/14] check CR,LF --- src/fpm_filesystem.F90 | 4 +++- 1 file changed, 3 insertions(+), 1 deletion(-) diff --git a/src/fpm_filesystem.F90 b/src/fpm_filesystem.F90 index a0066708d7..3c9d4a2a86 100644 --- a/src/fpm_filesystem.F90 +++ b/src/fpm_filesystem.F90 @@ -51,7 +51,9 @@ end function c_is_dir end interface #endif - character(*), parameter :: eol = new_line('a') !! End of line + character, parameter :: CR = achar(13) + character, parameter :: LF = new_line('A') + character(*), parameter :: eol = CR//LF contains From 95a0a6a91ec8e38d3473a2af9d6d97117dd973ae Mon Sep 17 00:00:00 2001 From: Federico Perini Date: Tue, 11 Mar 2025 04:22:02 -0500 Subject: [PATCH 06/14] split_lines_first_last --- src/fpm_filesystem.F90 | 10 +++------ src/fpm_strings.f90 | 46 +++++++++++++++++++++++++++++++++++++++++- 2 files changed, 48 insertions(+), 8 deletions(-) diff --git a/src/fpm_filesystem.F90 b/src/fpm_filesystem.F90 index 3c9d4a2a86..0e7e221b7f 100644 --- a/src/fpm_filesystem.F90 +++ b/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,10 +51,6 @@ end function c_is_dir end interface #endif - character, parameter :: CR = achar(13) - character, parameter :: LF = new_line('A') - character(*), parameter :: eol = CR//LF - contains !> Extract filename from path with/without suffix @@ -321,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))) @@ -346,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))) diff --git a/src/fpm_strings.f90 b/src/fpm_strings.f90 index bf43a4b53b..e8771b2165 100644 --- a/src/fpm_strings.f90 +++ b/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,50 @@ 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 .and. index(CR//LF, string(p:p)) == 0) + 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 From 26d0ac592d3e11e435f2a2fe2c675ef9ab6f06e1 Mon Sep 17 00:00:00 2001 From: Federico Perini Date: Tue, 11 Mar 2025 04:25:52 -0500 Subject: [PATCH 07/14] safe loop --- src/fpm_strings.f90 | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/src/fpm_strings.f90 b/src/fpm_strings.f90 index e8771b2165..f2803794b6 100644 --- a/src/fpm_strings.f90 +++ b/src/fpm_strings.f90 @@ -575,7 +575,8 @@ pure subroutine split_lines_first_last(string, first, last) if (index(CR//LF, string(p:p)) == 0) then n = n + 1 istart(n) = p - do while (p <= slen .and. index(CR//LF, string(p:p)) == 0) + do while (p <= slen) + if (index(CR//LF, string(p:p)) == 0) exit p = p + 1 end do iend(n) = p - 1 From 39b67b34a5dcdeb376afe87af60ae592899938a9 Mon Sep 17 00:00:00 2001 From: Federico Perini Date: Tue, 11 Mar 2025 04:27:27 -0500 Subject: [PATCH 08/14] test split_lines_first_last --- test/fpm_test/test_filesystem.f90 | 39 ++++++++++++++++++++++++++++++- 1 file changed, 38 insertions(+), 1 deletion(-) diff --git a/test/fpm_test/test_filesystem.f90 b/test/fpm_test/test_filesystem.f90 index 8e3a0b3972..023f63fae0 100644 --- a/test/fpm_test/test_filesystem.f90 +++ b/test/fpm_test/test_filesystem.f90 @@ -4,7 +4,7 @@ module test_filesystem 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 + use fpm_strings, only: string_t, split_lines_first_last implicit none private @@ -23,6 +23,7 @@ subroutine collect_filesystem(tests) & 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-split-lines-first-last", test_split_lines_first_last), & & new_unittest("test-crlf-lines", test_dir_with_crlf) & ] @@ -293,6 +294,42 @@ subroutine test_get_home(error) 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') + integer, allocatable :: first(:), last(:) + + call check_array(error, & + & split_lines_first_last(CR//LF//'line1'//CR//'line2'//LF//'line3'//CR//LF//'hello', first, last), & + & [3, 9, 15, 23], [7, 13, 21, 27]) + if (allocated(error)) return + + call check_array(error, & + & split_lines_first_last('single_line', first, last), & + & [1], [11]) + if (allocated(error)) return + + call check_array(error, & + & split_lines_first_last(CR//LF//CR//LF//'test', first, last), & + & [5], [8]) + if (allocated(error)) return + + call check_array(error, & + & split_lines_first_last('a'//CR//'b'//LF//'c'//CR//LF//'d', first, last), & + & [1, 3, 5, 8], [1, 3, 5, 8]) + if (allocated(error)) return + + call check_array(error, & + & split_lines_first_last('', first, last), & + & [], []) + if (allocated(error)) return + + end subroutine test_split_lines_first_last + ! On MS windows, subroutine test_dir_with_crlf(error) type(error_t), allocatable, intent(out) :: error From ff3d0f020c04489d17c113875a5ae226e37520cc Mon Sep 17 00:00:00 2001 From: Federico Perini Date: Tue, 11 Mar 2025 04:32:13 -0500 Subject: [PATCH 09/14] Update test_filesystem.f90 --- test/fpm_test/test_filesystem.f90 | 47 +++++++++++++++++-------------- 1 file changed, 26 insertions(+), 21 deletions(-) diff --git a/test/fpm_test/test_filesystem.f90 b/test/fpm_test/test_filesystem.f90 index 023f63fae0..5943184f4b 100644 --- a/test/fpm_test/test_filesystem.f90 +++ b/test/fpm_test/test_filesystem.f90 @@ -302,31 +302,36 @@ subroutine test_split_lines_first_last(error) character, parameter :: CR = achar(13) character, parameter :: LF = new_line('A') 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,23]) .and. all(last==[7,13,21,27]))) then + call test_failed(error, "Test split_lines_first_last #1 failed") + return + end if - call check_array(error, & - & split_lines_first_last(CR//LF//'line1'//CR//'line2'//LF//'line3'//CR//LF//'hello', first, last), & - & [3, 9, 15, 23], [7, 13, 21, 27]) - if (allocated(error)) return - - call check_array(error, & - & split_lines_first_last('single_line', first, last), & - & [1], [11]) - if (allocated(error)) return + 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 check_array(error, & - & split_lines_first_last(CR//LF//CR//LF//'test', first, last), & - & [5], [8]) - if (allocated(error)) return + 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 check_array(error, & - & split_lines_first_last('a'//CR//'b'//LF//'c'//CR//LF//'d', first, last), & - & [1, 3, 5, 8], [1, 3, 5, 8]) - if (allocated(error)) return + 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 check_array(error, & - & split_lines_first_last('', first, last), & - & [], []) - if (allocated(error)) return + 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 end subroutine test_split_lines_first_last From 837590c345a1f322cbebf0cbb9b66d669fe131a7 Mon Sep 17 00:00:00 2001 From: Federico Perini Date: Tue, 11 Mar 2025 04:38:13 -0500 Subject: [PATCH 10/14] Update test_filesystem.f90 --- test/fpm_test/test_filesystem.f90 | 11 ++++++++--- 1 file changed, 8 insertions(+), 3 deletions(-) diff --git a/test/fpm_test/test_filesystem.f90 b/test/fpm_test/test_filesystem.f90 index 5943184f4b..0661e190e2 100644 --- a/test/fpm_test/test_filesystem.f90 +++ b/test/fpm_test/test_filesystem.f90 @@ -304,7 +304,7 @@ subroutine test_split_lines_first_last(error) 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,23]) .and. all(last==[7,13,21,27]))) then + if (.not.(all(first==[3,9,15,21]) .and. all(last==[7,13,18,25]))) then call test_failed(error, "Test split_lines_first_last #1 failed") return end if @@ -351,6 +351,7 @@ subroutine test_dir_with_crlf(error) type(string_t), allocatable :: lines(:) character(len=:), allocatable :: temp_file + character(256) :: msg integer :: unit, i, ios temp_file = get_temp_filename() @@ -376,12 +377,14 @@ subroutine test_dir_with_crlf(error) lines = read_lines(temp_file) if (.not.allocated(lines)) then - call test_failed(error, "Failed reading file with CRLF: no output") + write(msg, 1) 'no output' + call test_failed(error, msg) return end if if (size(lines)/=5) then - call test_failed(error, "Failed reading file with CRLF: wrong number of lines") + write(msg, 1) 'wrong number of lines: expected ',5,', actual ',size(lines) + call test_failed(error, msg) return end if @@ -408,6 +411,8 @@ subroutine test_dir_with_crlf(error) call delete_file(temp_file) + 1 format("Failed reading file with CRLF: ",a,:,i0,:,a,:,i0) + end subroutine test_dir_with_crlf From ea2ee73feff973d4464bc06101bec82eb64a1cbe Mon Sep 17 00:00:00 2001 From: Federico Perini Date: Tue, 11 Mar 2025 04:43:29 -0500 Subject: [PATCH 11/14] fix split_lines --- src/fpm_strings.f90 | 2 +- test/fpm_test/test_filesystem.f90 | 2 +- 2 files changed, 2 insertions(+), 2 deletions(-) diff --git a/src/fpm_strings.f90 b/src/fpm_strings.f90 index f2803794b6..b039271994 100644 --- a/src/fpm_strings.f90 +++ b/src/fpm_strings.f90 @@ -576,7 +576,7 @@ pure subroutine split_lines_first_last(string, first, last) n = n + 1 istart(n) = p do while (p <= slen) - if (index(CR//LF, string(p:p)) == 0) exit + if (index(CR//LF, string(p:p)) /= 0) exit p = p + 1 end do iend(n) = p - 1 diff --git a/test/fpm_test/test_filesystem.f90 b/test/fpm_test/test_filesystem.f90 index 0661e190e2..827d37a1d6 100644 --- a/test/fpm_test/test_filesystem.f90 +++ b/test/fpm_test/test_filesystem.f90 @@ -304,7 +304,7 @@ subroutine test_split_lines_first_last(error) 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,21]) .and. all(last==[7,13,18,25]))) then + 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 From b91f1d0518fdf9524fc2ef01cfc35c1c0af07724 Mon Sep 17 00:00:00 2001 From: Federico Perini Date: Tue, 11 Mar 2025 04:50:05 -0500 Subject: [PATCH 12/14] one more test --- test/fpm_test/test_filesystem.f90 | 18 +++++++++++++++--- 1 file changed, 15 insertions(+), 3 deletions(-) diff --git a/test/fpm_test/test_filesystem.f90 b/test/fpm_test/test_filesystem.f90 index 827d37a1d6..c2639bfbbc 100644 --- a/test/fpm_test/test_filesystem.f90 +++ b/test/fpm_test/test_filesystem.f90 @@ -299,9 +299,10 @@ 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') - integer, allocatable :: first(:), last(:) + 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 @@ -332,6 +333,17 @@ subroutine test_split_lines_first_last(error) 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 From 29182b4bd83cbc180704eea02ec4e9a7d1134a33 Mon Sep 17 00:00:00 2001 From: Federico Perini Date: Tue, 11 Mar 2025 04:54:46 -0500 Subject: [PATCH 13/14] Update test_filesystem.f90 --- test/fpm_test/test_filesystem.f90 | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/test/fpm_test/test_filesystem.f90 b/test/fpm_test/test_filesystem.f90 index c2639bfbbc..0aba718603 100644 --- a/test/fpm_test/test_filesystem.f90 +++ b/test/fpm_test/test_filesystem.f90 @@ -338,7 +338,8 @@ subroutine test_split_lines_first_last(error) 'dependency.f90'//CRLF//& 'example.f90'//CRLF//& 'executable.f90'//CRLF//& - 'fortran.f90'//CRLF, first, last)) + '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") From f2a2fbb1048fd715f19d83e7e7f4613788437a12 Mon Sep 17 00:00:00 2001 From: Federico Perini Date: Tue, 11 Mar 2025 04:55:41 -0500 Subject: [PATCH 14/14] add comment --- test/fpm_test/test_filesystem.f90 | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/test/fpm_test/test_filesystem.f90 b/test/fpm_test/test_filesystem.f90 index 0aba718603..4c8d499bbf 100644 --- a/test/fpm_test/test_filesystem.f90 +++ b/test/fpm_test/test_filesystem.f90 @@ -348,7 +348,8 @@ subroutine test_split_lines_first_last(error) end subroutine test_split_lines_first_last - ! On MS windows, + ! 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