This is the mail archive of the
fortran@gcc.gnu.org
mailing list for the GNU Fortran project.
gfortran patch for PR 18778 Abort on endfile on unopened unit
- From: Bud Davis <bdavis9659 at comcast dot net>
- To: "gcc-patches at gcc dot gnu dot org" <gcc-patches at gcc dot gnu dot org>, gfortran <fortran at gcc dot gnu dot org>
- Date: Thu, 23 Dec 2004 21:36:04 -0600
- Subject: gfortran patch for PR 18778 Abort on endfile on unopened unit
This fixes the PR and FM411 of the NIST tests.
ENDFILE(8)
READ(8,END=111)A
was aborting. first we needed to add code to the endfile statement
to open a unit if the unit was not previously open. next, we
had a problem with pre-positioning on an empty unit. the
following would fail with a runtime error:
OPEN(8,FORMAT='UNFORMATTED',STATUS='SCRATCH')
READ(8,END=111)A
which it is not right, the correct action is to hit the END=.
This patch fixes both problems:
The test suite file fails before and passes after applying this
patch. Tested i686/gnu/linux with no new regressions.
After this patch we are down to the following NIST failures:
11 f95 compile fails
FM020.FOR FM111.FOR FM252.FOR FM311.FOR FM328.FOR FM509.FOR
FM517.FOR FM711.FOR FM719.FOR FM908.FOR FM909.FOR
1 f95 run time error
FM110.FOR
1 f95 test(s) failed
FM912.FOR
which looks pretty good !! AFAIK, all the compile fails are
caused by two problems.
--bud
2004-12-23 Bud Davis <bdavis9659@comcast.net>
PR fortran/18778
* io/transfer.c (us_read): no bytes available is not a
runtime error.
* io/endfile.c (st_endfile): open the unit if needed.
Index: gcc/libgfortran/io/endfile.c
===================================================================
RCS file: /cvs/gcc/gcc/libgfortran/io/endfile.c,v
retrieving revision 1.5
diff -c -3 -p -r1.5 endfile.c
*** gcc/libgfortran/io/endfile.c 12 Dec 2004 08:59:04 -0000 1.5
--- gcc/libgfortran/io/endfile.c 24 Dec 2004 03:23:05 -0000
*************** void
*** 31,50 ****
st_endfile (void)
{
gfc_unit *u;
library_start ();
! u = get_unit (0);
! if (u != NULL)
{
! current_unit = u; /* next_record() needs this set */
! if (u->current_record)
! next_record (1);
!
! flush(u->s);
! struncate (u->s);
! u->endfile = AFTER_ENDFILE;
}
library_end ();
}
--- 31,65 ----
st_endfile (void)
{
gfc_unit *u;
+ unit_flags u_flags;
library_start ();
! u = get_unit (ioparm.unit);
! if (u == NULL)
{
! /* endfile without an open on this unit.
! not an error, so let's make a unit
! */
! memset (&u_flags, '\0', sizeof (u_flags));
! u_flags.access = ACCESS_SEQUENTIAL;
! u_flags.action = ACTION_READWRITE;
! u_flags.form = FORM_UNFORMATTED;
! u_flags.delim = DELIM_UNSPECIFIED;
! u_flags.blank = BLANK_UNSPECIFIED;
! u_flags.pad = PAD_UNSPECIFIED;
! u_flags.status = STATUS_UNKNOWN;
! new_unit(&u_flags);
! u = get_unit (ioparm.unit);
}
+ current_unit = u; /* next_record() needs this set */
+ if (u->current_record)
+ next_record (1);
+
+ flush(u->s);
+ struncate (u->s);
+ u->endfile = AFTER_ENDFILE;
+
library_end ();
}
Index: gcc/libgfortran/io/transfer.c
===================================================================
RCS file: /cvs/gcc/gcc/libgfortran/io/transfer.c,v
retrieving revision 1.23
diff -c -3 -p -r1.23 transfer.c
*** gcc/libgfortran/io/transfer.c 24 Dec 2004 00:29:07 -0000 1.23
--- gcc/libgfortran/io/transfer.c 24 Dec 2004 03:23:05 -0000
*************** us_read (void)
*** 834,839 ****
--- 834,842 ----
n = sizeof (gfc_offset);
p = salloc_r (current_unit->s, &n);
+ if (n == 0)
+ return; /* end of file */
+
if (p == NULL || n != sizeof (gfc_offset))
{
generate_error (ERROR_BAD_US, NULL);
! pr18778 abort on endfile without opening unit
program test
implicit none
integer i
endfile(8)
rewind(8)
read(8,end=0023)i
call abort ! should never get here
stop
0023 continue
end