diff --git a/.gitignore b/.gitignore index 246122db7..f7f2ef4a2 100644 --- a/.gitignore +++ b/.gitignore @@ -51,3 +51,4 @@ API-doc/ scratch.txt *.dat *.stream +.venv/ diff --git a/doc/specs/stdlib_io.md b/doc/specs/stdlib_io.md index 46befe2ea..d4971eaa8 100644 --- a/doc/specs/stdlib_io.md +++ b/doc/specs/stdlib_io.md @@ -247,6 +247,41 @@ Read a whole line from a formatted unit into a string variable {!example/io/example_get_line.f90!} ``` +## `input` — convenience prompt + read from standard input + +### Status + +Experimental / convenience + +### Description + +`input(prompt)` displays `prompt` (if provided) on the same line and returns the full user input as a string. Trailing spaces and tabs are preserved. Optionally the call can provide an `iostat`-like integer to capture the status. + +### Syntax + +`s = input(prompt [, iostat])` + +### Arguments + +`prompt`: Optional character input for the prompt message. + This argument is `intent(in)`. + +`iostat`: Optional integer output for the status. + This argument is `intent(out)`. + +### Return value + +Deferred-length character string containing the input. + +### Example + +```fortran +use stdlib_io, only: input +character(len=:), allocatable :: name +integer :: iostat +name = input('Enter your name: ', iostat) +``` + ## Formatting constants ### Status diff --git a/example/io/CMakeLists.txt b/example/io/CMakeLists.txt index db663f537..c15b5355b 100644 --- a/example/io/CMakeLists.txt +++ b/example/io/CMakeLists.txt @@ -6,3 +6,6 @@ ADD_EXAMPLE(loadtxt) ADD_EXAMPLE(open) ADD_EXAMPLE(savenpy) ADD_EXAMPLE(savetxt) +# ADD_EXAMPLE(input) -- Interactive example, do not run as test +add_executable(example_input example_input.f90) +target_link_libraries(example_input "${PROJECT_NAME}") diff --git a/example/io/example_input.f90 b/example/io/example_input.f90 new file mode 100644 index 000000000..c4452fe03 --- /dev/null +++ b/example/io/example_input.f90 @@ -0,0 +1,21 @@ +program example_input + use stdlib_io, only: input + implicit none + character(len=:), allocatable :: name + integer :: stat + + print *, "Example of input() usage:" + + ! Simple usage + name = input("Enter your name: ") + print *, "Hello, ", name, "!" + + ! Usage with status check + name = input("Enter something else (or Ctrl+D to fail): ", stat) + if (stat == 0) then + print *, "You entered: ", name + else + print *, "Input failed or EOF encountered (stat=", stat, ")" + end if + +end program example_input diff --git a/src/stdlib_io.fypp b/src/stdlib_io.fypp index 6ba82ad12..ca1ae7386 100644 --- a/src/stdlib_io.fypp +++ b/src/stdlib_io.fypp @@ -16,25 +16,25 @@ module stdlib_io implicit none private ! Public API - public :: loadtxt, savetxt, open, get_line, get_file + public :: loadtxt, savetxt, open, get_line, get_file, input - !! version: experimental + !! version: experimental !! - !! Reads a whole ASCII file and loads its contents into a string variable. + !! Reads a whole ASCII file and loads its contents into a string variable. !! ([Specification](../page/specs/stdlib_io.html#get-file-read-a-whole-ascii-file-into-a-character-or-a-string-variable)) - !! - !!### Summary + !! + !!### Summary !! Subroutine interface for reading the content of a file into a string. !! !!### Description - !! - !! This subroutine reads the entirety of a specified ASCII file and returns it as a string. The optional - !! `err` argument allows for handling errors through the library's `state_type` class. - !! An optional `logical` flag can be passed to delete the file after reading. - !! - !!@note Handles errors using the library's `state_type` error-handling class. If not provided, - !! exceptions will trigger an `error stop`. - !! + !! + !! This subroutine reads the entirety of a specified ASCII file and returns it as a string. The optional + !! `err` argument allows for handling errors through the library's `state_type` class. + !! An optional `logical` flag can be passed to delete the file after reading. + !! + !!@note Handles errors using the library's `state_type` error-handling class. If not provided, + !! exceptions will trigger an `error stop`. + !! interface get_file module procedure :: get_file_char module procedure :: get_file_string @@ -82,6 +82,12 @@ module stdlib_io module procedure :: get_line_input_string end interface get_line + !> Minimal Python-like input(prompt) convenience + !> Reads a whole line from standard input (preserving trailing whitespace) + interface input + module procedure :: input_character + end interface input + interface loadtxt !! version: experimental !! @@ -173,15 +179,15 @@ contains do i = 1, skiprows_ read(s, *, iostat=ios, iomsg=iomsg) - - if (ios/=0) then - write(msgout,1) trim(iomsg),i,trim(filename) + + if (ios/=0) then + write(msgout,1) trim(iomsg),i,trim(filename) 1 format('loadtxt: error <',a,'> skipping line ',i0,' of ',a,'.') call error_stop(msg=trim(msgout)) end if - + end do - + ! Default to format used for savetxt if fmt not specified. #:if 'real' in t1 fmt_ = optval(fmt, "(*"//FMT_REAL_${k1}$(1:len(FMT_REAL_${k1}$)-1)//",:,1x))") @@ -189,63 +195,63 @@ contains fmt_ = optval(fmt, "(*"//FMT_COMPLEX_${k1}$(1:len(FMT_COMPLEX_${k1}$)-1)//",:,1x))") #:else fmt_ = optval(fmt, "*") - #:endif + #:endif if ( fmt_ == '*' ) then ! Use list directed read if user has specified fmt='*' if (is_blank(delimiter_) .or. delimiter_ == ",") then do i = 1, max_rows_ read (s,*,iostat=ios,iomsg=iomsg) d(i, :) - - if (ios/=0) then + + if (ios/=0) then write(msgout,2) trim(iomsg),size(d,2),i,trim(filename) call error_stop(msg=trim(msgout)) - end if - + 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 + 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 + 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 + if (ios/=0) then write(msgout,2) trim(iomsg),size(d,2),i,trim(filename) call error_stop(msg=trim(msgout)) - end if - + end if + enddo end if else ! Otherwise pass default or user specified fmt string. do i = 1, max_rows_ read (s,fmt_,iostat=ios,iomsg=iomsg) d(i, :) - - if (ios/=0) then + + if (ios/=0) then write(msgout,2) trim(iomsg),size(d,2),i,trim(filename) call error_stop(msg=trim(msgout)) - end if - + end if + enddo endif close(s) - + 2 format('loadtxt: error <',a,'> reading ',i0,' values from line ',i0,' of ',a,'.') end subroutine loadtxt_${t1[0]}$${k1}$ @@ -297,17 +303,17 @@ contains write(s, *, & #:endif iostat=ios,iomsg=iomsg) d(i, :) - - if (ios/=0) then - write(msgout,1) trim(iomsg),size(d,2),i,trim(filename) + + if (ios/=0) then + write(msgout,1) trim(iomsg),size(d,2),i,trim(filename) call error_stop(msg=trim(msgout)) - end if - + end if + end do close(s) - + 1 format('savetxt: error <',a,'> writing ',i0,' values to line ',i0,' of ',a,'.') - + end subroutine savetxt_${t1[0]}$${k1}$ #:endfor @@ -335,7 +341,7 @@ contains read(s, *) end do number_of_columns = 0 - + ! Read first non-skipped line as a whole call get_line(s, line, ios) if (ios/=0 .or. .not.allocated(line)) return @@ -612,10 +618,48 @@ contains end subroutine get_line_input_string !> Version: experimental - !> + !> Minimal Python-like input function. + !> Usage: + !> s = input("Enter name: ") + !> s = input("Prompt: ", iostat) ! if you want status (optional) + impure function input_character(prompt, iostat) result(str) + !> Optional prompt displayed before reading. If present, printed on same line. + character(len=*), intent(in), optional :: prompt + !> Optional iostat-like status output (0 success, non-zero indicates error/EOF) + integer, intent(out), optional :: iostat + !> Result: deferred-length character string preserving trailing spaces/tabs + character(len=:), allocatable :: str + + integer :: iostat_local + character(len=:), allocatable :: iomsg_local + + ! Print prompt on same line if provided + if (present(prompt)) then + write(*,'(a)', advance='no') prompt + end if + + ! Reuse existing get_line_input_char which already reads preserving trailing spaces + call get_line_input_char(str, iostat_local, iomsg_local) + + ! Propagate iostat if requested, otherwise follow stdlib_io error semantics + if (present(iostat)) then + iostat = iostat_local + else if (iostat_local /= 0) then + if (allocated(iomsg_local)) then + call error_stop(trim(iomsg_local)) + else + call error_stop("input: I/O error reading from standard input") + end if + end if + + end function input_character + + + !> Version: experimental + !> !> Reads a whole ASCII file and loads its contents into a string variable. !> The function handles error states and optionally deletes the file after reading. - subroutine get_file_string(filename,file,err,delete) + subroutine get_file_string(filename,file,err,delete) !> Input file name character(*), intent(in) :: filename !> Output string variable @@ -624,21 +668,21 @@ contains type(state_type), optional, intent(out) :: err !> [optional] Delete file after reading? Default: do not delete logical, optional, intent(in) :: delete - + ! Local variables character(len=:), allocatable :: filestring - + ! Process output call get_file_char(filename,filestring,err,delete) - call move(from=fileString,to=file) + call move(from=filestring,to=file) end subroutine get_file_string !> Version: experimental - !> + !> !> Reads a whole ASCII file and loads its contents into an allocatable `character` variable. !> The function handles error states and optionally deletes the file after reading. - subroutine get_file_char(filename,file,err,delete) + subroutine get_file_char(filename,file,err,delete) !> Input file name character(*), intent(in) :: filename !> Output string variable @@ -647,7 +691,7 @@ contains type(state_type), optional, intent(out) :: err !> [optional] Delete file after reading? Default: do not delete logical, optional, intent(in) :: delete - + ! Local variables type(state_type) :: err0 character(len=512) :: iomsg @@ -656,10 +700,10 @@ contains logical :: is_present,want_deleted !> Check if the file should be deleted after reading - if (present(delete)) then + if (present(delete)) then want_deleted = delete else - want_deleted = .false. + want_deleted = .false. end if !> Check file existing @@ -670,57 +714,57 @@ contains call err0%handle(err) return end if - + !> Retrieve file size inquire(file=filename,size=file_size) - - invalid_size: if (file_size<0) then + + invalid_size: if (file_size<0) then allocate(character(len=0) :: file) err0 = state_type('get_file',STDLIB_IO_ERROR,filename,'has invalid size=',file_size) call err0%handle(err) - return - - endif invalid_size - + return + + endif invalid_size + ! Read file open(newunit=lun,file=filename, & form='unformatted',action='read',access='stream',status='old', & iostat=iostat,iomsg=iomsg) - - if (iostat/=0) then + + if (iostat/=0) then allocate(character(len=0) :: file) err0 = state_type('get_file',STDLIB_IO_ERROR,'Cannot open',filename,'for read:',iomsg) call err0%handle(err) return - end if - + end if + allocate(character(len=file_size) :: file) - - read_data: if (file_size>0) then - + + read_data: if (file_size>0) then + read(lun, pos=1, iostat=iostat, iomsg=iomsg) file - + ! Read error - if (iostat/=0) then - - inquire(unit=lun,pos=errpos) + if (iostat/=0) then + + inquire(unit=lun,pos=errpos) err0 = state_type('get_file',STDLIB_IO_ERROR,iomsg,'(',filename,'at byte',errpos,')') call err0%handle(err) return endif - + end if read_data - - if (want_deleted) then + + if (want_deleted) then close(lun,iostat=iostat,status='delete') if (iostat/=0) err0 = state_type('get_file',STDLIB_IO_ERROR,'Cannot delete',filename,'after reading') else close(lun,iostat=iostat) if (iostat/=0) err0 = state_type('get_file',STDLIB_IO_ERROR,'Cannot close',filename,'after reading') - endif - + endif + ! Process output call err0%handle(err) diff --git a/test/io/CMakeLists.txt b/test/io/CMakeLists.txt index 4e19b5fbe..2be82ecca 100644 --- a/test/io/CMakeLists.txt +++ b/test/io/CMakeLists.txt @@ -17,3 +17,4 @@ ADDTEST(get_line) ADDTEST(npy) ADDTEST(open) ADDTEST(parse_mode) +ADDTEST(input) diff --git a/test/io/test_input.f90 b/test/io/test_input.f90 new file mode 100644 index 000000000..70cc0ee16 --- /dev/null +++ b/test/io/test_input.f90 @@ -0,0 +1,159 @@ +module test_input + use, intrinsic :: iso_fortran_env, only : input_unit, output_unit + use stdlib_io, only : input, get_line + use testdrive, only : new_unittest, unittest_type, error_type, check + implicit none + private + + public :: collect_input + +contains + + !> Collect all exported unit tests + subroutine collect_input(testsuite) + !> Collection of tests + type(unittest_type), allocatable, intent(out) :: testsuite(:) + + testsuite = [ & + new_unittest("check-input-compilation", test_input_compilation), & + new_unittest("check-input-functional", test_input_functional), & + new_unittest("check-input-prompt-capture", test_input_prompt_capture), & + new_unittest("check-input-error-handling", test_input_error_handling) & + ] + end subroutine collect_input + + subroutine test_input_compilation(error) + !> Error handling + type(error_type), allocatable, intent(out) :: error + + ! Simple check that we can reference the user stub and the interface exists. + ! We avoid actually calling input() here to prevent blocking in CI. + call check(error, .true.) + end subroutine test_input_compilation + + !> Functional test: read from a pre-populated file and verify trailing whitespace preserved. + subroutine test_input_functional(error) + type(error_type), allocatable, intent(out) :: error + integer :: unit + character(len=:), allocatable :: s + integer :: iostat + + ! Create a small temporary file that contains a line with trailing whitespace. + open(newunit=unit, file="test_input_temp1.txt", status="replace", action="write", iostat=iostat) + call check(error, iostat == 0, "failed to create temp file for input functional test") + write(unit, '(a)') 'hello ' ! two trailing spaces + close(unit) + + ! Open temp file on an auxiliary unit and call get_line to simulate input() internal behavior. + open(newunit=unit, file="test_input_temp1.txt", status="old", action="read", iostat=iostat) + call check(error, iostat == 0, "failed to open temp file for reading") + + call get_line(unit, s, iostat) + call check(error, iostat == 0, "iostat should be 0 for normal read") + ! trailing spaces preserved: len > len_trim + call check(error, len(s) == 7, "length should be 7 (hello + 2 spaces)") + call check(error, s == 'hello ', "content should match including trailing spaces") + + ! cleanup + close(unit, status="delete") + end subroutine test_input_functional + + !> Capture prompt output by redirecting output_unit to a file and redirecting input_unit to + !! a prepared file. Then call input(...) which prints the prompt to output_unit and reads + !! from input_unit. Confirm the prompt was written (without newline) and the returned string. + subroutine test_input_prompt_capture(error) + type(error_type), allocatable, intent(out) :: error + integer :: in_unit, iostat + character(len=:), allocatable :: s, prompt_content + integer :: tmp_unit, ios + + ! Prepare a temp file that will act as stdin for input() + open(newunit=in_unit, file="test_input_temp2.txt", status="replace", action="write", iostat=iostat) + call check(error, iostat == 0, "failed to create temp input file") + write(in_unit, '(a)') 'world' ! no trailing spaces + close(in_unit) + + ! Re-open the file on the special standard input unit number + open(unit=input_unit, file="test_input_temp2.txt", status="old", action="read", iostat=iostat) + call check(error, iostat == 0, "failed to open test_input_temp2.txt on input_unit") + + ! Redirect standard output by opening the special output_unit to a capture file. + open(unit=output_unit, file="prompt_capture.txt", status="replace", action="write", iostat=iostat) + call check(error, iostat == 0, "failed to redirect output_unit to prompt_capture.txt") + + ! Call input which should: + ! - write the prompt to output_unit (no newline) + ! - read the line from input_unit + s = input("PROMPT: ", iostat) + call check(error, iostat == 0, "input() iostat must be 0 when reading from prepared file") + call check(error, trim(s) == 'world', "input must read 'world' from prepared stdin file") + + ! Close redirected units to flush output and restore state + close(unit=output_unit, iostat=ios) + call check(error, ios == 0, "failed to close redirected output_unit") + close(unit=input_unit, iostat=ios) + call check(error, ios == 0, "failed to close redirected input_unit") + + ! Read the prompt capture file and verify prompt was printed. + open(newunit=tmp_unit, file="prompt_capture.txt", status="old", action="read", iostat=iostat) + call check(error, iostat == 0, "failed to open prompt_capture.txt for verification") + call get_line(tmp_unit, prompt_content, iostat) + call check(error, iostat == 0, "failed to read prompt_capture.txt") + close(tmp_unit, status="delete") + + ! The prompt should be present. Because input printed prompt with advance='no', the file + ! should contain the prompt text (no trailing newline before prompt). Check prefix. + call check(error, index(prompt_content, "PROMPT:") == 1, "prompt must appear at start of captured output") + end subroutine test_input_prompt_capture + + !> Error handling test: ensure input returns non-zero iostat when input_unit is not connected. + subroutine test_input_error_handling(error) + type(error_type), allocatable, intent(out) :: error + integer :: ios + character(len=:), allocatable :: s + integer :: iostat + + ! Ensure input_unit is not connected by trying to close it (ignore errors) + close(unit=input_unit, iostat=ios) + + ! Now call input(...) with iostat and expect non-zero (error/EOF) + s = input("ShouldFail: ", iostat) + call check(error, iostat /= 0, "input iostat should be non-zero if input_unit is not connected") + + ! If the unit was mistakenly connected, try to forcibly open then close to simulate disconnected state. + ! (No-op if already disconnected) + if (iostat == 0) then + ! attempt to close properly to simulate failure on subsequent tries + close(unit=input_unit, iostat=ios) + s = input("ShouldFail2: ", iostat) + call check(error, iostat /= 0, "input iostat should be non-zero after closing input_unit") + end if + end subroutine test_input_error_handling + +end module test_input + +program tester + use, intrinsic :: iso_fortran_env, only : error_unit + use testdrive, only : run_testsuite, new_testsuite, testsuite_type + use test_input, only : collect_input + implicit none + integer :: stat, is + type(testsuite_type), allocatable :: testsuites(:) + character(len=*), parameter :: fmt = '("#", *(1x, a))' + + stat = 0 + + testsuites = [ & + new_testsuite("input", collect_input) & + ] + + do is = 1, size(testsuites) + write(error_unit, fmt) "Testing:", testsuites(is)%name + call run_testsuite(testsuites(is)%collect, error_unit, stat) + end do + + if (stat > 0) then + write(error_unit, '(i0, 1x, a)') stat, "test(s) failed!" + error stop + end if +end program