From 6c306f90a96af99319dd14db3ec40db0b6e1a5bc Mon Sep 17 00:00:00 2001 From: kargl Date: Sun, 7 Aug 2005 22:56:19 +0000 Subject: [PATCH] 2005-08-07 Janne Blomqvist 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 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 Steven G. Kargl PR fortran/22390 * gfortran.dg/flush_1.f90: New test. git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@102835 138bc75d-0d04-0410-961f-82ee72b054a4 --- gcc/fortran/ChangeLog | 19 +++++++++++++++++++ gcc/fortran/dump-parse-tree.c | 4 ++++ gcc/fortran/gfortran.h | 24 ++++++++++++------------ gcc/fortran/io.c | 16 ++++++++++++---- gcc/fortran/match.c | 1 + gcc/fortran/match.h | 1 + gcc/fortran/parse.c | 7 ++++++- gcc/fortran/resolve.c | 1 + gcc/fortran/st.c | 1 + gcc/fortran/trans-io.c | 20 ++++++++++++++++++++ gcc/fortran/trans-stmt.h | 1 + gcc/fortran/trans.c | 4 ++++ gcc/testsuite/ChangeLog | 6 ++++++ gcc/testsuite/gfortran.dg/flush_1.f90 | 28 ++++++++++++++++++++++++++++ libgfortran/ChangeLog | 10 ++++++++++ libgfortran/Makefile.am | 4 +--- libgfortran/Makefile.in | 20 ++++++-------------- 17 files changed, 133 insertions(+), 34 deletions(-) create mode 100644 gcc/testsuite/gfortran.dg/flush_1.f90 diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog index 6c5eb5c..f3384c0 100644 --- a/gcc/fortran/ChangeLog +++ b/gcc/fortran/ChangeLog @@ -1,3 +1,22 @@ +2005-08-07 Janne Blomqvist + + 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 * primary.c (match_hollerith_constant): Fix typo. diff --git a/gcc/fortran/dump-parse-tree.c b/gcc/fortran/dump-parse-tree.c index 2968c6c..8f039d2 100644 --- a/gcc/fortran/dump-parse-tree.c +++ b/gcc/fortran/dump-parse-tree.c @@ -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; diff --git a/gcc/fortran/gfortran.h b/gcc/fortran/gfortran.h index dea08c3..83e71c4 100644 --- a/gcc/fortran/gfortran.h +++ b/gcc/fortran/gfortran.h @@ -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; diff --git a/gcc/fortran/io.c b/gcc/fortran/io.c index abfeead..78899aa 100644 --- a/gcc/fortran/io.c +++ b/gcc/fortran/io.c @@ -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 *********************/ diff --git a/gcc/fortran/match.c b/gcc/fortran/match.c index 22a0263..87737fc 100644 --- a/gcc/fortran/match.c +++ b/gcc/fortran/match.c @@ -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) diff --git a/gcc/fortran/match.h b/gcc/fortran/match.h index 58d0828..e8f8b8b 100644 --- a/gcc/fortran/match.h +++ b/gcc/fortran/match.h @@ -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); diff --git a/gcc/fortran/parse.c b/gcc/fortran/parse.c index 24e5c99..2894e50 100644 --- a/gcc/fortran/parse.c +++ b/gcc/fortran/parse.c @@ -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"; diff --git a/gcc/fortran/resolve.c b/gcc/fortran/resolve.c index d0fa4d9..d855a7f 100644 --- a/gcc/fortran/resolve.c +++ b/gcc/fortran/resolve.c @@ -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; diff --git a/gcc/fortran/st.c b/gcc/fortran/st.c index 8b2476a..dc0a01e 100644 --- a/gcc/fortran/st.c +++ b/gcc/fortran/st.c @@ -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; diff --git a/gcc/fortran/trans-io.c b/gcc/fortran/trans-io.c index 2af6eb3..b25e80a 100644 --- a/gcc/fortran/trans-io.c +++ b/gcc/fortran/trans-io.c @@ -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); diff --git a/gcc/fortran/trans-stmt.h b/gcc/fortran/trans-stmt.h index 520ddee..c1e5513 100644 --- a/gcc/fortran/trans-stmt.h +++ b/gcc/fortran/trans-stmt.h @@ -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 *); diff --git a/gcc/fortran/trans.c b/gcc/fortran/trans.c index 1ff4ef2..0ee8459 100644 --- a/gcc/fortran/trans.c +++ b/gcc/fortran/trans.c @@ -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; diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog index 5ed686f..42a216a 100644 --- a/gcc/testsuite/ChangeLog +++ b/gcc/testsuite/ChangeLog @@ -1,3 +1,9 @@ +2005-08-07 Janne Blomqvist + Steven G. Kargl + + PR fortran/22390 + * gfortran.dg/flush_1.f90: New test. + 2005-08-06 Volker Reichelt PR c++/23191 diff --git a/gcc/testsuite/gfortran.dg/flush_1.f90 b/gcc/testsuite/gfortran.dg/flush_1.f90 new file mode 100644 index 0000000..51b7fa0 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/flush_1.f90 @@ -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 diff --git a/libgfortran/ChangeLog b/libgfortran/ChangeLog index cff23fab..aed0280 100644 --- a/libgfortran/ChangeLog +++ b/libgfortran/ChangeLog @@ -1,3 +1,13 @@ +2005-08-07 Janne Blomqvist + + 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 * io/io.h: Change DEFAULT_TEMPDIR to /tmp instead of /var/tmp. diff --git a/libgfortran/Makefile.am b/libgfortran/Makefile.am index e13aaa5..9d6af64 100644 --- a/libgfortran/Makefile.am +++ b/libgfortran/Makefile.am @@ -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 \ diff --git a/libgfortran/Makefile.in b/libgfortran/Makefile.in index 86bd9d7..15aa5e3 100644 --- a/libgfortran/Makefile.in +++ b/libgfortran/Makefile.in @@ -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 -- 2.7.4