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.
git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@102835
138bc75d-0d04-0410-961f-
82ee72b054a4
+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.
case EXEC_REWIND:
gfc_status ("REWIND");
+ goto show_filepos;
+
+ case EXEC_FLUSH:
+ gfc_status ("FLUSH");
show_filepos:
fp = c->ext.filepos;
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;
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;
}
-/* 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)
/* 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)
}
-/* 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)
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 *********************/
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)
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);
break;
case 'f':
+ match ("flush", gfc_match_flush, ST_FLUSH);
match ("format", gfc_match_format, ST_FORMAT);
break;
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. */
case ST_EXIT:
p = "EXIT";
break;
+ case ST_FLUSH:
+ p = "FLUSH";
+ break;
case ST_FORALL_BLOCK: /* Fall through */
case ST_FORALL:
p = "FORALL";
case EXEC_BACKSPACE:
case EXEC_ENDFILE:
case EXEC_REWIND:
+ case EXEC_FLUSH:
if (gfc_resolve_filepos (code->ext.filepos) == FAILURE)
break;
case EXEC_BACKSPACE:
case EXEC_ENDFILE:
case EXEC_REWIND:
+ case EXEC_FLUSH:
gfc_free_filepos (p->ext.filepos);
break;
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;
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 =
}
+/* 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
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);
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 *);
res = gfc_trans_select (code);
break;
+ case EXEC_FLUSH:
+ res = gfc_trans_flush (code);
+ break;
+
case EXEC_FORALL:
res = gfc_trans_forall (code);
break;
+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
--- /dev/null
+! { 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
+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.
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 \
$(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 \
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 \
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
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