From ffc53a7b3d63308a6f1c0153d96cb5f80e78f31d Mon Sep 17 00:00:00 2001 From: ZUO Zhihua Date: Fri, 21 Mar 2025 01:58:23 +0800 Subject: [PATCH 1/6] Add the delimiter argument to the loadtxt and savetxt functions. --- doc/specs/stdlib_io.md | 8 +++-- example/io/example.csv | 3 ++ example/io/example_loadtxt.f90 | 3 ++ example/io/example_savetxt.f90 | 1 + src/stdlib_io.fypp | 66 ++++++++++++++++++++++++---------- test/io/test_loadtxt.f90 | 16 +++++++++ 6 files changed, 75 insertions(+), 22 deletions(-) create mode 100644 example/io/example.csv diff --git a/doc/specs/stdlib_io.md b/doc/specs/stdlib_io.md index 0ae2b11b3..ef87ffa61 100644 --- a/doc/specs/stdlib_io.md +++ b/doc/specs/stdlib_io.md @@ -17,7 +17,7 @@ Loads a rank-2 `array` from a text file. ### Syntax -`call ` [[stdlib_io(module):loadtxt(interface)]] `(filename, array [, skiprows] [, max_rows] [, fmt])` +`call ` [[stdlib_io(module):loadtxt(interface)]] `(filename, array [, skiprows] [, max_rows] [, fmt] [, delimiter])` ### Arguments @@ -31,7 +31,7 @@ Loads a rank-2 `array` from a text file. `fmt` (optional): Fortran format specifier for the text read. Defaults to the write format for the data type. Setting fmt='*' will specify list directed read. - +`delimiter` (optional): Shall be a character expression of length 1 that contains the delimiter used to separate the columns. The default is `' '`. ### Return value @@ -105,7 +105,7 @@ Saves a rank-2 `array` into a text file. ### Syntax -`call ` [[stdlib_io(module):savetxt(interface)]] `(filename, array)` +`call ` [[stdlib_io(module):savetxt(interface)]] `(filename, array [, delimiter])` ### Arguments @@ -113,6 +113,8 @@ Saves a rank-2 `array` into a text file. `array`: Shall be a rank-2 array of type `real`, `complex` or `integer`. +`delimiter` (optional): Shall be a character expression of length 1 that contains the delimiter used to separate the columns. The default is `' '`. + ### Output Provides a text file called `filename` that contains the rank-2 `array`. diff --git a/example/io/example.csv b/example/io/example.csv new file mode 100644 index 000000000..8b1c204ba --- /dev/null +++ b/example/io/example.csv @@ -0,0 +1,3 @@ + 1.00000000E+00, 1.00000000E+00 + 1.00000000E+00, 1.00000000E+00 + 1.00000000E+00, 1.00000000E+00 diff --git a/example/io/example_loadtxt.f90 b/example/io/example_loadtxt.f90 index fa4091c2f..bd20c93f0 100644 --- a/example/io/example_loadtxt.f90 +++ b/example/io/example_loadtxt.f90 @@ -6,4 +6,7 @@ program example_loadtxt ! Can also use list directed format if the default read fails. call loadtxt('example.dat', x, fmt='*') + + call loadtxt('example.csv', x, delimiter=',') + end program example_loadtxt diff --git a/example/io/example_savetxt.f90 b/example/io/example_savetxt.f90 index b1e6b94d9..430bbada0 100644 --- a/example/io/example_savetxt.f90 +++ b/example/io/example_savetxt.f90 @@ -3,4 +3,5 @@ program example_savetxt implicit none real :: x(3, 2) = 1 call savetxt('example.dat', x) + call savetxt('example.csv', x, delimiter=',') end program example_savetxt diff --git a/src/stdlib_io.fypp b/src/stdlib_io.fypp index a51a2d4ce..e7a309740 100644 --- a/src/stdlib_io.fypp +++ b/src/stdlib_io.fypp @@ -103,7 +103,7 @@ module stdlib_io contains #:for k1, t1 in KINDS_TYPES - subroutine loadtxt_${t1[0]}$${k1}$(filename, d, skiprows, max_rows, fmt) + subroutine loadtxt_${t1[0]}$${k1}$(filename, d, skiprows, max_rows, fmt, delimiter) !! version: experimental !! !! Loads a 2D array from a text file. @@ -123,6 +123,7 @@ contains !! The default value is -1. integer, intent(in), optional :: max_rows character(len=*), intent(in), optional :: fmt + character(len=1), intent(in), optional :: delimiter character(len=:), allocatable :: fmt_ !! !! Example @@ -157,9 +158,11 @@ contains ! determine number of columns ncol = 0 - if ( skiprows_ < nrow ) ncol = number_of_columns(s, skiprows=skiprows_) + if ( skiprows_ < nrow ) ncol = number_of_columns(s, skiprows=skiprows_, delimiter=delimiter) #:if 'complex' in t1 - ncol = ncol / 2 + if (present(delimiter)) then + if (is_blank(delimiter)) ncol = ncol / 2 + end if #:endif allocate(d(max_rows_, ncol)) @@ -217,7 +220,7 @@ contains #:for k1, t1 in KINDS_TYPES - subroutine savetxt_${t1[0]}$${k1}$(filename, d) + subroutine savetxt_${t1[0]}$${k1}$(filename, d, delimiter) !! version: experimental !! !! Saves a 2D array into a text file. @@ -227,6 +230,7 @@ contains !! character(len=*), intent(in) :: filename ! File to save the array to ${t1}$, intent(in) :: d(:,:) ! The 2D array to save + character(len=1), intent(in), optional :: delimiter ! Column delimiter. Default is a space. !! !! Example !! ------- @@ -236,17 +240,27 @@ contains !! call savetxt("log.txt", data) !!``` !! - + integer :: s, i, ios + character(len=1) :: delimiter_ + character(len=3) :: delim_str + character(len=:), allocatable :: fmt_ character(len=1024) :: iomsg, msgout + + delimiter_ = optval(delimiter, " ") + delim_str = "'"//delimiter_//"'" + #:if 'real' in t1 + fmt_ = "(*"//FMT_REAL_${k1}$(1:len(FMT_REAL_${k1}$)-1)//",:,"//delim_str//"))" + #:elif 'complex' in t1 + fmt_ = "(*"//FMT_COMPLEX_${k1}$(1:len(FMT_COMPLEX_${k1}$)-1)//",:,"//delim_str//"))" + #:elif 'integer' in t1 + fmt_ = "(*"//FMT_INT(1:len(FMT_INT)-1)//",:,"//delim_str//"))" + #:endif + s = open(filename, "w") do i = 1, size(d, 1) - #:if 'real' in t1 - write(s, "(*"//FMT_REAL_${k1}$(1:len(FMT_REAL_${k1}$)-1)//",:,1x))", & - #:elif 'complex' in t1 - write(s, "(*"//FMT_COMPLEX_${k1}$(1:len(FMT_COMPLEX_${k1}$)-1)//",:,1x))", & - #:elif 'integer' in t1 - write(s, "(*"//FMT_INT(1:len(FMT_INT)-1)//",:,1x))", & + #:if 'real' in t1 or 'complex' in t1 or 'integer' in t1 + write(s, fmt_, & #:else write(s, *, & #:endif @@ -266,19 +280,22 @@ contains #:endfor - integer function number_of_columns(s, skiprows) + integer function number_of_columns(s, skiprows, delimiter) !! version: experimental !! !! determine number of columns integer,intent(in) :: s integer, intent(in), optional :: skiprows + character(len=1), intent(in), optional :: delimiter integer :: ios, skiprows_, i character :: c character(len=:), allocatable :: line - logical :: lastblank + character(len=1) :: delimiter_ + logical :: last_delim skiprows_ = optval(skiprows, 0) + delimiter_ = optval(delimiter, " ") rewind(s) @@ -291,12 +308,23 @@ contains call get_line(s, line, ios) if (ios/=0 .or. .not.allocated(line)) return - lastblank = .true. - do i = 1,len(line) - c = line(i:i) - if (lastblank .and. .not. is_blank(c)) number_of_columns = number_of_columns + 1 - lastblank = is_blank(c) - end do + last_delim = .true. + if (delimiter_ == " ") then + do i = 1,len(line) + c = line(i:i) + if (last_delim .and. .not. is_blank(c)) number_of_columns = number_of_columns + 1 + last_delim = is_blank(c) + end do + else + do i = 1,len(line) + if (line(i:i) == delimiter_) number_of_columns = number_of_columns + 1 + end do + if (number_of_columns == 0) then + if (len_trim(line) /= 0) number_of_columns = 1 + else + number_of_columns = number_of_columns + 1 + end if + end if rewind(s) end function number_of_columns diff --git a/test/io/test_loadtxt.f90 b/test/io/test_loadtxt.f90 index 3234c2533..93646a734 100644 --- a/test/io/test_loadtxt.f90 +++ b/test/io/test_loadtxt.f90 @@ -47,6 +47,10 @@ subroutine test_loadtxt_int32(error) call loadtxt('test_int32.txt', expected, fmt='*') call check(error, all(input == expected),'User specified list directed read faile') if (allocated(error)) return + call savetxt('test_int32.txt', input, delimiter=',') + call loadtxt('test_int32.txt', expected, delimiter=',') + call check(error, all(input == expected),'User specified delimiter read failed') + if (allocated(error)) return end do end subroutine test_loadtxt_int32 @@ -74,6 +78,10 @@ subroutine test_loadtxt_sp(error) call loadtxt('test_sp.txt', expected, fmt="(*"//FMT_REAL_sp(1:len(FMT_REAL_sp)-1)//",1x))") call check(error, all(input == expected),'User specified format failed') if (allocated(error)) return + call savetxt('test_sp.txt', input, delimiter=',') + call loadtxt('test_sp.txt', expected, delimiter=',') + call check(error, all(input == expected),'User specified delimiter read failed') + if (allocated(error)) return end do end subroutine test_loadtxt_sp @@ -158,6 +166,10 @@ subroutine test_loadtxt_dp(error) call loadtxt('test_dp.txt', expected, fmt="(*"//FMT_REAL_dp(1:len(FMT_REAL_dp)-1)//",1x))") call check(error, all(input == expected),'User specified format failed') if (allocated(error)) return + call savetxt('test_dp.txt', input, delimiter=',') + call loadtxt('test_dp.txt', expected, delimiter=',') + call check(error, all(input == expected),'User specified delimiter read failed') + if (allocated(error)) return end do end subroutine test_loadtxt_dp @@ -272,6 +284,10 @@ subroutine test_loadtxt_complex(error) call loadtxt('test_complex.txt', expected, fmt="(*"//FMT_COMPLEX_dp(1:len(FMT_COMPLEX_dp)-1)//",1x))") call check(error, all(input == expected)) if (allocated(error)) return + call savetxt('test_complex.txt', input, delimiter=',') + call loadtxt('test_complex.txt', expected, delimiter=',') + call check(error, all(input == expected)) + if (allocated(error)) return end do end subroutine test_loadtxt_complex From ff3352debb4a1b8081f46e142ff59b6704f60c35 Mon Sep 17 00:00:00 2001 From: ZUO Zhihua Date: Fri, 21 Mar 2025 02:02:05 +0800 Subject: [PATCH 2/6] docs: update headings in stdlib_math and stdlib_sparse documentation --- doc/specs/stdlib_math.md | 2 +- doc/specs/stdlib_sparse.md | 6 +++--- 2 files changed, 4 insertions(+), 4 deletions(-) diff --git a/doc/specs/stdlib_math.md b/doc/specs/stdlib_math.md index cfd632456..5175c020a 100644 --- a/doc/specs/stdlib_math.md +++ b/doc/specs/stdlib_math.md @@ -427,7 +427,7 @@ Experimental Elemenal function. -### Description +#### Description `deg2rad` converts phase angles from degrees to radians. diff --git a/doc/specs/stdlib_sparse.md b/doc/specs/stdlib_sparse.md index fc9d0a0c0..1ba837d32 100644 --- a/doc/specs/stdlib_sparse.md +++ b/doc/specs/stdlib_sparse.md @@ -178,7 +178,7 @@ Type-bound procedures to enable requesting data from a sparse matrix. `v` : Shall be a `real` or `complex` value in accordance to the declared sparse matrix object. If the `ij` tuple is within the sparse pattern, `v` contains the value in the data buffer. If the `ij` tuple is outside the sparse pattern, `v` is equal `0`. If the `ij` tuple is outside the matrix pattern `(nrows,ncols)`, `v` is `NaN`. -## Example +### Example ```fortran {!example/linalg/example_sparse_data_accessors.f90!} ``` @@ -257,7 +257,7 @@ This module provides facility functions for converting between storage formats. `chunk`, `optional`: chunk size, only valid in the case of a `SELLC` matrix, by default it will be taken from the `SELLC` default attribute chunk size. It is an `intent(in)` argument. -## Example +### Example ```fortran {!example/linalg/example_sparse_from_ijv.f90!} ``` @@ -358,7 +358,7 @@ If the `diagonal` array has not been previously allocated, the `diag` subroutine `coo` : Shall be a `COO` type of `real` or `complex` type. It is an `intent(out)` argument. -## Example +### Example ```fortran {!example/linalg/example_sparse_spmv.f90!} ``` \ No newline at end of file From a56317927399b0a7cfe01459d178cac05aa41808 Mon Sep 17 00:00:00 2001 From: ZUO Zhihua Date: Fri, 21 Mar 2025 02:37:23 +0800 Subject: [PATCH 3/6] io: fix the delimiter handling logic in the `loadtxt` function. --- src/stdlib_io.fypp | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/src/stdlib_io.fypp b/src/stdlib_io.fypp index e7a309740..a6a5f619e 100644 --- a/src/stdlib_io.fypp +++ b/src/stdlib_io.fypp @@ -125,6 +125,7 @@ contains character(len=*), intent(in), optional :: fmt character(len=1), intent(in), optional :: delimiter character(len=:), allocatable :: fmt_ + character(len=1) :: delimiter_ !! !! Example !! ------- @@ -148,6 +149,7 @@ contains skiprows_ = max(optval(skiprows, 0), 0) max_rows_ = optval(max_rows, -1) + delimiter_ = optval(delimiter, " ") s = open(filename) @@ -158,11 +160,9 @@ contains ! determine number of columns ncol = 0 - if ( skiprows_ < nrow ) ncol = number_of_columns(s, skiprows=skiprows_, delimiter=delimiter) + if ( skiprows_ < nrow ) ncol = number_of_columns(s, skiprows=skiprows_, delimiter=delimiter_) #:if 'complex' in t1 - if (present(delimiter)) then - if (is_blank(delimiter)) ncol = ncol / 2 - end if + if (is_blank(delimiter_)) ncol = ncol / 2 #:endif allocate(d(max_rows_, ncol)) From 8fb821d7fa82fadb9fc5b809320f22b9a1c99651 Mon Sep 17 00:00:00 2001 From: ZUO Zhihua Date: Fri, 21 Mar 2025 13:31:30 +0800 Subject: [PATCH 4/6] io: use a default delimiter for loadtxt and savetxt functions --- src/stdlib_io.fypp | 12 +++++++----- 1 file changed, 7 insertions(+), 5 deletions(-) diff --git a/src/stdlib_io.fypp b/src/stdlib_io.fypp index a6a5f619e..ce20075e2 100644 --- a/src/stdlib_io.fypp +++ b/src/stdlib_io.fypp @@ -143,13 +143,14 @@ contains !! 11 12 13 !! ... !! + character(len=1), parameter :: delimiter_default = " " integer :: s integer :: nrow, ncol, i, ios, skiprows_, max_rows_ character(len=1024) :: iomsg, msgout skiprows_ = max(optval(skiprows, 0), 0) max_rows_ = optval(max_rows, -1) - delimiter_ = optval(delimiter, " ") + delimiter_ = optval(delimiter, delimiter_default) s = open(filename) @@ -240,14 +241,14 @@ contains !! call savetxt("log.txt", data) !!``` !! - + character(len=1), parameter :: delimiter_default = " " integer :: s, i, ios character(len=1) :: delimiter_ character(len=3) :: delim_str character(len=:), allocatable :: fmt_ character(len=1024) :: iomsg, msgout - delimiter_ = optval(delimiter, " ") + delimiter_ = optval(delimiter, delimiter_default) delim_str = "'"//delimiter_//"'" #:if 'real' in t1 fmt_ = "(*"//FMT_REAL_${k1}$(1:len(FMT_REAL_${k1}$)-1)//",:,"//delim_str//"))" @@ -288,6 +289,7 @@ contains integer, intent(in), optional :: skiprows character(len=1), intent(in), optional :: delimiter + character(len=1), parameter :: delimiter_default = " " integer :: ios, skiprows_, i character :: c character(len=:), allocatable :: line @@ -295,7 +297,7 @@ contains logical :: last_delim skiprows_ = optval(skiprows, 0) - delimiter_ = optval(delimiter, " ") + delimiter_ = optval(delimiter, delimiter_default) rewind(s) @@ -309,7 +311,7 @@ contains if (ios/=0 .or. .not.allocated(line)) return last_delim = .true. - if (delimiter_ == " ") then + if (delimiter_ == delimiter_default) then do i = 1,len(line) c = line(i:i) if (last_delim .and. .not. is_blank(c)) number_of_columns = number_of_columns + 1 From c892a7401e265007528aadafa54b54f0ad2e7861 Mon Sep 17 00:00:00 2001 From: ZUO Zhihua Date: Fri, 21 Mar 2025 22:41:48 +0800 Subject: [PATCH 5/6] io: enhance delimiter handling in loadtxt and savetxt functions --- src/stdlib_io.fypp | 62 +++++++++++++++++++++++++++++----------- test/io/test_loadtxt.f90 | 16 +++++++++-- 2 files changed, 60 insertions(+), 18 deletions(-) diff --git a/src/stdlib_io.fypp b/src/stdlib_io.fypp index ce20075e2..47acd4d3e 100644 --- a/src/stdlib_io.fypp +++ b/src/stdlib_io.fypp @@ -59,13 +59,15 @@ module stdlib_io !> Format string for quadruple precision real numbers FMT_REAL_QP = '(es44.35e4)', & !> Format string for single precision complex numbers - FMT_COMPLEX_SP = '(es15.8e2,1x,es15.8e2)', & + FMT_COMPLEX_SP = '(es15.08e2,1x,es15.08e2)', & !> Format string for double precision complex numbers FMT_COMPLEX_DP = '(es24.16e3,1x,es24.16e3)', & !> Format string for extended double precision complex numbers FMT_COMPLEX_XDP = '(es26.18e3,1x,es26.18e3)', & !> Format string for quadruple precision complex numbers FMT_COMPLEX_QP = '(es44.35e4,1x,es44.35e4)' + !> Default delimiter for loadtxt, savetxt and number_of_columns + character(len=1), parameter :: delimiter_default = " " public :: FMT_INT, FMT_REAL_SP, FMT_REAL_DP, FMT_REAL_XDP, FMT_REAL_QP public :: FMT_COMPLEX_SP, FMT_COMPLEX_DP, FMT_COMPLEX_XDP, FMT_COMPLEX_QP @@ -143,9 +145,9 @@ contains !! 11 12 13 !! ... !! - character(len=1), parameter :: delimiter_default = " " integer :: s - integer :: nrow, ncol, i, ios, skiprows_, max_rows_ + integer :: nrow, ncol, i, j, ios, skiprows_, max_rows_, istart, iend + character(len=:), allocatable :: line, iomsg_ character(len=1024) :: iomsg, msgout skiprows_ = max(optval(skiprows, 0), 0) @@ -163,10 +165,11 @@ contains ncol = 0 if ( skiprows_ < nrow ) ncol = number_of_columns(s, skiprows=skiprows_, delimiter=delimiter_) #:if 'complex' in t1 - if (is_blank(delimiter_)) ncol = ncol / 2 + ncol = ncol / 2 #:endif allocate(d(max_rows_, ncol)) + if (max_rows_ == 0 .or. ncol == 0) return do i = 1, skiprows_ read(s, *, iostat=ios, iomsg=iomsg) @@ -190,15 +193,44 @@ contains if ( fmt_ == '*' ) then ! Use list directed read if user has specified fmt='*' - do i = 1, max_rows_ - read (s,*,iostat=ios,iomsg=iomsg) d(i, :) - - if (ios/=0) then - write(msgout,2) trim(iomsg),size(d,2),i,trim(filename) - call error_stop(msg=trim(msgout)) - end if - - enddo + if (is_blank(delimiter_) .or. delimiter_ == ",") then + do i = 1, max_rows_ + read (s,*,iostat=ios,iomsg=iomsg) d(i, :) + + if (ios/=0) then + write(msgout,2) trim(iomsg),size(d,2),i,trim(filename) + call error_stop(msg=trim(msgout)) + end if + + enddo + ! Otherwise read each value separately + else + do i = 1, max_rows_ + call get_line(s, line, ios, iomsg_) + if (ios/=0) then + write(msgout,2) trim(iomsg_),size(d,2),i,trim(filename) + call error_stop(msg=trim(msgout)) + end if + + istart = 0 + do j = 1, ncol - 1 + iend = index(line(istart+1:), delimiter_) + read (line(istart+1:istart+iend-1),*,iostat=ios,iomsg=iomsg) d(i, j) + if (ios/=0) then + write(msgout,2) trim(iomsg),size(d,2),i,trim(filename) + call error_stop(msg=trim(msgout)) + end if + istart = istart + iend + end do + + read (line(istart+1:),*,iostat=ios,iomsg=iomsg) d(i, ncol) + if (ios/=0) then + write(msgout,2) trim(iomsg),size(d,2),i,trim(filename) + call error_stop(msg=trim(msgout)) + end if + + enddo + end if else ! Otherwise pass default or user specified fmt string. do i = 1, max_rows_ @@ -241,7 +273,6 @@ contains !! call savetxt("log.txt", data) !!``` !! - character(len=1), parameter :: delimiter_default = " " integer :: s, i, ios character(len=1) :: delimiter_ character(len=3) :: delim_str @@ -253,7 +284,7 @@ contains #:if 'real' in t1 fmt_ = "(*"//FMT_REAL_${k1}$(1:len(FMT_REAL_${k1}$)-1)//",:,"//delim_str//"))" #:elif 'complex' in t1 - fmt_ = "(*"//FMT_COMPLEX_${k1}$(1:len(FMT_COMPLEX_${k1}$)-1)//",:,"//delim_str//"))" + fmt_ = "(*"//FMT_COMPLEX_${k1}$(1:11)//delim_str//FMT_COMPLEX_${k1}$(14:23)//",:,"//delim_str//"))" #:elif 'integer' in t1 fmt_ = "(*"//FMT_INT(1:len(FMT_INT)-1)//",:,"//delim_str//"))" #:endif @@ -289,7 +320,6 @@ contains integer, intent(in), optional :: skiprows character(len=1), intent(in), optional :: delimiter - character(len=1), parameter :: delimiter_default = " " integer :: ios, skiprows_, i character :: c character(len=:), allocatable :: line diff --git a/test/io/test_loadtxt.f90 b/test/io/test_loadtxt.f90 index 93646a734..88277fcf3 100644 --- a/test/io/test_loadtxt.f90 +++ b/test/io/test_loadtxt.f90 @@ -49,7 +49,11 @@ subroutine test_loadtxt_int32(error) if (allocated(error)) return call savetxt('test_int32.txt', input, delimiter=',') call loadtxt('test_int32.txt', expected, delimiter=',') - call check(error, all(input == expected),'User specified delimiter read failed') + call check(error, all(input == expected),'User specified delimiter `,` read failed') + if (allocated(error)) return + call savetxt('test_int32.txt', input, delimiter='-') + call loadtxt('test_int32.txt', expected, delimiter='-') + call check(error, all(input == expected),'User specified delimiter `-` read failed') if (allocated(error)) return end do @@ -80,7 +84,11 @@ subroutine test_loadtxt_sp(error) if (allocated(error)) return call savetxt('test_sp.txt', input, delimiter=',') call loadtxt('test_sp.txt', expected, delimiter=',') - call check(error, all(input == expected),'User specified delimiter read failed') + call check(error, all(input == expected),'User specified delimiter `,` read failed') + if (allocated(error)) return + call savetxt('test_sp.txt', input, delimiter=';') + call loadtxt('test_sp.txt', expected, delimiter=';') + call check(error, all(input == expected),'User specified delimiter `;` read failed') if (allocated(error)) return end do @@ -288,6 +296,10 @@ subroutine test_loadtxt_complex(error) call loadtxt('test_complex.txt', expected, delimiter=',') call check(error, all(input == expected)) if (allocated(error)) return + call savetxt('test_complex.txt', input, delimiter=';') + call loadtxt('test_complex.txt', expected, delimiter=';') + call check(error, all(input == expected)) + if (allocated(error)) return end do end subroutine test_loadtxt_complex From eb819332b34d3398f59ccef9d28877fa8eccc003 Mon Sep 17 00:00:00 2001 From: ZUO Zhihua Date: Sat, 22 Mar 2025 03:50:04 +0800 Subject: [PATCH 6/6] io: update access mode handling in open function --- doc/specs/stdlib_io.md | 3 ++- src/stdlib_io.fypp | 4 ++-- 2 files changed, 4 insertions(+), 3 deletions(-) diff --git a/doc/specs/stdlib_io.md b/doc/specs/stdlib_io.md index ef87ffa61..488563362 100644 --- a/doc/specs/stdlib_io.md +++ b/doc/specs/stdlib_io.md @@ -52,7 +52,8 @@ Experimental ### Description -Returns the unit number of a file opened to read, to write, or to read and write. The file might be a text file or a binary file. All files are opened using a streamed access. +Returns the unit number of a file opened to read, to write, or to read and write. The file might be a text file or a binary file. +Text files are opened using a sequential access, while binary files are opened using a streamed access. ### Syntax diff --git a/src/stdlib_io.fypp b/src/stdlib_io.fypp index 47acd4d3e..6ba82ad12 100644 --- a/src/stdlib_io.fypp +++ b/src/stdlib_io.fypp @@ -460,14 +460,14 @@ contains select case (mode_(3:3)) case('t') form_='formatted' + access_='sequential' case('b') form_='unformatted' + access_ = 'stream' case default call error_stop("Unsupported mode: "//mode_(3:3)) end select - access_ = 'stream' - if (present(iostat)) then open(newunit=u, file=filename, & action = action_, position = position_, status = status_, &