FreeChainXenon/gcc
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

re PR libfortran/19314 (inquire(position=) segfaults at runtime)

Browse source 
2004-01-22  Bud Davis  <bdavis9659@comcast.net>

        PR fortran/19314
        * io/inquire.c(inquire_via_unit): implement POSITION=.
        * io/transfer.c(next_record): update position for
        INQUIRE.
        * io/rewind.c(st_rewind): update position for
        INQUIRE.

        * gfortran.dg/inquire_5.f90: New test.

From-SVN: r94060
This commit is contained in:
Bud Davis 2005-01-22 03:51:12 +00:00 • committed by Bud Davis
parent 987732e0c8
commit b1a807057e
6 changed files with 74 additions and 6 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

5
gcc/testsuite/ChangeLog
View file

@ -1,3 +1,8 @@
2005-01-22 Bud Davis <bdavis9659@comcast.net>
PR fortran/19314
* gfortran.dg/inquire_5.f90: New test.
2005-01-22 Volker Reichelt <reichelt@igpm.rwth-aachen.de>
PR c/18809

35
gcc/testsuite/gfortran.dg/inquire_5.f90 Normal file
View file

@ -0,0 +1,35 @@
! { dg-do run }
! pr19314 inquire(..position=..) segfaults
! test by Thomas.Koenig@online.de
! bdavis9659@comcast.net
implicit none
character*20 chr
open(7,STATUS='SCRATCH')
inquire(7,position=chr)
if (chr.NE.'ASIS') CALL ABORT
close(7)
open(7,STATUS='SCRATCH',ACCESS='DIRECT',RECL=100)
inquire(7,position=chr)
if (chr.NE.'UNDEFINED') CALL ABORT
close(7)
open(7,STATUS='SCRATCH',POSITION='REWIND')
inquire(7,position=chr)
if (chr.NE.'REWIND') CALL ABORT
close(7)
open(7,STATUS='SCRATCH',POSITION='ASIS')
inquire(7,position=chr)
if (chr.NE.'ASIS') CALL ABORT
close(7)
open(7,STATUS='SCRATCH',POSITION='APPEND')
inquire(7,position=chr)
if (chr.NE.'APPEND') CALL ABORT
close(7)
open(7,STATUS='SCRATCH',POSITION='REWIND')
write(7,*)'this is a record written to the file'
inquire(7,position=chr)
if (chr.NE.'ASIS') CALL ABORT
rewind(7)
inquire(7,position=chr)
if (chr.NE.'REWIND') CALL ABORT
close(7)
end

9
libgfortran/ChangeLog
View file

@ -1,3 +1,12 @@
2004-01-22 Bud Davis <bdavis9659@comcast.net>
PR fortran/19314
* io/inquire.c(inquire_via_unit): implement POSITION=.
* io/transfer.c(next_record): update position for
INQUIRE.
* io/rewind.c(st_rewind): update position for
INQUIRE.
2004-01-16 Bud Davis <bdavis9659@comcast.net>
PR fortran/18778

26
libgfortran/io/inquire.c
View file

@ -166,13 +166,27 @@ inquire_via_unit (gfc_unit * u)
if (ioparm.position != NULL)
{
if (u == NULL || u->flags.access == ACCESS_DIRECT)
p = undefined;
p = undefined;
else
{
p = NULL; /* TODO: Try to decode what the standard says... */
}
cf_strcpy (ioparm.blank, ioparm.blank_len, p);
switch (u->flags.position)
{
case POSITION_REWIND:
p = "REWIND";
break;
case POSITION_APPEND:
p = "APPEND";
break;
case POSITION_ASIS:
p = "ASIS";
break;
default:
/* if not direct access, it must be
either REWIND, APPEND, or ASIS.
ASIS seems to be the best default */
p = "ASIS";
break;
}
cf_strcpy (ioparm.position, ioparm.position_len, p);
}
if (ioparm.action != NULL)

2
libgfortran/io/rewind.c
View file

@ -66,6 +66,8 @@ st_rewind (void)
u->current_record = 0;
test_endfile (u);
}
/* update position for INQUIRE */
u->flags.position = POSITION_REWIND;
}
library_end ();

3
libgfortran/io/transfer.c
View file

@ -1363,6 +1363,9 @@ next_record (int done)
else
next_record_w (done);
/* keep position up to date for INQUIRE */
current_unit->flags.position = POSITION_ASIS;
current_unit->current_record = 0;
if (current_unit->flags.access == ACCESS_DIRECT)
{