https://gcc.gnu.org/bugzilla/show_bug.cgi?id=124543
--- Comment #4 from Walter Spector <w6ws at earthlink dot net> ---
Jerry - I added a new set of tests for unformatted stream. Also added rec= to
align with some requirements F2018 added. Hopefully I've got all the values
right...:
#define TEST_F2003
!
! Causes a SEGV at run-time w/gfortran
! #define TEST_F2003ASYNC
!
! Defined in F2018 (recl= defaults)
#define TEST_F2018
!
! Not supported yet by gfortran
! #define TEST_F2023
program inq_tests
implicit none
! Test various INQUIRE return values
! Most of these tests are based on Table C.1 in Section C.6.5 of F95.
! F2003, F2018 and F2023 can optionally be enabled.
character(16) :: access, action, blank, delim, direct, form, formatted
character(16) :: name, pad, position, read, readwrite, sequential
character(16) :: unformatted, write
logical :: exist, named, opened
integer :: iostat, nextrec, number, recl
#ifdef TEST_F2003
character(20) :: decimal, encoding, round, signc, stream
integer :: pos
#endif
#ifdef TEST_F2003ASYNC
character(16) :: async
integer :: id
logical :: pending
#endif
#ifdef TEST_F2023
character(16) :: leading_zero
#endif
integer, parameter :: lun = 42
character(*), parameter :: lfn = 'fort.42'
integer :: fail_count = 0, pass_count = 0
! Make sure there is no file with the name we will be using
open (lun, file=lfn, status='old', iostat=iostat)
if (iostat == 0) then
close (lun, status='delete')
end if
! File not connected yet
call init_vars ()
inquire (file=lfn, access=access, action=action, blank=blank, delim=delim, &
direct=direct, form=form, formatted=formatted, pad=pad,
position=position, &
read=read, readwrite=readwrite, sequential=sequential,
unformatted=unformatted, &
write=write, iostat=iostat)
print *, 'Unconnected INQUIRE by file'
print *, 'iostat =', iostat, pf (iostat == 0)
print *, 'access =', access, pf (access == 'UNDEFINED')
print *, 'action =', action, pf (action == 'UNDEFINED')
print *, 'blank =', blank, pf (blank == 'UNDEFINED')
print *, 'delim =', delim, pf (delim == 'UNDEFINED')
print *, 'direct =', direct, pf (direct == 'UNKNOWN')
print *, 'exist =', exist, pf (.not. exist)
print *, 'form =', form, pf (form == 'UNDEFINED')
print *, 'formatted =', formatted, pf (formatted == 'UNKNOWN')
print *, 'name =', name, pf (name /= lfn)
print *, 'named =', named, pf (named)
print *, 'number =', number, pf (number == -1)
print *, 'opened =', opened, pf (.not. opened)
print *, 'pad =', pad, pf (pad == 'YES')
print *, 'position =', position, pf (position == 'UNDEFINED')
print *, 'read =', read, pf (read == 'UNKNOWN')
print *, 'readwrite =', readwrite, pf (readwrite == 'UNKNOWN')
print *, 'sequential =', sequential, pf (sequential == 'UNKNOWN')
print *, 'unformatted =', unformatted, pf (unformatted == 'UNKNOWN')
print *, 'write =', write, pf (write == 'UNKNOWN')
#ifdef TEST_F2003
inquire (file=lfn, decimal=decimal, encoding=encoding, pos=pos, &
round=round, sign=signc, stream=stream)
print *, 'decimal =', decimal, pf (decimal == 'UNDEFINED')
print *, 'encoding =', encoding, pf (decimal == 'UNKNOWN')
print *, 'round =', round, pf (round == 'UNDEFINED')
print *, 'sign =', signc, pf (signc == 'UNDEFINED')
print *, 'stream =', stream, pf (stream == 'UNKNOWN')
#endif
#ifdef TEST_F2003ASYNC
inquire (file=lfn, asynchronous=async)
print *, 'asynchronous =', async, pf (async == 'UNDEFINED')
inquire (file=lfn, id=id, pending=pending) ! SEGV at run-time w/gfortran
#endif
#ifdef TEST_F2018
print *, 'recl =', recl, pf (recl == -1)
#endif
#ifdef TEST_F2023
inquire (file=lfn, leading_zero=leading_zero)
print *, 'leading_zero =', leading_zero, pf (leading_zero == 'UNDEFINED')
#endif
! Unit not connected yet
call init_vars ()
inquire (unit=lun, access=access, action=action, blank=blank, delim=delim, &
direct=direct, form=form, formatted=formatted, pad=pad,
position=position, &
read=read, readwrite=readwrite, sequential=sequential,
unformatted=unformatted, &
write=write, iostat=iostat)
print *
print *, 'Unconnected INQUIRE by unit'
print *, 'iostat =', iostat, pf (iostat == 0)
print *, 'access =', access, pf (access == 'UNDEFINED')
print *, 'action =', action, pf (action == 'UNDEFINED')
print *, 'blank =', blank, pf (blank == 'UNDEFINED')
print *, 'delim =', delim, pf (delim == 'UNDEFINED')
print *, 'direct =', direct, pf (direct == 'UNKNOWN')
print *, 'exist =', exist, pf (.not. exist)
print *, 'form =', form, pf (form == 'UNDEFINED')
print *, 'formatted =', formatted, pf (formatted == 'UNKNOWN')
print *, 'name =', name, pf (name == 'UNDEFINED')
print *, 'named =', named, pf (.not. named)
print *, 'number =', number, pf (number == -1)
print *, 'opened =', opened, pf (.not. opened)
print *, 'pad =', pad, pf (pad == 'YES')
print *, 'position =', position, pf (position == 'UNDEFINED')
print *, 'read =', read, pf (read == 'UNKNOWN')
print *, 'readwrite =', readwrite, pf (readwrite == 'UNKNOWN')
print *, 'sequential =', sequential, pf (sequential == 'UNKNOWN')
print *, 'unformatted =', unformatted, pf (unformatted == 'UNKNOWN')
print *, 'write =', write, pf (write == 'UNKNOWN')
#ifdef TEST_F2003
inquire (unit=lun, decimal=decimal, encoding=encoding, pos=pos, &
round=round, sign=signc, stream=stream)
print *, 'decimal =', decimal, pf (decimal == 'UNDEFINED')
print *, 'encoding =', encoding, pf (encoding == 'UNKNOWN')
print *, 'round =', round, pf (round == 'UNDEFINED')
print *, 'sign =', signc, pf (signc == 'UNDEFINED')
print *, 'stream =', stream, pf (stream == 'UNKNOWN')
#endif
#ifdef TEST_F2003ASYNC
inquire (unit=lun, asynchronous=async)
print *, 'asynchronous =', async, pf (async == 'UNDEFINED')
inquire (unit=lun, id=id, pending=pending) ! SEGV at run-time w/gfortran
#endif
#ifdef TEST_F2018
print *, 'recl =', recl, pf (recl == -1)
#endif
#ifdef TEST_F2023
inquire (unit=lun, leading_zero=leading_zero)
print *, 'leading_zero =', leading_zero, pf (leading_zero == 'UNDEFINED')
#endif
! Open the file to connect it to the unit - sequential access
open (lun, file=lfn, status='new', access='sequential', form='formatted',
recl=80)
write (lun,*) 'hello world!'
rewind (lun)
call init_vars ()
inquire (file=lfn, access=access, action=action, blank=blank, delim=delim, &
direct=direct, form=form, formatted=formatted, pad=pad,
position=position, &
read=read, readwrite=readwrite, sequential=sequential,
unformatted=unformatted, &
write=write, iostat=iostat)
print *
print *, 'Connected INQUIRE by file (sequential)'
print *, 'iostat =', iostat, pf (iostat == 0)
print *, 'access =', access, pf (access == 'SEQUENTIAL')
print *, 'action =', action, pf (action == 'READWRITE')
print *, 'blank =', blank, pf (blank == 'NULL')
print *, 'delim =', delim, pf (delim == 'NONE')
print *, 'direct =', direct, pf (direct == 'NO')
print *, 'exist =', exist, pf (.not. exist)
print *, 'form =', form, pf (form == 'FORMATTED')
print *, 'formatted =', formatted, pf (formatted == 'YES')
print *, 'name =', name, pf (name == lfn)
print *, 'named =', named, pf (named)
print *, 'number =', number, pf (number == -1)
print *, 'opened =', opened, pf (opened)
print *, 'pad =', pad, pf (pad == 'YES')
print *, 'position =', position, pf (position == 'REWIND')
print *, 'read =', read, pf (read == 'YES')
print *, 'readwrite =', readwrite, pf (readwrite == 'YES')
print *, 'recl =', recl, pf (recl == 80)
print *, 'sequential =', sequential, pf (sequential == 'YES')
print *, 'unformatted =', unformatted, pf (unformatted == 'NO')
print *, 'write =', write, pf (write == 'YES')
#ifdef TEST_F2003
inquire (file=lfn, decimal=decimal, encoding=encoding, pos=pos, &
round=round, sign=signc, stream=stream)
print *, 'decimal =', decimal, pf (decimal == 'POINT')
print *, 'encoding =', encoding, pf (encoding == 'UNKNOWN')
print *, 'round =', round, pf (round == 'PROCESSOR_DEFINED')
print *, 'sign =', signc, pf (signc == 'PROCESSOR_DEFINED')
print *, 'stream =', stream, pf (stream == 'NO')
#endif
! Unit is connected
call init_vars ()
inquire (unit=lun, access=access, action=action, blank=blank, delim=delim, &
direct=direct, form=form, formatted=formatted, pad=pad,
position=position, &
read=read, readwrite=readwrite, sequential=sequential,
unformatted=unformatted, &
write=write, iostat=iostat)
print *
print *, 'Connected INQUIRE by unit (sequential)'
print *, 'iostat =', iostat, pf (iostat == 0)
print *, 'access =', access, pf (access == 'SEQUENTIAL')
print *, 'action =', action, pf (action == 'READWRITE')
print *, 'blank =', blank, pf (blank == 'NULL')
print *, 'delim =', delim, pf (delim == 'NONE')
print *, 'direct =', direct, pf (direct == 'NO')
print *, 'exist =', exist, pf (.not. exist)
print *, 'form =', form, pf (form == 'FORMATTED')
print *, 'formatted =', formatted, pf (formatted == 'NO')
print *, 'name =', name, pf (name == lfn)
print *, 'named =', named, pf (named)
print *, 'number =', number, pf (number == -1)
print *, 'opened =', opened, pf (opened)
print *, 'pad =', pad, pf (pad == 'YES')
print *, 'position =', position, pf (position == 'REWIND')
print *, 'read =', read, pf (read == 'YES')
print *, 'readwrite =', readwrite, pf (readwrite == 'YES')
print *, 'recl =', recl, pf (recl == 80)
print *, 'sequential =', sequential, pf (sequential == 'YES')
print *, 'unformatted =', unformatted, pf (unformatted == 'NO')
print *, 'write =', write, pf (write == 'YES')
#ifdef TEST_F2003
inquire (unit=lun, decimal=decimal, encoding=encoding, pos=pos, &
round=round, sign=signc, stream=stream)
print *, 'decimal =', decimal, pf (decimal == 'POINT')
print *, 'encoding =', encoding, pf (encoding == 'UNKNOWN')
print *, 'round =', round, pf (round == 'PROCESSOR_DEFINED')
print *, 'sign =', signc, pf (signc == 'PROCESSOR_DEFINED')
print *, 'stream =', stream, pf (stream == 'NO')
#endif
close (lun, status='delete')
#ifdef TEST_F2003
! Open the file to connect it to the unit - sequential stream access
open (lun, file=lfn, status='new', access='stream', form='unformatted')
write (lun) 'hello world!'
rewind (lun)
call init_vars ()
inquire (file=lfn, access=access, action=action, blank=blank, delim=delim, &
direct=direct, form=form, formatted=formatted, pad=pad,
position=position, &
read=read, readwrite=readwrite, sequential=sequential,
unformatted=unformatted, &
write=write, iostat=iostat)
print *
print *, 'Connected INQUIRE by file (stream, unformatted)'
print *, 'iostat =', iostat, pf (iostat == 0)
print *, 'access =', access, pf (access == 'STREAM')
print *, 'action =', action, pf (action == 'READWRITE')
print *, 'blank =', blank, pf (blank == 'UNDEFINED')
print *, 'delim =', delim, pf (delim == 'UNDEFINED')
print *, 'direct =', direct, pf (direct == 'NO')
print *, 'exist =', exist, pf (.not. exist)
print *, 'form =', form, pf (form == 'UNFORMATTED')
print *, 'formatted =', formatted, pf (formatted == 'NO')
print *, 'name =', name, pf (name == lfn)
print *, 'named =', named, pf (named)
print *, 'number =', number, pf (number == -1)
print *, 'opened =', opened, pf (opened)
print *, 'pad =', pad, pf (pad == 'UNDEFINED')
print *, 'position =', position, pf (position == 'REWIND')
print *, 'read =', read, pf (read == 'YES')
print *, 'readwrite =', readwrite, pf (readwrite == 'YES')
print *, 'sequential =', sequential, pf (sequential == 'NO') ! ????
print *, 'unformatted =', unformatted, pf (unformatted == 'YES')
print *, 'write =', write, pf (write == 'YES')
inquire (file=lfn, decimal=decimal, encoding=encoding, pos=pos, &
round=round, sign=signc, stream=stream)
print *, 'decimal =', decimal, pf (decimal == 'UNDEFINED')
print *, 'encoding =', encoding, pf (encoding == 'UNDEFINED')
print *, 'round =', round, pf (round == 'PROCESSOR_DEFINED')
print *, 'sign =', signc, pf (signc == 'PROCESSOR_DEFINED')
print *, 'stream =', stream, pf (stream == 'YES')
#ifdef TEST_F2018
print *, 'recl =', recl, pf (recl == -2)
#endif
! Unit is connected
call init_vars ()
inquire (unit=lun, access=access, action=action, blank=blank, delim=delim, &
direct=direct, form=form, formatted=formatted, pad=pad,
position=position, &
read=read, readwrite=readwrite, sequential=sequential,
unformatted=unformatted, &
write=write, iostat=iostat)
print *
print *, 'Connected INQUIRE by unit (stream, unformatted)'
print *, 'iostat =', iostat, pf (iostat == 0)
print *, 'access =', access, pf (access == 'STREAM')
print *, 'action =', action, pf (action == 'READWRITE')
print *, 'blank =', blank, pf (blank == 'UNDEFINED')
print *, 'delim =', delim, pf (delim == 'UNDEFINED')
print *, 'direct =', direct, pf (direct == 'NO')
print *, 'exist =', exist, pf (.not. exist)
print *, 'form =', form, pf (form == 'UNFORMATTED')
print *, 'formatted =', formatted, pf (formatted == 'NO')
print *, 'name =', name, pf (name == lfn)
print *, 'named =', named, pf (named)
print *, 'number =', number, pf (number == -1)
print *, 'opened =', opened, pf (opened)
print *, 'pad =', pad, pf (pad == 'UNDEFINED')
print *, 'position =', position, pf (position == 'REWIND')
print *, 'read =', read, pf (read == 'YES')
print *, 'readwrite =', readwrite, pf (readwrite == 'YES')
print *, 'sequential =', sequential, pf (sequential == 'NO') ! ????
print *, 'unformatted =', unformatted, pf (unformatted == 'YES')
print *, 'write =', write, pf (write == 'YES')
inquire (unit=lun, decimal=decimal, encoding=encoding, pos=pos, &
round=round, sign=signc, stream=stream)
print *, 'decimal =', decimal, pf (decimal == 'UNDEFINED')
print *, 'encoding =', encoding, pf (encoding == 'UNDEFINED')
print *, 'round =', round, pf (round == 'PROCESSOR_DEFINED')
print *, 'sign =', signc, pf (signc == 'PROCESSOR_DEFINED')
print *, 'stream =', stream, pf (stream == 'YES')
#ifdef TEST_F2018
print *, 'recl =', recl, pf (recl == -2)
#endif
close (lun, status='delete')
#endif
! Open the file to connect it to the unit - direct access
open (lun, file=lfn, status='new', access='direct', recl=12,
form='formatted')
write (lun,rec=1, fmt='(a)') 'hello world!'
call init_vars ()
inquire (file=lfn, access=access, action=action, blank=blank, delim=delim, &
direct=direct, form=form, formatted=formatted, nextrec=nextrec, pad=pad,
&
position=position, read=read, readwrite=readwrite, recl=recl, &
sequential=sequential, unformatted=unformatted, write=write,
iostat=iostat)
print *
print *, 'Connected INQUIRE by file (direct, formatted)'
print *, 'iostat =', iostat, pf (iostat == 0)
print *, 'access =', access, pf (access == 'DIRECT')
print *, 'action =', action, pf (action == 'READWRITE')
print *, 'blank =', blank, pf (blank == 'NULL')
print *, 'delim =', delim, pf (delim == 'NONE')
print *, 'direct =', direct, pf (direct == 'YES')
print *, 'exist =', exist, pf (.not. exist)
print *, 'form =', form, pf (form == 'FORMATTED')
print *, 'formatted =', formatted, pf (formatted == 'NO')
print *, 'name =', name, pf (name == lfn)
print *, 'named =', named, pf (named)
print *, 'nextrec =', nextrec, pf (nextrec == 2)
print *, 'number =', number, pf (number == 2)
print *, 'opened =', opened, pf (opened)
print *, 'pad =', pad, pf (pad == 'YES')
print *, 'position =', position, pf (position == 'UNDEFINED')
print *, 'read =', read, pf (read == 'YES')
print *, 'readwrite =', readwrite, pf (readwrite == 'YES')
print *, 'recl =', recl, pf (recl == 12)
print *, 'sequential =', sequential, pf (sequential == 'NO')
print *, 'unformatted =', unformatted, pf (unformatted == 'NO')
print *, 'write =', write, pf (write == 'YES')
! Unit is connected
call init_vars ()
inquire (unit=lun, access=access, action=action, blank=blank, delim=delim, &
direct=direct, form=form, formatted=formatted, nextrec=nextrec, pad=pad,
&
position=position, read=read, readwrite=readwrite, recl=recl, &
sequential=sequential, unformatted=unformatted, write=write,
iostat=iostat)
print *
print *, 'Connected INQUIRE by unit (direct, formatted)'
print *, 'iostat =', iostat, pf (iostat == 0)
print *, 'access =', access, pf (access == 'DIRECT')
print *, 'action =', action, pf (action == 'READWRITE')
print *, 'blank =', blank, pf (blank == 'NULL')
print *, 'delim =', delim, pf (delim == 'NONE')
print *, 'direct =', direct, pf (direct == 'YES')
print *, 'exist =', exist, pf (.not. exist)
print *, 'form =', form, pf (form == 'FORMATTED')
print *, 'formatted =', formatted, pf (formatted == 'YES')
print *, 'name =', name, pf (name == lfn)
print *, 'named =', named, pf (named)
print *, 'nextrec =', nextrec, pf (nextrec == 2)
print *, 'number =', number, pf (number == 2)
print *, 'opened =', opened, pf (opened)
print *, 'pad =', pad, pf (pad == 'YES')
print *, 'position =', position, pf (position == 'UNDEFINED')
print *, 'read =', read, pf (read == 'YES')
print *, 'readwrite =', readwrite, pf (readwrite == 'YES')
print *, 'recl =', recl, pf (recl == 12)
print *, 'sequential =', sequential, pf (sequential == 'NO')
print *, 'unformatted =', unformatted, pf (unformatted == 'NO')
print *, 'write =', write, pf (write == 'YES')
close (lun)
print *, '# of passes :', pass_count
print *, '# of failures:', fail_count
contains
subroutine init_vars ()
access = 'xxx'
action = 'xxx'
blank = 'xxx'
delim = 'xxx'
direct = 'xxx'
form = 'xxx'
formatted = 'xxx'
name = 'xxx'
nextrec = -41
number = -42
pad = 'xxx'
position = 'xxx'
read = 'xxx'
readwrite = 'xxx'
recl = -43
sequential = 'xxx'
unformatted = 'xxx'
write = 'xxx'
#ifdef TEST_F2003
decimal = 'xxx'
encoding = 'xxx'
round = 'xxx'
pos = -44
signc = 'xxx'
stream = 'xxx'
#endif
#ifdef TEST_F2003ASYNC
async = 'xxx'
id = -45
#endif
#ifdef TEST_F2023
leading_zero = 'xxx'
#endif
end subroutine
function pf (l)
character(6) :: pf
logical, intent(in) :: l
pf = merge (': pass', ': fail', l)
if (l) then
pass_count = pass_count + 1
else
fail_count = fail_count + 1
end if
end function
end program
