From e2947cfa2d1d4da13bb298b4f36cd745b007d88d Mon Sep 17 00:00:00 2001 From: Jerry DeLisle Date: Fri, 17 Jan 2020 19:36:03 -0800 Subject: [PATCH] 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. --- gcc/testsuite/ChangeLog | 5 +++ gcc/testsuite/gfortran.dg/inquire_pre.f90 | 68 +++++++++++++++++++++++++++++++ libgfortran/ChangeLog | 6 +++ libgfortran/io/unit.c | 16 ++++---- 4 files changed, 87 insertions(+), 8 deletions(-) create mode 100644 gcc/testsuite/gfortran.dg/inquire_pre.f90 diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog index 95e4e34..9eacb7f 100644 --- a/gcc/testsuite/ChangeLog +++ b/gcc/testsuite/ChangeLog @@ -1,3 +1,8 @@ +2020-01-17 Jerry DeLisle + + PR libfortran/93234 + * gfortran.dg/inquire_pre.f90: New test. + 2020-01-17 David Malcolm PR analyzer/93290 diff --git a/gcc/testsuite/gfortran.dg/inquire_pre.f90 b/gcc/testsuite/gfortran.dg/inquire_pre.f90 new file mode 100644 index 0000000..c75248b --- /dev/null +++ b/gcc/testsuite/gfortran.dg/inquire_pre.f90 @@ -0,0 +1,68 @@ +! { 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 diff --git a/libgfortran/ChangeLog b/libgfortran/ChangeLog index bd2d87e..f546ef8 100644 --- a/libgfortran/ChangeLog +++ b/libgfortran/ChangeLog @@ -1,5 +1,11 @@ 2020-01-17 Jerry DeLisle + PR libfortran/93234 + * io/unit.c (set_internal_unit): Set round and sign flags + correctly. + +2020-01-17 Jerry DeLisle + PR libfortran/90374 * io/format.c (parse_format_list): Zero width not allowed with FMT_D. diff --git a/libgfortran/io/unit.c b/libgfortran/io/unit.c index c4e1ccb..0030d7e 100644 --- a/libgfortran/io/unit.c +++ b/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; -- 2.7.4