Skip to content

Commit 38e8e0e

Browse files
authored
loadtxt/savetxt: do not require space after last entry (#877)
2 parents 2736e06 + ddb8186 commit 38e8e0e

File tree

1 file changed

+54
-48
lines changed

1 file changed

+54
-48
lines changed

src/stdlib_io.fypp

+54-48
Original file line numberDiff line numberDiff line change
@@ -9,7 +9,6 @@ module stdlib_io
99
use, intrinsic :: iso_fortran_env, only : input_unit
1010
use stdlib_kinds, only: sp, dp, xdp, qp, &
1111
int8, int16, int32, int64
12-
use stdlib_error, only: error_stop
1312
use stdlib_optval, only: optval
1413
use stdlib_ascii, only: is_blank
1514
use stdlib_string_type, only : string_type
@@ -120,7 +119,8 @@ contains
120119
!! ...
121120
!!
122121
integer :: s
123-
integer :: nrow, ncol, i, skiprows_, max_rows_
122+
integer :: nrow, ncol, i, ios, skiprows_, max_rows_
123+
character(len=128) :: iomsg, msgout
124124

125125
skiprows_ = max(optval(skiprows, 0), 0)
126126
max_rows_ = optval(max_rows, -1)
@@ -142,56 +142,51 @@ contains
142142
allocate(d(max_rows_, ncol))
143143

144144
do i = 1, skiprows_
145-
read(s, *)
145+
read(s, *, iostat=ios, iomsg=iomsg)
146+
147+
if (ios/=0) then
148+
write(msgout,1) trim(iomsg),i,trim(filename)
149+
error stop trim(msgout)
150+
end if
151+
146152
end do
147-
148-
#:if 'real' in t1
153+
149154
! Default to format used for savetxt if fmt not specified.
150-
fmt_ = optval(fmt, "(*"//FMT_REAL_${k1}$(1:len(FMT_REAL_${k1}$)-1)//",1x))")
151-
152-
if ( fmt_ == '*' ) then
153-
! Use list directed read if user has specified fmt='*'
154-
do i = 1, max_rows_
155-
read (s,*) d(i, :)
156-
enddo
157-
else
158-
! Otherwise pass default or user specified fmt string.
159-
do i = 1, max_rows_
160-
read (s,fmt_) d(i, :)
161-
enddo
162-
endif
155+
#:if 'real' in t1
156+
fmt_ = optval(fmt, "(*"//FMT_REAL_${k1}$(1:len(FMT_REAL_${k1}$)-1)//",:,1x))")
163157
#:elif 'complex' in t1
164-
! Default to format used for savetxt if fmt not specified.
165-
fmt_ = optval(fmt, "(*"//FMT_COMPLEX_${k1}$(1:len(FMT_COMPLEX_${k1}$)-1)//",1x))")
166-
if ( fmt_ == '*' ) then
167-
! Use list directed read if user has specified fmt='*'
168-
do i = 1, max_rows_
169-
read (s,*) d(i, :)
170-
enddo
171-
else
172-
! Otherwise pass default or user specified fmt string.
173-
do i = 1, max_rows_
174-
read (s,fmt_) d(i, :)
175-
enddo
176-
endif
158+
fmt_ = optval(fmt, "(*"//FMT_COMPLEX_${k1}$(1:len(FMT_COMPLEX_${k1}$)-1)//",:,1x))")
177159
#:else
178-
! Default to list directed for integer
179160
fmt_ = optval(fmt, "*")
180-
! Use list directed read if user has specified fmt='*'
161+
#:endif
162+
181163
if ( fmt_ == '*' ) then
164+
! Use list directed read if user has specified fmt='*'
182165
do i = 1, max_rows_
183-
read (s,*) d(i, :)
166+
read (s,*,iostat=ios,iomsg=iomsg) d(i, :)
167+
168+
if (ios/=0) then
169+
write(msgout,1) trim(iomsg),i,trim(filename)
170+
error stop trim(msgout)
171+
end if
172+
184173
enddo
185174
else
186-
! Otherwise pass default user specified fmt string.
175+
! Otherwise pass default or user specified fmt string.
187176
do i = 1, max_rows_
188-
read (s,fmt_) d(i, :)
177+
read (s,fmt_,iostat=ios,iomsg=iomsg) d(i, :)
178+
179+
if (ios/=0) then
180+
write(msgout,1) trim(iomsg),i,trim(filename)
181+
error stop trim(msgout)
182+
end if
183+
189184
enddo
190185
endif
191186

192-
#:endif
193-
194187
close(s)
188+
189+
1 format('loadtxt: error <',a,'> reading line ',i0,' of ',a,'.')
195190

196191
end subroutine loadtxt_${t1[0]}$${k1}$
197192
#:endfor
@@ -218,20 +213,31 @@ contains
218213
!!```
219214
!!
220215

221-
integer :: s, i
216+
integer :: s, i, ios
217+
character(len=128) :: iomsg, msgout
222218
s = open(filename, "w")
223219
do i = 1, size(d, 1)
224220
#:if 'real' in t1
225-
write(s, "(*"//FMT_REAL_${k1}$(1:len(FMT_REAL_${k1}$)-1)//",1x))") d(i, :)
221+
write(s, "(*"//FMT_REAL_${k1}$(1:len(FMT_REAL_${k1}$)-1)//",:,1x))", &
226222
#:elif 'complex' in t1
227-
write(s, "(*"//FMT_COMPLEX_${k1}$(1:len(FMT_COMPLEX_${k1}$)-1)//",1x))") d(i, :)
223+
write(s, "(*"//FMT_COMPLEX_${k1}$(1:len(FMT_COMPLEX_${k1}$)-1)//",:,1x))", &
228224
#:elif 'integer' in t1
229-
write(s, "(*"//FMT_INT(1:len(FMT_INT)-1)//",1x))") d(i, :)
225+
write(s, "(*"//FMT_INT(1:len(FMT_INT)-1)//",:,1x))", &
230226
#:else
231-
write(s, *) d(i, :)
227+
write(s, *, &
232228
#:endif
229+
iostat=ios,iomsg=iomsg) d(i, :)
230+
231+
if (ios/=0) then
232+
write(msgout,1) trim(iomsg),i,trim(filename)
233+
error stop trim(msgout)
234+
end if
235+
233236
end do
234237
close(s)
238+
239+
1 format('savetxt: error <',a,'> writing line ',i0,' of ',a,'.')
240+
235241
end subroutine savetxt_${t1[0]}$${k1}$
236242
#:endfor
237243

@@ -360,7 +366,7 @@ contains
360366
position_='asis'
361367
status_='new'
362368
case default
363-
call error_stop("Unsupported mode: "//mode_(1:2))
369+
error stop "Unsupported mode: "//mode_(1:2)
364370
end select
365371

366372
select case (mode_(3:3))
@@ -369,7 +375,7 @@ contains
369375
case('b')
370376
form_='unformatted'
371377
case default
372-
call error_stop("Unsupported mode: "//mode_(3:3))
378+
error stop "Unsupported mode: "//mode_(3:3)
373379
end select
374380

375381
access_ = 'stream'
@@ -415,9 +421,9 @@ contains
415421
else if (a(i:i) == ' ') then
416422
cycle
417423
else if(any(.not.lfirst)) then
418-
call error_stop("Wrong mode: "//trim(a))
424+
error stop "Wrong mode: "//trim(a)
419425
else
420-
call error_stop("Wrong character: "//a(i:i))
426+
error stop "Wrong character: "//a(i:i)
421427
endif
422428
end do
423429

@@ -466,7 +472,7 @@ contains
466472
if (present(iostat)) then
467473
iostat = stat
468474
else if (stat /= 0) then
469-
call error_stop(trim(msg))
475+
error stop trim(msg)
470476
end if
471477
end subroutine getline_char
472478

0 commit comments

Comments
 (0)