PR93234 INQUIRE on pre-assigned files of ROUND and SIGN properties
authorJerry DeLisle <jvdelisle@gcc.gnu.org>
Sat, 18 Jan 2020 03:36:03 +0000 (19:36 -0800)
committerJerry DeLisle <jvdelisle@gcc.gnu.org>
Sat, 18 Jan 2020 03:36:03 +0000 (19:36 -0800)
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
gcc/testsuite/gfortran.dg/inquire_pre.f90 [new file with mode: 0644]
libgfortran/ChangeLog
libgfortran/io/unit.c

index 95e4e344ee058913c55c73ad70cfab9e93447c60..9eacb7f568f2a82f775c549041ab6abe009c57c0 100644 (file)
@@ -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 (file)
index 0000000..c75248b
--- /dev/null
@@ -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
index bd2d87eab014ead70e2a875134ffbc81fa07f7ad..f546ef872eaf5f91646d7d07432ef5e1aa605851 100644 (file)
@@ -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
index c4e1ccbdb23e46c9b1aba58c85e8346b6f354c17..0030d7e8701856630ad89194f6b02a749d3179fe 100644 (file)
@@ -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;