mirrors/gcc
0
0
Fork 0
mirror of https://gcc.gnu.org/git/gcc.git synced 2025-01-27 06:44:12 +08:00
Code Issues Actions Packages Projects Releases Wiki Activity

re PR libfortran/31532 (INQUIRE(...,POSITION=...) not standard conforming)

Browse Source 
2007-04-27  Jerry DeLisle  <jvdelisle@gcc.gnu.org>

	PR libfortran/31532
	* io/file_pos.c (st_backspace): Set flags.position for end of file
	condition and use new function update_position.
	(st_endfile): Use new function update_position.
	* io/io.h: Add prototype for new function.
	* io/inquire.c (inquire_via_unit): If not direct access, set NEXTREC
	to zero.
	* io/unit.c (update_position): New function to update position info
	used by inquire.
	* io/transfer.c (next_record): Fix typo and use new function.

From-SVN: r124252
This commit is contained in:
Jerry DeLisle 2007-04-28 02:03:21 +00:00
parent a6ee54a636
commit 16d962d92c
6 changed files with 48 additions and 4 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

13
libgfortran/ChangeLog
View File

@ -1,3 +1,16 @@
2007-04-27 Jerry DeLisle <jvdelisle@gcc.gnu.org>
PR libfortran/31532
* io/file_pos.c (st_backspace): Set flags.position for end of file
condition and use new function update_position.
(st_endfile): Use new function update_position.
* io/io.h: Add prototype for new function.
* io/inquire.c (inquire_via_unit): If not direct access, set NEXTREC
to zero.
* io/unit.c (update_position): New function to update position info
used by inquire.
* io/transfer.c (next_record): Fix typo and use new function.
2007-04-25 Francois-Xavier Coudert <fxcoudert@gcc.gnu.org>
PR libfortran/31299

8
libgfortran/io/file_pos.c
View File

@ -213,13 +213,17 @@ st_backspace (st_parameter_filepos *fpp)
if (u->endfile == AFTER_ENDFILE)
{
u->endfile = AT_ENDFILE;
u->flags.position = POSITION_APPEND;
flush (u->s);
struncate (u->s);
}
else
{
if (file_position (u->s) == 0)
goto done; /* Common special case */
{
u->flags.position = POSITION_REWIND;
goto done; /* Common special case */
}
if (u->mode == WRITING)
{
@ -233,6 +237,7 @@ st_backspace (st_parameter_filepos *fpp)
else
unformatted_backspace (fpp, u);
update_position (u);
u->endfile = NO_ENDFILE;
u->current_record = 0;
u->bytes_left = 0;
@ -271,6 +276,7 @@ st_endfile (st_parameter_filepos *fpp)
flush (u->s);
struncate (u->s);
u->endfile = AFTER_ENDFILE;
update_position (u);
unlock_unit (u);
}

8
libgfortran/io/inquire.c
View File

@ -152,7 +152,13 @@ inquire_via_unit (st_parameter_inquire *iqp, gfc_unit * u)
*iqp->strm_pos_out = (u != NULL) ? u->strm_pos : 0;
if ((cf & IOPARM_INQUIRE_HAS_NEXTREC) != 0)
*iqp->nextrec = (u != NULL) ? u->last_record + 1 : 0;
{
/* This only makes sense in the context of DIRECT access. */
if (u != NULL && u->flags.access == ACCESS_DIRECT)
*iqp->nextrec = u->last_record + 1;
else
*iqp->nextrec = 0;
}
if ((cf & IOPARM_INQUIRE_HAS_BLANK) != 0)
{

3
libgfortran/io/io.h
View File

@ -693,6 +693,9 @@ internal_proto(get_unit);
extern void unlock_unit (gfc_unit *);
internal_proto(unlock_unit);
extern void update_position (gfc_unit *);
internal_proto(update_position);
/* open.c */
extern gfc_unit *new_unit (st_parameter_open *, gfc_unit *, unit_flags *);

6
libgfortran/io/transfer.c
View File

@ -2546,8 +2546,10 @@ next_record (st_parameter_dt *dtp, int done)
if (!is_stream_io (dtp))
{
/* keep position up to date for INQUIRE */
dtp->u.p.current_unit->flags.position = POSITION_ASIS;
/* Keep position up to date for INQUIRE */
if (done)
update_position (dtp->u.p.current_unit);
dtp->u.p.current_unit->current_record = 0;
if (dtp->u.p.current_unit->flags.access == ACCESS_DIRECT)
{

14
libgfortran/io/unit.c
View File

@ -678,3 +678,17 @@ close_units (void)
close_unit_1 (unit_root, 1);
__gthread_mutex_unlock (&unit_lock);
}
/* update_position()-- Update the flags position for later use by inquire. */
void
update_position (gfc_unit *u)
{
if (file_position (u->s) == 0)
u->flags.position = POSITION_REWIND;
else if (file_length (u->s) == file_position (u->s))
u->flags.position = POSITION_APPEND;
else
u->flags.position = POSITION_ASIS;
}