[multiple changes]

2005-08-07   Janne Blomqvist <jblomqvi@cc.hut.fi>

        PR fortran/22390
        * dump-parse-tree.c (gfc_show_code_node): Add case for FLUSH.
        * gfortran.h: Add enums for FLUSH.
        * io.c (gfc_free_filepos,match_file_element,match_filepos): Modify
        comment appropriately.  (gfc_match_flush): New function.
        * match.c (gfc_match_if): Add match for flush.
        * match.h: Add prototype.
        * parse.c (decode_statement): Add flush to 'f' case.
        (next_statement): Add case for flush. (gfc_ascii_statement): Likewise.
        * resolve.c (resolve_code): Add flush case.
        * st.c (gfc_free_statement): Add flush case.
        * trans-io.c: Add prototype for flush.
        (gfc_build_io_library_fndecls): Build fndecl for flush.
        (gfc_trans_flush): New function.
        * trans-stmt.h: Add prototype.
        * trans.c (gfc_trans_code): Add case for flush.

2005-08-07  Janne Blomqvist  <jblomqvi@cc.hut.fi>

        PR fortran/22390
        * io/backspace.c: File removed, contents moved to ...
        * io/endfile.c: Ditto.
        * io/rewind.c: Ditto.
        * io/file_pos.c: New file, ... here.
        * Makefile.am: Add file_pos.c to list, remove obsolete files.
        * Makefile.in: Regenerated.

2005-08-07  Janne Blomqvist <jblomqvi@cc.hut.fi>
            Steven G. Kargl <kargls@comcast.net>

        PR fortran/22390
        * gfortran.dg/flush_1.f90: New test.

Co-Authored-By: Steven G. Kargl <kargls@comcast.net>

From-SVN: r102835
This commit is contained in:
Janne Blomqvist 2005-08-08 01:56:19 +03:00 committed by Steven G. Kargl
parent f18faab7c4
commit 6403ec5ff6
17 changed files with 133 additions and 34 deletions

View File

@ -1,3 +1,22 @@
2005-08-07 Janne Blomqvist <jblomqvi@cc.hut.fi>
PR fortran/22390
* dump-parse-tree.c (gfc_show_code_node): Add case for FLUSH.
* gfortran.h: Add enums for FLUSH.
* io.c (gfc_free_filepos,match_file_element,match_filepos): Modify
comment appropriately. (gfc_match_flush): New function.
* match.c (gfc_match_if): Add match for flush.
* match.h: Add prototype.
* parse.c (decode_statement): Add flush to 'f' case.
(next_statement): Add case for flush. (gfc_ascii_statement): Likewise.
* resolve.c (resolve_code): Add flush case.
* st.c (gfc_free_statement): Add flush case.
* trans-io.c: Add prototype for flush.
(gfc_build_io_library_fndecls): Build fndecl for flush.
(gfc_trans_flush): New function.
* trans-stmt.h: Add prototype.
* trans.c (gfc_trans_code): Add case for flush.
2005-08-06 Francois-Xavier Coudert <coudert@clipper.ens.fr>
* primary.c (match_hollerith_constant): Fix typo.

View File

@ -1177,6 +1177,10 @@ gfc_show_code_node (int level, gfc_code * c)
case EXEC_REWIND:
gfc_status ("REWIND");
goto show_filepos;
case EXEC_FLUSH:
gfc_status ("FLUSH");
show_filepos:
fp = c->ext.filepos;

View File

@ -192,17 +192,17 @@ typedef enum
ST_CALL, ST_CASE, ST_CLOSE, ST_COMMON, ST_CONTINUE, ST_CONTAINS, ST_CYCLE,
ST_DATA, ST_DATA_DECL, ST_DEALLOCATE, ST_DO, ST_ELSE, ST_ELSEIF,
ST_ELSEWHERE, ST_END_BLOCK_DATA, ST_ENDDO, ST_IMPLIED_ENDDO,
ST_END_FILE, ST_END_FORALL, ST_END_FUNCTION, ST_ENDIF, ST_END_INTERFACE,
ST_END_MODULE, ST_END_PROGRAM, ST_END_SELECT, ST_END_SUBROUTINE,
ST_END_WHERE, ST_END_TYPE, ST_ENTRY, ST_EQUIVALENCE, ST_EXIT, ST_FORALL,
ST_FORALL_BLOCK, ST_FORMAT, ST_FUNCTION, ST_GOTO, ST_IF_BLOCK, ST_IMPLICIT,
ST_IMPLICIT_NONE, ST_INQUIRE, ST_INTERFACE, ST_PARAMETER, ST_MODULE,
ST_MODULE_PROC, ST_NAMELIST, ST_NULLIFY, ST_OPEN, ST_PAUSE, ST_PRIVATE,
ST_PROGRAM, ST_PUBLIC, ST_READ, ST_RETURN, ST_REWIND, ST_STOP,
ST_SUBROUTINE,
ST_TYPE, ST_USE, ST_WHERE_BLOCK, ST_WHERE, ST_WRITE, ST_ASSIGNMENT,
ST_POINTER_ASSIGNMENT, ST_SELECT_CASE, ST_SEQUENCE, ST_SIMPLE_IF,
ST_STATEMENT_FUNCTION, ST_DERIVED_DECL, ST_LABEL_ASSIGNMENT, ST_NONE
ST_END_FILE, ST_FLUSH, ST_END_FORALL, ST_END_FUNCTION, ST_ENDIF,
ST_END_INTERFACE, ST_END_MODULE, ST_END_PROGRAM, ST_END_SELECT,
ST_END_SUBROUTINE, ST_END_WHERE, ST_END_TYPE, ST_ENTRY, ST_EQUIVALENCE,
ST_EXIT, ST_FORALL, ST_FORALL_BLOCK, ST_FORMAT, ST_FUNCTION, ST_GOTO,
ST_IF_BLOCK, ST_IMPLICIT, ST_IMPLICIT_NONE, ST_INQUIRE, ST_INTERFACE,
ST_PARAMETER, ST_MODULE, ST_MODULE_PROC, ST_NAMELIST, ST_NULLIFY, ST_OPEN,
ST_PAUSE, ST_PRIVATE, ST_PROGRAM, ST_PUBLIC, ST_READ, ST_RETURN, ST_REWIND,
ST_STOP, ST_SUBROUTINE, ST_TYPE, ST_USE, ST_WHERE_BLOCK, ST_WHERE, ST_WRITE,
ST_ASSIGNMENT, ST_POINTER_ASSIGNMENT, ST_SELECT_CASE, ST_SEQUENCE,
ST_SIMPLE_IF, ST_STATEMENT_FUNCTION, ST_DERIVED_DECL, ST_LABEL_ASSIGNMENT,
ST_NONE
}
gfc_statement;
@ -1325,7 +1325,7 @@ typedef enum
EXEC_ALLOCATE, EXEC_DEALLOCATE,
EXEC_OPEN, EXEC_CLOSE,
EXEC_READ, EXEC_WRITE, EXEC_IOLENGTH, EXEC_TRANSFER, EXEC_DT_END,
EXEC_BACKSPACE, EXEC_ENDFILE, EXEC_INQUIRE, EXEC_REWIND
EXEC_BACKSPACE, EXEC_ENDFILE, EXEC_INQUIRE, EXEC_REWIND, EXEC_FLUSH
}
gfc_exec_op;

View File

@ -1340,7 +1340,7 @@ gfc_free_filepos (gfc_filepos * fp)
}
/* Match elements of a REWIND, BACKSPACE or ENDFILE statement. */
/* Match elements of a REWIND, BACKSPACE, ENDFILE, or FLUSH statement. */
static match
match_file_element (gfc_filepos * fp)
@ -1362,7 +1362,7 @@ match_file_element (gfc_filepos * fp)
/* Match the second half of the file-positioning statements, REWIND,
BACKSPACE or ENDFILE. */
BACKSPACE, ENDFILE, or the FLUSH statement. */
static match
match_filepos (gfc_statement st, gfc_exec_op op)
@ -1446,8 +1446,8 @@ gfc_resolve_filepos (gfc_filepos * fp)
}
/* Match the file positioning statements: ENDFILE, BACKSPACE or
REWIND. */
/* Match the file positioning statements: ENDFILE, BACKSPACE, REWIND,
and the FLUSH statement. */
match
gfc_match_endfile (void)
@ -1470,6 +1470,14 @@ gfc_match_rewind (void)
return match_filepos (ST_REWIND, EXEC_REWIND);
}
match
gfc_match_flush (void)
{
if (gfc_notify_std (GFC_STD_F2003, "Fortran 2003: FLUSH statement at %C") == FAILURE)
return MATCH_ERROR;
return match_filepos (ST_FLUSH, EXEC_FLUSH);
}
/******************** Data Transfer Statements *********************/

View File

@ -1074,6 +1074,7 @@ gfc_match_if (gfc_statement * if_type)
match ("deallocate", gfc_match_deallocate, ST_DEALLOCATE)
match ("end file", gfc_match_endfile, ST_END_FILE)
match ("exit", gfc_match_exit, ST_EXIT)
match ("flush", gfc_match_flush, ST_FLUSH)
match ("forall", match_simple_forall, ST_FORALL)
match ("go to", gfc_match_goto, ST_GOTO)
match ("if", match_arithmetic_if, ST_ARITHMETIC_IF)

View File

@ -154,6 +154,7 @@ match gfc_match_close (void);
match gfc_match_endfile (void);
match gfc_match_backspace (void);
match gfc_match_rewind (void);
match gfc_match_flush (void);
match gfc_match_inquire (void);
match gfc_match_read (void);
match gfc_match_write (void);

View File

@ -212,6 +212,7 @@ decode_statement (void)
break;
case 'f':
match ("flush", gfc_match_flush, ST_FLUSH);
match ("format", gfc_match_format, ST_FORMAT);
break;
@ -526,7 +527,8 @@ next_statement (void)
case ST_READ: case ST_RETURN: case ST_REWIND: case ST_SIMPLE_IF: \
case ST_PAUSE: case ST_STOP: case ST_WRITE: case ST_ASSIGNMENT: \
case ST_POINTER_ASSIGNMENT: case ST_EXIT: case ST_CYCLE: \
case ST_ARITHMETIC_IF: case ST_WHERE: case ST_FORALL: case ST_LABEL_ASSIGNMENT
case ST_ARITHMETIC_IF: case ST_WHERE: case ST_FORALL: \
case ST_LABEL_ASSIGNMENT: case ST_FLUSH
/* Statements that mark other executable statements. */
@ -833,6 +835,9 @@ gfc_ascii_statement (gfc_statement st)
case ST_EXIT:
p = "EXIT";
break;
case ST_FLUSH:
p = "FLUSH";
break;
case ST_FORALL_BLOCK: /* Fall through */
case ST_FORALL:
p = "FORALL";

View File

@ -3953,6 +3953,7 @@ resolve_code (gfc_code * code, gfc_namespace * ns)
case EXEC_BACKSPACE:
case EXEC_ENDFILE:
case EXEC_REWIND:
case EXEC_FLUSH:
if (gfc_resolve_filepos (code->ext.filepos) == FAILURE)
break;

View File

@ -139,6 +139,7 @@ gfc_free_statement (gfc_code * p)
case EXEC_BACKSPACE:
case EXEC_ENDFILE:
case EXEC_REWIND:
case EXEC_FLUSH:
gfc_free_filepos (p->ext.filepos);
break;

View File

@ -125,6 +125,7 @@ static GTY(()) tree iocall_iolength_done;
static GTY(()) tree iocall_rewind;
static GTY(()) tree iocall_backspace;
static GTY(()) tree iocall_endfile;
static GTY(()) tree iocall_flush;
static GTY(()) tree iocall_set_nml_val;
static GTY(()) tree iocall_set_nml_val_dim;
@ -297,6 +298,11 @@ gfc_build_io_library_fndecls (void)
iocall_endfile =
gfc_build_library_function_decl (get_identifier (PREFIX("st_endfile")),
gfc_int4_type_node, 0);
iocall_flush =
gfc_build_library_function_decl (get_identifier (PREFIX("st_flush")),
gfc_int4_type_node, 0);
/* Library helpers */
iocall_read_done =
@ -755,6 +761,16 @@ gfc_trans_rewind (gfc_code * code)
}
/* Translate a FLUSH statement. */
tree
gfc_trans_flush (gfc_code * code)
{
return build_filepos (iocall_flush, code);
}
/* Translate the non-IOLENGTH form of an INQUIRE statement. */
tree
@ -770,6 +786,10 @@ gfc_trans_inquire (gfc_code * code)
set_error_locus (&block, &code->loc);
p = code->ext.inquire;
/* Sanity check. */
if (p->unit && p->file)
gfc_error ("INQUIRE statement at %L cannot contain both FILE and UNIT specifiers.", &code->loc);
if (p->unit)
set_parameter_value (&block, ioparm_unit, p->unit);

View File

@ -61,6 +61,7 @@ tree gfc_trans_backspace (gfc_code *);
tree gfc_trans_endfile (gfc_code *);
tree gfc_trans_inquire (gfc_code *);
tree gfc_trans_rewind (gfc_code *);
tree gfc_trans_flush (gfc_code *);
tree gfc_trans_transfer (gfc_code *);
tree gfc_trans_dt_end (gfc_code *);

View File

@ -557,6 +557,10 @@ gfc_trans_code (gfc_code * code)
res = gfc_trans_select (code);
break;
case EXEC_FLUSH:
res = gfc_trans_flush (code);
break;
case EXEC_FORALL:
res = gfc_trans_forall (code);
break;

View File

@ -1,3 +1,9 @@
2005-08-07 Janne Blomqvist <jblomqvi@cc.hut.fi>
Steven G. Kargl <kargls@comcast.net>
PR fortran/22390
* gfortran.dg/flush_1.f90: New test.
2005-08-06 Volker Reichelt <reichelt@igpm.rwth-aachen.de>
PR c++/23191

View File

@ -0,0 +1,28 @@
! { dg-do run }
! PR 22390 Implement flush statement
program flush_1
character(len=256) msg
integer ios
open (unit=10, access='SEQUENTIAL', status='SCRATCH')
write (10, *) 42
flush 10 ! { dg-warning "Fortran 2003: FLUSH statement" }
write (10, *) 42
flush(10) ! { dg-warning "Fortran 2003: FLUSH statement" }
write (10, *) 42
flush(unit=10, iostat=ios) ! { dg-warning "Fortran 2003: FLUSH statement" }
if (ios /= 0) call abort
write (10, *) 42
flush (unit=10, err=20) ! { dg-warning "Fortran 2003: FLUSH statement" }
goto 30
20 call abort
30 continue
call flush(10)
end program flush_1

View File

@ -1,3 +1,13 @@
2005-08-07 Janne Blomqvist <jblomqvi@cc.hut.fi>
PR fortran/22390
* io/backspace.c: File removed, contents moved to ...
* io/endfile.c: Ditto.
* io/rewind.c: Ditto.
* io/file_pos.c: New file, ... here.
* Makefile.am: Add file_pos.c to list, remove obsolete files.
* Makefile.in: Regenerated.
2005-08-07 Francois-Xavier Coudert <coudert@clipper.ens.fr>
* io/io.h: Change DEFAULT_TEMPDIR to /tmp instead of /var/tmp.

View File

@ -21,16 +21,14 @@ AM_CPPFLAGS = -iquote$(srcdir)/io
libgfortranincludedir = $(includedir)/gforio
gfor_io_src= \
io/backspace.c \
io/close.c \
io/endfile.c \
io/file_pos.c \
io/format.c \
io/inquire.c \
io/list_read.c \
io/lock.c \
io/open.c \
io/read.c \
io/rewind.c \
io/transfer.c \
io/unit.c \
io/unix.c \

View File

@ -127,9 +127,9 @@ am__objects_31 = $(am__objects_2) $(am__objects_3) $(am__objects_4) \
$(am__objects_23) $(am__objects_24) $(am__objects_25) \
$(am__objects_26) $(am__objects_27) $(am__objects_28) \
$(am__objects_29) $(am__objects_30)
am__objects_32 = backspace.lo close.lo endfile.lo format.lo inquire.lo \
list_read.lo lock.lo open.lo read.lo rewind.lo transfer.lo \
unit.lo unix.lo write.lo
am__objects_32 = close.lo file_pos.lo format.lo inquire.lo \
list_read.lo lock.lo open.lo read.lo transfer.lo unit.lo \
unix.lo write.lo
am__objects_33 = associated.lo abort.lo args.lo bessel.lo \
c99_functions.lo chdir.lo cpu_time.lo cshift0.lo \
date_and_time.lo env.lo erf.lo eoshift0.lo eoshift2.lo \
@ -315,16 +315,14 @@ libgfortranbegin_la_LDFLAGS = -static
AM_CPPFLAGS = -iquote$(srcdir)/io
libgfortranincludedir = $(includedir)/gforio
gfor_io_src = \
io/backspace.c \
io/close.c \
io/endfile.c \
io/file_pos.c \
io/format.c \
io/inquire.c \
io/list_read.c \
io/lock.c \
io/open.c \
io/read.c \
io/rewind.c \
io/transfer.c \
io/unit.c \
io/unix.c \
@ -1216,14 +1214,11 @@ pow_c4_i8.lo: generated/pow_c4_i8.c
pow_c8_i8.lo: generated/pow_c8_i8.c
$(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o pow_c8_i8.lo `test -f 'generated/pow_c8_i8.c' || echo '$(srcdir)/'`generated/pow_c8_i8.c
backspace.lo: io/backspace.c
$(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o backspace.lo `test -f 'io/backspace.c' || echo '$(srcdir)/'`io/backspace.c
close.lo: io/close.c
$(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o close.lo `test -f 'io/close.c' || echo '$(srcdir)/'`io/close.c
endfile.lo: io/endfile.c
$(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o endfile.lo `test -f 'io/endfile.c' || echo '$(srcdir)/'`io/endfile.c
file_pos.lo: io/file_pos.c
$(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o file_pos.lo `test -f 'io/file_pos.c' || echo '$(srcdir)/'`io/file_pos.c
format.lo: io/format.c
$(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o format.lo `test -f 'io/format.c' || echo '$(srcdir)/'`io/format.c
@ -1243,9 +1238,6 @@ open.lo: io/open.c
read.lo: io/read.c
$(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o read.lo `test -f 'io/read.c' || echo '$(srcdir)/'`io/read.c
rewind.lo: io/rewind.c
$(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o rewind.lo `test -f 'io/rewind.c' || echo '$(srcdir)/'`io/rewind.c
transfer.lo: io/transfer.c
$(LIBTOOL) --mode=compile $(CC) $(DEFS) $(DEFAULT_INCLUDES) $(INCLUDES) $(AM_CPPFLAGS) $(CPPFLAGS) $(AM_CFLAGS) $(CFLAGS) -c -o transfer.lo `test -f 'io/transfer.c' || echo '$(srcdir)/'`io/transfer.c