[gcc(refs/users/marxin/heads/marxin-gcc-benchmark-branch)] PR93234 INQUIRE on pre-assigned files of ROUND and SIGN properties
Martin Liska
marxin@gcc.gnu.org
Mon Mar 30 10:14:36 GMT 2020
https://gcc.gnu.org/g:e2947cfa2d1d4da13bb298b4f36cd745b007d88d
commit e2947cfa2d1d4da13bb298b4f36cd745b007d88d
Author: Jerry DeLisle <jvdelisle@gcc.gnu.org>
Date: Fri Jan 17 19:36:03 2020 -0800
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.
Diff:
---
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(-)
diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog
index 95e4e344ee0..9eacb7f568f 100644
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -1,3 +1,8 @@
+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
diff --git a/gcc/testsuite/gfortran.dg/inquire_pre.f90 b/gcc/testsuite/gfortran.dg/inquire_pre.f90
new file mode 100644
index 00000000000..c75248b4db7
--- /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 bd2d87eab01..f546ef872ea 100644
--- a/libgfortran/ChangeLog
+++ b/libgfortran/ChangeLog
@@ -1,3 +1,9 @@
+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
diff --git a/libgfortran/io/unit.c b/libgfortran/io/unit.c
index c4e1ccbdb23..0030d7e8701 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;
More information about the Gcc-cvs
mailing list