diff --git a/doc/specs/stdlib_io.md b/doc/specs/stdlib_io.md index 8c868802a..0ae2b11b3 100644 --- a/doc/specs/stdlib_io.md +++ b/doc/specs/stdlib_io.md @@ -205,7 +205,7 @@ Provides a npy file called `filename` that contains the rank-2 `array`. {!example/io/example_savenpy.f90!} ``` -## `getline` +## `get_line` ### Status @@ -217,9 +217,9 @@ Read a whole line from a formatted unit into a string variable ### Syntax -`call ` [[stdlib_io(module):getline(interface)]] ` (unit, line[, iostat][, iomsg])` +`call ` [[stdlib_io(module):get_line(interface)]] ` (unit, line[, iostat][, iomsg])` -`call ` [[stdlib_io(module):getline(interface)]] ` (line[, iostat][, iomsg])` +`call ` [[stdlib_io(module):get_line(interface)]] ` (line[, iostat][, iomsg])` ### Arguments @@ -241,7 +241,7 @@ Read a whole line from a formatted unit into a string variable ### Example ```fortran -{!example/io/example_getline.f90!} +{!example/io/example_get_line.f90!} ``` ## Formatting constants @@ -260,3 +260,44 @@ Provides formats for all kinds as defined in the `stdlib_kinds` module. ```fortran {!example/io/example_fmt_constants.f90!} ``` + +## `get_file` - Read a whole ASCII file into a `character` or a `string` variable + +### Status + +Experimental + +### Description + +This subroutine interface reads the entirety of a specified ASCII file and returns its content as a string or an allocatable `character` variable. +The function provides an optional error-handling mechanism via the `state_type` class. If the `err` argument is not provided, exceptions will trigger an `error stop`. The function also supports an optional flag to delete the file after reading. + +### Syntax + +`call [[stdlib_io(module):get_file(subroutine)]] (filename, file [, err] [, delete=.false.])` + +### Class +Function + +### Arguments + +`filename`: Shall be a character input containing the path to the ASCII file to read. It is an `intent(in)` argument. + +`file`: Shall be a `type(string_type)` or an allocatable `character` variable containing the full content of the specified file. It is an `intent(out)` argument. + +`err` (optional): Shall be a `type(state_type)` variable. It is an `intent(out)` argument used for error handling. + +`delete` (optional): Shall be a `logical` flag. If `.true.`, the file is deleted after reading. Default is `.false.`. It is an `intent(in)` argument. + +### Return values + +Output variable `file` will contain the full content of the specified file. + +Raises `STDLIB_IO_ERROR` if the file is not found, cannot be opened, read, or deleted. +Exceptions trigger an `error stop` unless the optional `err` argument is provided. + +### Example + +```fortran +{!example/io/example_get_file.f90!} +``` diff --git a/example/io/CMakeLists.txt b/example/io/CMakeLists.txt index 2e606d2d1..db663f537 100644 --- a/example/io/CMakeLists.txt +++ b/example/io/CMakeLists.txt @@ -1,5 +1,6 @@ ADD_EXAMPLE(fmt_constants) -#ADD_EXAMPLE(getline) +#ADD_EXAMPLE(get_line) +ADD_EXAMPLE(get_file) ADD_EXAMPLE(loadnpy) ADD_EXAMPLE(loadtxt) ADD_EXAMPLE(open) diff --git a/example/io/example_get_file.f90 b/example/io/example_get_file.f90 new file mode 100644 index 000000000..bb0a2743a --- /dev/null +++ b/example/io/example_get_file.f90 @@ -0,0 +1,20 @@ +! Demonstrate usage of `get_file` +program example_get_file + use stdlib_io, only: get_file + use stdlib_string_type, only: string_type + use stdlib_error, only: state_type + implicit none + + character(*), parameter :: filename = "example.txt" + type(string_type) :: filecontent + type(state_type) :: err + + ! Read a file into a string + call get_file(filename, filecontent, err=err) + + if (err%error()) then + print *, err%print() + else + print *, "Success! File "//filename//" imported." + end if +end program example_get_file diff --git a/example/io/example_getline.f90 b/example/io/example_get_line.f90 similarity index 69% rename from example/io/example_getline.f90 rename to example/io/example_get_line.f90 index f61265099..a641f933c 100644 --- a/example/io/example_getline.f90 +++ b/example/io/example_get_line.f90 @@ -1,13 +1,13 @@ program example_getline use, intrinsic :: iso_fortran_env, only: input_unit, output_unit - use stdlib_io, only: getline + use stdlib_io, only: get_line implicit none character(len=:), allocatable :: line integer :: stat - call getline(input_unit, line, stat) + call get_line(input_unit, line, stat) do while (stat == 0) write (output_unit, '(a)') line - call getline(input_unit, line, stat) + call get_line(input_unit, line, stat) end do end program example_getline diff --git a/src/stdlib_io.fypp b/src/stdlib_io.fypp index 01b50a881..8e45d8c80 100644 --- a/src/stdlib_io.fypp +++ b/src/stdlib_io.fypp @@ -9,14 +9,36 @@ module stdlib_io use, intrinsic :: iso_fortran_env, only : input_unit use stdlib_kinds, only: sp, dp, xdp, qp, & int8, int16, int32, int64 - use stdlib_error, only: error_stop + use stdlib_error, only: error_stop, state_type, STDLIB_IO_ERROR use stdlib_optval, only: optval use stdlib_ascii, only: is_blank - use stdlib_string_type, only : string_type + use stdlib_string_type, only : string_type, assignment(=), move implicit none private ! Public API - public :: loadtxt, savetxt, open, getline + public :: loadtxt, savetxt, open, get_line, get_file + + !! version: experimental + !! + !! 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 + !! 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`. + !! + interface get_file + module procedure :: get_file_char + module procedure :: get_file_string + end interface get_file ! Private API that is exposed so that we can test it in tests public :: parse_mode @@ -51,12 +73,12 @@ module stdlib_io !> Version: experimental !> !> Read a whole line from a formatted unit into a string variable - interface getline - module procedure :: getline_char - module procedure :: getline_string - module procedure :: getline_input_char - module procedure :: getline_input_string - end interface getline + interface get_line + module procedure :: get_line_char + module procedure :: get_line_string + module procedure :: get_line_input_char + module procedure :: get_line_input_string + end interface get_line interface loadtxt !! version: experimental @@ -265,7 +287,7 @@ contains number_of_columns = 0 ! Read first non-skipped line as a whole - call getline(s, line, ios) + call get_line(s, line, ios) if (ios/=0 .or. .not.allocated(line)) return lastblank = .true. @@ -437,7 +459,7 @@ contains !> Version: experimental !> !> Read a whole line from a formatted unit into a deferred length character variable - subroutine getline_char(unit, line, iostat, iomsg) + subroutine get_line_char(unit, line, iostat, iomsg) !> Formatted IO unit integer, intent(in) :: unit !> Line to read @@ -479,12 +501,12 @@ contains else if (stat /= 0) then call error_stop(trim(msg)) end if - end subroutine getline_char + end subroutine get_line_char !> Version: experimental !> !> Read a whole line from a formatted unit into a string variable - subroutine getline_string(unit, line, iostat, iomsg) + subroutine get_line_string(unit, line, iostat, iomsg) !> Formatted IO unit integer, intent(in) :: unit !> Line to read @@ -496,14 +518,14 @@ contains character(len=:), allocatable :: buffer - call getline(unit, buffer, iostat, iomsg) + call get_line(unit, buffer, iostat, iomsg) line = string_type(buffer) - end subroutine getline_string + end subroutine get_line_string !> Version: experimental !> !> Read a whole line from the standard input into a deferred length character variable - subroutine getline_input_char(line, iostat, iomsg) + subroutine get_line_input_char(line, iostat, iomsg) !> Line to read character(len=:), allocatable, intent(out) :: line !> Status of operation @@ -511,13 +533,13 @@ contains !> Error message character(len=:), allocatable, optional :: iomsg - call getline(input_unit, line, iostat, iomsg) - end subroutine getline_input_char + call get_line(input_unit, line, iostat, iomsg) + end subroutine get_line_input_char !> Version: experimental !> !> Read a whole line from the standard input into a string variable - subroutine getline_input_string(line, iostat, iomsg) + subroutine get_line_input_string(line, iostat, iomsg) !> Line to read type(string_type), intent(out) :: line !> Status of operation @@ -525,7 +547,122 @@ contains !> Error message character(len=:), allocatable, optional :: iomsg - call getline(input_unit, line, iostat, iomsg) - end subroutine getline_input_string + call get_line(input_unit, line, iostat, iomsg) + end subroutine get_line_input_string + + !> 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) + !> Input file name + character(*), intent(in) :: filename + !> Output string variable + type(string_type), intent(out) :: file + !> [optional] State return flag. On error, if not requested, the code will stop. + 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) + + 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) + !> Input file name + character(*), intent(in) :: filename + !> Output string variable + character(len=:), allocatable, intent(out) :: file + !> [optional] State return flag. On error, if not requested, the code will stop. + 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 + integer :: lun,iostat + integer(int64) :: errpos,file_size + logical :: is_present,want_deleted + + !> Check if the file should be deleted after reading + if (present(delete)) then + want_deleted = delete + else + want_deleted = .false. + end if + + !> Check file existing + inquire(file=filename, exist=is_present) + if (.not.is_present) then + allocate(character(len=0) :: file) + err0 = state_type('get_file',STDLIB_IO_ERROR,'File not present:',filename) + call err0%handle(err) + return + end if + + !> Retrieve file size + inquire(file=filename,size=file_size) + + 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 + + ! Read file + open(newunit=lun,file=filename, & + form='unformatted',action='read',access='stream',status='old', & + iostat=iostat,iomsg=iomsg) + + 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 + + allocate(character(len=file_size) :: file) + + 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) + 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 + 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 + + ! Process output + call err0%handle(err) + + end subroutine get_file_char end module stdlib_io diff --git a/test/io/CMakeLists.txt b/test/io/CMakeLists.txt index 98794cd88..4e19b5fbe 100644 --- a/test/io/CMakeLists.txt +++ b/test/io/CMakeLists.txt @@ -13,7 +13,7 @@ ADDTEST(savetxt_qp) set_tests_properties(loadtxt_qp PROPERTIES LABELS quadruple_precision) set_tests_properties(savetxt_qp PROPERTIES LABELS quadruple_precision) -ADDTEST(getline) +ADDTEST(get_line) ADDTEST(npy) ADDTEST(open) ADDTEST(parse_mode) diff --git a/test/io/test_getline.f90 b/test/io/test_get_line.f90 similarity index 57% rename from test/io/test_getline.f90 rename to test/io/test_get_line.f90 index e035a904f..d83bab06d 100644 --- a/test/io/test_getline.f90 +++ b/test/io/test_get_line.f90 @@ -1,16 +1,17 @@ -module test_getline - use stdlib_io, only : getline - use stdlib_string_type, only : string_type, len +module test_get_line + use stdlib_io, only : get_line, get_file + use stdlib_error, only: state_type + use stdlib_string_type, only : string_type, len, len_trim use testdrive, only : new_unittest, unittest_type, error_type, check implicit none private - public :: collect_getline + public :: collect_get_line contains !> Collect all exported unit tests - subroutine collect_getline(testsuite) + subroutine collect_get_line(testsuite) !> Collection of tests type(unittest_type), allocatable, intent(out) :: testsuite(:) @@ -20,9 +21,12 @@ subroutine collect_getline(testsuite) new_unittest("pad-no", test_pad_no), & new_unittest("iostat-end", test_iostat_end), & new_unittest("closed-unit", test_closed_unit, should_fail=.true.), & - new_unittest("no-unit", test_no_unit, should_fail=.true.) & + new_unittest("no-unit", test_no_unit, should_fail=.true.), & + new_unittest("get_file-no", test_get_file_missing), & + new_unittest("get_file-empty", test_get_file_empty), & + new_unittest("get_file-non-empty", test_get_file_non_empty) & ] - end subroutine collect_getline + end subroutine collect_get_line subroutine test_read_char(error) !> Error handling @@ -36,7 +40,7 @@ subroutine test_read_char(error) rewind(io) do i = 1, 3 - call getline(io, line, stat) + call get_line(io, line, stat) call check(error, stat) if (allocated(error)) exit call check(error, len(line), 3*10**i) @@ -57,7 +61,7 @@ subroutine test_read_string(error) rewind(io) do i = 1, 3 - call getline(io, line, stat) + call get_line(io, line, stat) call check(error, stat) if (allocated(error)) exit call check(error, len(line), 3*10**i) @@ -78,7 +82,7 @@ subroutine test_pad_no(error) rewind(io) do i = 1, 3 - call getline(io, line, stat) + call get_line(io, line, stat) call check(error, stat) if (allocated(error)) exit call check(error, len(line), 3*10**i) @@ -100,14 +104,14 @@ subroutine test_iostat_end(error) rewind(io) do i = 1, 3 - call getline(io, line, stat) + call get_line(io, line, stat) call check(error, stat) if (allocated(error)) exit call check(error, len(line), 3*10**i) if (allocated(error)) exit end do if (.not.allocated(error)) then - call getline(io, line, stat) + call get_line(io, line, stat) call check(error, stat, iostat_end) end if close(io) @@ -123,7 +127,7 @@ subroutine test_closed_unit(error) open(newunit=io, status="scratch") close(io) - call getline(io, line, stat, msg) + call get_line(io, line, stat, msg) call check(error, stat, msg) end subroutine test_closed_unit @@ -135,17 +139,88 @@ subroutine test_no_unit(error) character(len=:), allocatable :: line, msg io = -1 - call getline(io, line, stat, msg) + call get_line(io, line, stat, msg) call check(error, stat, msg) end subroutine test_no_unit -end module test_getline + subroutine test_get_file_missing(error) + !> Test for a missing file. + type(error_type), allocatable, intent(out) :: error + + type(string_type) :: filecontents + type(state_type) :: err + + call get_file("nonexistent_file.txt", fileContents, err) + + ! Check that an error was returned + call check(error, err%error(), "Error not returned on a missing file") + if (allocated(error)) return + + end subroutine test_get_file_missing + + subroutine test_get_file_empty(error) + !> Test for an empty file. + type(error_type), allocatable, intent(out) :: error + + integer :: ios + character(len=:), allocatable :: filename + type(string_type) :: filecontents + type(state_type) :: err + + ! Get a temporary file name + filename = "test_get_file_empty.txt" + + ! Create an empty file + open(newunit=ios, file=filename, action="write", form="formatted", access="sequential") + close(ios) + + ! Read and delete it + call get_file(filename, filecontents, err, delete=.true.) + + call check(error, err%ok(), "Should not return error reading an empty file") + if (allocated(error)) return + + call check(error, len_trim(filecontents) == 0, "String from empty file should be empty") + if (allocated(error)) return + + end subroutine test_get_file_empty + + subroutine test_get_file_non_empty(error) + !> Test for a non-empty file. + type(error_type), allocatable, intent(out) :: error + + integer :: ios + character(len=:), allocatable :: filename + type(string_type) :: filecontents + type(state_type) :: err + + ! Get a temporary file name + filename = "test_get_file_size5.txt" + + ! Create a fixed-size file + open(newunit=ios, file=filename, action="write", form="unformatted", access="stream") + write(ios) "12345" + close(ios) + + ! Read and delete it + call get_file(filename, filecontents, err, delete=.true.) + + call check(error, err%ok(), "Should not return error reading a non-empty file") + if (allocated(error)) return + + call check(error, len_trim(filecontents) == 5, "Wrong string size returned") + if (allocated(error)) return + + end subroutine test_get_file_non_empty + + +end module test_get_line program tester use, intrinsic :: iso_fortran_env, only : error_unit use testdrive, only : run_testsuite, new_testsuite, testsuite_type - use test_getline, only : collect_getline + use test_get_line, only : collect_get_line implicit none integer :: stat, is type(testsuite_type), allocatable :: testsuites(:) @@ -154,7 +229,7 @@ program tester stat = 0 testsuites = [ & - new_testsuite("getline", collect_getline) & + new_testsuite("get_line", collect_get_line) & ] do is = 1, size(testsuites)