https://gcc.gnu.org/bugzilla/show_bug.cgi?id=124543
Bug ID: 124543
Summary: INQUIRE: Sometimes returns incorrect values
Product: gcc
Version: 16.0
Status: UNCONFIRMED
Severity: normal
Priority: P3
Component: fortran
Assignee: unassigned at gcc dot gnu.org
Reporter: w6ws at earthlink dot net
Target Milestone: ---
The following tests INQUIRE mostly based on Table C.1 in Section C.6.5 of F95.
I've also conditionally added some tests for the F2003 and F2023 additions.
Note that the F2003 asynch I/O keywords cause a SEGV at run-time.
#define TEST_F2003
!
! Causes a SEGV at run-time w/gfortran
! #define TEST_F2003ASYNC
!
! 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 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'
! 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
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
! File not connected yet
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_F2023
inquire (file=lfn, leading_zero=leading_zero)
print *, 'leading_zero =', leading_zero, pf (leading_zero == 'UNDEFINED')
#endif
! Unit not connected yet
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_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')
write (lun,*) 'hello world!'
rewind (lun)
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 *, '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
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 *, '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')
! 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!'
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)'
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 == 'REWIND')
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
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)'
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 == 'REWIND')
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)
contains
function pf (l)
character(6) :: pf
logical, intent(in) :: l
pf = merge (': pass', ': fail', l)
end function
end program
