This is the mail archive of the
gcc-patches@gcc.gnu.org
mailing list for the GCC project.
[gfortran] PATCH PR 20660, bug fc007
- From: FranÃois-Xavier Coudert <Francois-Xavier dot Coudert at lcp dot u-psud dot fr>
- To: Walt Brainerd <walt at fortran dot com>
- Cc: Gfortran <fortran at gcc dot gnu dot org>, gcc-patches at gcc dot gnu dot org
- Date: Thu, 31 Mar 2005 13:33:23 +0200
- Subject: [gfortran] PATCH PR 20660, bug fc007
- Organization: Laboratoire de Chimie Physique
- References: <42497C3D.7090500@fortran.com>
This patch fixes two bugs submitted by Walt Brainerd and related to handling
negative units and INQUIRing non-opened units: fc001, aka PR
libfortran/20660, and fc007.
*strapped and regtested on i386-linux for both 4.0 and mainline. OK?
2005-03-31 Francois-Xavier Coudert <coudert@clipper.ens.fr>
PR libfortran/20660
* io/inquire.c (inquire_via_unit): Non-opened units should still be
reported by an INQUIRE statement as existing.
* io/transfer.c (data_transfer_init): Never accept negative units.
2005-03-31 Francois-Xavier Coudert <coudert@clipper.ens.fr>
PR libfortran/20660
* gfortran.dg/negative_unit.f: New test.
! {dg-do run}
!
! PR libfortran/20660 and other bugs (not filed in bugzilla) relating
! to negative units
!
! Bugs submitted by Walt Brainerd
integer i
logical l
i = 0
! gfortran created a 'fort.-1' file and wrote "Hello" in it
write (unit=-1, fmt=*, iostat=i) "Hello"
if (i <= 0) call abort
i = 0
open (unit=-11, file="xxx", iostat=i)
if (i <= 0) call abort
inquire (unit=-42, exist=l)
if (l) call abort
end
Index: inquire.c
===================================================================
RCS file: /cvsroot/gcc/gcc/libgfortran/io/inquire.c,v
retrieving revision 1.9
diff -p -u -r1.9 inquire.c
--- inquire.c 30 Jan 2005 13:16:19 -0000 1.9
+++ inquire.c 31 Mar 2005 11:24:59 -0000
@@ -46,7 +46,12 @@ inquire_via_unit (gfc_unit * u)
const char *p;
if (ioparm.exist != NULL)
- *ioparm.exist = (u != NULL);
+ {
+ if (ioparm.unit >= 0)
+ *ioparm.exist = 1;
+ else
+ *ioparm.exist = 0;
+ }
if (ioparm.opened != NULL)
*ioparm.opened = (u != NULL);
Index: transfer.c
===================================================================
RCS file: /cvsroot/gcc/gcc/libgfortran/io/transfer.c,v
retrieving revision 1.33
diff -p -u -r1.33 transfer.c
--- transfer.c 25 Mar 2005 13:35:29 -0000 1.33
+++ transfer.c 31 Mar 2005 11:25:00 -0000
@@ -935,6 +935,12 @@ data_transfer_init (int read_flag)
current_unit = get_unit (read_flag);
if (current_unit == NULL)
{ /* Open the unit with some default flags. */
+ if (ioparm.unit < 0)
+ {
+ generate_error (ERROR_BAD_OPTION, "Bad unit number in OPEN statement");
+ library_end ();
+ return;
+ }
memset (&u_flags, '\0', sizeof (u_flags));
u_flags.access = ACCESS_SEQUENTIAL;
u_flags.action = ACTION_READWRITE;