Skip to content

R
riscv-gcc-1
Commit e2947cfa by Jerry DeLisle
Options

PR93234 INQUIRE on pre-assigned files of ROUND and SIGN properties 

	PR libfortran/93234
	* io/unit.c (set_internal_unit): Set round and sign flags
	correctly.

	* gfortran.dg/inquire_pre.f90: New test.
parent 92030203
Showing with 87 additions and 8 deletions
gcc/testsuite/ChangeLog
2020-01-17 Jerry DeLisle <jvdelisle@gcc.gnu.org>
PR libfortran/93234
* gfortran.dg/inquire_pre.f90: New test.
2020-01-17 David Malcolm <dmalcolm@redhat.com>
PR analyzer/93290
......
gcc/testsuite/gfortran.dg/inquire_pre.f90 0 → 100644
! { dg-do run }
! PR93234 Inquire by UNIT on preopened unit failed on ROUND= and SIGN=
program inquire_browse
implicit none
integer :: ios
character(len=256) :: message
!==============================================================================================
character(len=20) :: name ; namelist/inquire/name
integer :: unit ; namelist/inquire/unit
integer :: id ; namelist/inquire/id
!==============================================================================================
integer :: recl ; namelist/inquire/recl
integer :: nextrec ; namelist/inquire/nextrec
integer :: pos ; namelist/inquire/pos
integer :: size ; namelist/inquire/size
!==============================================================================================
! ACCESS = SEQUENTIAL | DIRECT | STREAM
character(len=20) :: access ; namelist/inquire/access
character(len=20) :: sequential ; namelist/inquire/sequential
character(len=20) :: stream ; namelist/inquire/stream
character(len=20) :: direct ; namelist/inquire/direct
! ACTION = READ | WRITE | READWRITE
character(len=20) :: action ; namelist/inquire/action
character(len=20) :: read ; namelist/inquire/read
character(len=20) :: write ; namelist/inquire/write
character(len=20) :: readwrite ; namelist/inquire/readwrite
! FORM = FORMATTED | UNFORMATTED
cHaracter(len=20) :: form ; namelist/inquire/form
character(len=20) :: formatted ; namelist/inquire/formatted
character(len=20) :: unformatted ; namelist/inquire/unformatted
! POSITION = ASIS | REWIND | APPEND
character(len=20) :: position ; namelist/inquire/position
!==============================================================================================
character(len=20) :: blank ; namelist/inquire/blank
character(len=20) :: decimal ; namelist/inquire/decimal
character(len=20) :: sign ; namelist/inquire/sign
character(len=20) :: round ; namelist/inquire/round
character(len=20) :: delim ; namelist/inquire/delim
character(len=20) :: encoding ; namelist/inquire/encoding
character(len=20) :: pad ; namelist/inquire/pad
!==============================================================================================
logical :: named ; namelist/inquire/named
logical :: opened ; namelist/inquire/opened
logical :: exist ; namelist/inquire/exist
integer :: number ; namelist/inquire/number
logical :: pending ; namelist/inquire/pending
character(len=20) :: asynchronous ; namelist/inquire/asynchronous
!==============================================================================================
unit=5
!!include "setunit_and_open.inc"
inquire(unit=unit,sign=sign)
inquire(unit=unit,round=round)
inquire(unit=unit, &
& recl=recl,nextrec=nextrec,pos=pos,size=size, &
& name=name,position=position, &
& form=form,formatted=formatted,unformatted=unformatted, &
& access=access,sequential=sequential,direct=direct,stream=stream, &
& action=action,read=read,write=write,readwrite=readwrite, &
& blank=blank,decimal=decimal,delim=delim,encoding=encoding,pad=pad, &
& named=named,opened=opened,exist=exist,number=number,pending=pending,asynchronous=asynchronous, &
& iostat=ios,err=999,iomsg=message)
999 continue
if(ios.eq.0)then
!write(*,nml=inquire,delim='none')
else
stop 1
endif
end program inquire_browse
libgfortran/ChangeLog
2020-01-17 Jerry DeLisle <jvdelisle@gcc.gnu.org>
PR libfortran/93234
* io/unit.c (set_internal_unit): Set round and sign flags
correctly.
2020-01-17 Jerry DeLisle <jvdelisle@gcc.gnu.org>
PR libfortran/90374
* io/format.c (parse_format_list): Zero width not allowed with
FMT_D.
......
libgfortran/io/unit.c
......@@ -514,12 +514,12 @@ set_internal_unit (st_parameter_dt *dtp, gfc_unit *iunit, int kind)
iunit->flags.form = FORM_FORMATTED;
iunit->flags.pad = PAD_YES;
iunit->flags.status = STATUS_UNSPECIFIED;
iunit->flags.sign = SIGN_UNSPECIFIED;
iunit->flags.sign = SIGN_PROCDEFINED;
iunit->flags.decimal = DECIMAL_POINT;
iunit->flags.delim = DELIM_UNSPECIFIED;
iunit->flags.encoding = ENCODING_DEFAULT;
iunit->flags.async = ASYNC_NO;
iunit->flags.round = ROUND_UNSPECIFIED;
iunit->flags.round = ROUND_PROCDEFINED;
/* Initialize the data transfer parameters. */
......@@ -627,12 +627,12 @@ init_units (void)
u->flags.blank = BLANK_NULL;
u->flags.pad = PAD_YES;
u->flags.position = POSITION_ASIS;
u->flags.sign = SIGN_UNSPECIFIED;
u->flags.sign = SIGN_PROCDEFINED;
u->flags.decimal = DECIMAL_POINT;
u->flags.delim = DELIM_UNSPECIFIED;
u->flags.encoding = ENCODING_DEFAULT;
u->flags.async = ASYNC_NO;
u->flags.round = ROUND_UNSPECIFIED;
u->flags.round = ROUND_PROCDEFINED;
u->flags.share = SHARE_UNSPECIFIED;
u->flags.cc = CC_LIST;
......@@ -658,12 +658,12 @@ init_units (void)
u->flags.status = STATUS_OLD;
u->flags.blank = BLANK_NULL;
u->flags.position = POSITION_ASIS;
u->flags.sign = SIGN_UNSPECIFIED;
u->flags.sign = SIGN_PROCDEFINED;
u->flags.decimal = DECIMAL_POINT;
u->flags.delim = DELIM_UNSPECIFIED;
u->flags.encoding = ENCODING_DEFAULT;
u->flags.async = ASYNC_NO;
u->flags.round = ROUND_UNSPECIFIED;
u->flags.round = ROUND_PROCDEFINED;
u->flags.share = SHARE_UNSPECIFIED;
u->flags.cc = CC_LIST;
......@@ -689,11 +689,11 @@ init_units (void)
u->flags.status = STATUS_OLD;
u->flags.blank = BLANK_NULL;
u->flags.position = POSITION_ASIS;
u->flags.sign = SIGN_UNSPECIFIED;
u->flags.sign = SIGN_PROCDEFINED;
u->flags.decimal = DECIMAL_POINT;
u->flags.encoding = ENCODING_DEFAULT;
u->flags.async = ASYNC_NO;
u->flags.round = ROUND_UNSPECIFIED;
u->flags.round = ROUND_PROCDEFINED;
u->flags.share = SHARE_UNSPECIFIED;
u->flags.cc = CC_LIST;
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment