getfile Function

public function getfile(fileName, iostat, iomsg, delete) result(file)

Read a whole ASCII file into an allocatable string, without its trailing newlines, and optionally delete it afterwards. Ported from stdlib’s getfile, with an integer flag in place of the state type: on error, if iostat is not requested, the code stops. Check if the file should be deleted after reading Check file existing Retrieve file size, of the open unit: LLVM Flang on Windows returns -1 by file name

Arguments

Type IntentOptional Attributes Name
character(len=*), intent(in) :: fileName

Input file name

integer, intent(out), optional :: iostat

[optional] Error flag, 0 on success

character(len=:), intent(out), optional, allocatable :: iomsg

[optional] Error message

logical, intent(in), optional :: delete

[optional] Delete file after reading? Default: do not delete

Return Value character(len=:), allocatable

Return as an allocatable string


Source Code

function getfile(fileName, iostat, iomsg, delete) result(file)
    !> Input file name
    character(*), intent(in) :: fileName
    !> [optional] Error flag, 0 on success
    integer, optional, intent(out) :: iostat
    !> [optional] Error message
    character(len=:), allocatable, optional, intent(out) :: iomsg
    !> [optional] Delete file after reading? Default: do not delete
    logical, optional, intent(in) :: delete
    !> Return as an allocatable string
    character(len=:), allocatable :: file

    ! Local variables
    character(*), parameter :: CRLF = achar(13)//new_line('a')
    character(len=:), allocatable :: fileString, message
    character(len=512) :: msg
    character :: last_char
    integer :: lun, stat
    integer(int64) :: errpos, fileSize
    logical :: is_present, want_deleted

    ! Initializations
    file = ""
    message = ""
    stat = 0

    !> Check if the file should be deleted after reading
    if (present(delete)) then
        want_deleted = delete
    else
        want_deleted = .false.
    end if

    read_file: block

        !> Check file existing
        inquire(file=fileName, exist=is_present)
        if (.not.is_present) then
            stat = 1
            message = 'File not present: '//fileName
            exit read_file
        end if

        ! Read file
        open(newunit=lun, file=fileName, &
             form='unformatted', action='read', access='stream', status='old', &
             iostat=stat, iomsg=msg)

        if (stat /= 0) then
            message = 'Cannot open '//fileName//' for read: '//trim(msg)
            exit read_file
        end if

        !> Retrieve file size, of the open unit: LLVM Flang on Windows returns -1 by file name
        inquire(unit=lun, size=fileSize)

        invalid_size: if (fileSize < 0) then
            stat = 1
            message = fileName//' has invalid size='//str(fileSize)
            close(lun)
            exit read_file
        end if invalid_size

        remove_trailing_newline: if (fileSize > 0) then

            last_char = CRLF(1:1)
            fileSize = fileSize + 1

            do while (scan(last_char, CRLF) > 0 .and. fileSize > 1)
                fileSize = fileSize - 1
                read(lun, pos=fileSize, iostat=stat, iomsg=msg) last_char

                ! Read error
                if (stat /= 0) then
                    message = trim(msg)//' ('//fileName//' at byte '//str(fileSize)//')'
                    close(lun)
                    exit read_file
                end if
            end do

        end if remove_trailing_newline

        allocate(character(len=fileSize) :: fileString)

        read_data: if (fileSize > 0) then

            read(lun, pos=1, iostat=stat, iomsg=msg) fileString

            ! Read error
            if (stat /= 0) then
                inquire(unit=lun, pos=errpos)
                message = trim(msg)//' ('//fileName//' at byte '//str(errpos)//')'
                close(lun)
                exit read_file
            end if

        end if read_data

        close(lun, iostat=stat)
        if (stat /= 0) then
            message = 'Cannot close '//fileName//' after reading'
        elseif (want_deleted) then
            stat = c_remove(fileName//c_null_char)
            if (stat /= 0) message = 'Cannot delete '//fileName//' after reading'
        end if

        ! Process output
        call move_alloc(from=fileString, to=file)

    end block read_file

    if (present(iomsg)) iomsg = message
    if (present(iostat)) then
        iostat = stat
    elseif (stat /= 0) then
        call fpm_stop(1, '*getfile*: '//message)
    end if

end function getfile