[patch, fortran/libgfortran] Fix PR22390 (FLUSH statement)
Janne Blomqvist
jblomqvi@cc.hut.fi
Mon Jul 18 06:56:00 GMT 2005
On Sat, Jul 16, 2005 at 09:02:02AM -0700, Steve Kargl wrote:
> Janne,
>
> Can you create a new patch? I tried to apply the flush.patch
> to my tree and get
Ah, sorry. I think my tree was slighlty messed up due to unrelated
diagnostics stuff. Attached is a patch generated against a clean
tree. I won't waste bandwidth with file_pos.c and flush_1.f90 as they
haven't changed since my previous message. Also, Tobis formatting
remarks have been corrected.
--
Janne Blomqvist
-------------- next part --------------
gcc/fortran ChangeLog
2005-07-18 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): Modify comment
appropriately. (match_file_element, match_filepos):
Likewise. (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.
libgfortran ChangeLog
2005-07-18 Janne Blomqvist <jblomqvi@cc.hut.fi>
PR fortran/22390
* io/file_pos.c: New file, containing code for backspace, endfile,
rewind and flush.
* io/backspace.c: File removed, contents moved to io/file_pos.c.
* io/endfile.c: File removed, contents moved to io/file_pos.c.
* io/rewind.c: File removed, contents moved to io/file_pos.c.
* Makefile.am: Add file_pos.c to list, remove obsolete files.
-------------- next part --------------
Index: dump-parse-tree.c
===================================================================
RCS file: /cvsroot/gcc/gcc/gcc/fortran/dump-parse-tree.c,v
retrieving revision 1.18
diff -u -p -r1.18 dump-parse-tree.c
--- dump-parse-tree.c 25 Jun 2005 00:40:34 -0000 1.18
+++ dump-parse-tree.c 18 Jul 2005 06:26:04 -0000
@@ -1177,6 +1177,10 @@ gfc_show_code_node (int level, gfc_code
case EXEC_REWIND:
gfc_status ("REWIND");
+ goto show_filepos;
+
+ case EXEC_FLUSH:
+ gfc_status ("FLUSH");
show_filepos:
fp = c->ext.filepos;
Index: gfortran.h
===================================================================
RCS file: /cvsroot/gcc/gcc/gcc/fortran/gfortran.h,v
retrieving revision 1.76
diff -u -p -r1.76 gfortran.h
--- gfortran.h 14 Jul 2005 10:12:16 -0000 1.76
+++ gfortran.h 18 Jul 2005 06:26:06 -0000
@@ -192,7 +192,7 @@ 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_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,
@@ -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;
Index: io.c
===================================================================
RCS file: /cvsroot/gcc/gcc/gcc/fortran/io.c,v
retrieving revision 1.28
diff -u -p -r1.28 io.c
--- io.c 7 Jul 2005 07:54:42 -0000 1.28
+++ io.c 18 Jul 2005 06:26:08 -0000
@@ -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 *********************/
Index: match.c
===================================================================
RCS file: /cvsroot/gcc/gcc/gcc/fortran/match.c,v
retrieving revision 1.41
diff -u -p -r1.41 match.c
--- match.c 14 Jul 2005 10:12:15 -0000 1.41
+++ match.c 18 Jul 2005 06:26:11 -0000
@@ -1072,6 +1072,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)
Index: match.h
===================================================================
RCS file: /cvsroot/gcc/gcc/gcc/fortran/match.h,v
retrieving revision 1.13
diff -u -p -r1.13 match.h
--- match.h 25 Jun 2005 00:40:35 -0000 1.13
+++ match.h 18 Jul 2005 06:26:11 -0000
@@ -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);
Index: parse.c
===================================================================
RCS file: /cvsroot/gcc/gcc/gcc/fortran/parse.c,v
retrieving revision 1.28
diff -u -p -r1.28 parse.c
--- parse.c 25 Jun 2005 00:40:35 -0000 1.28
+++ parse.c 18 Jul 2005 06:26:14 -0000
@@ -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. */
@@ -832,6 +834,9 @@ gfc_ascii_statement (gfc_statement st)
break;
case ST_EXIT:
p = "EXIT";
+ break;
+ case ST_FLUSH:
+ p = "FLUSH";
break;
case ST_FORALL_BLOCK: /* Fall through */
case ST_FORALL:
Index: resolve.c
===================================================================
RCS file: /cvsroot/gcc/gcc/gcc/fortran/resolve.c,v
retrieving revision 1.45
diff -u -p -r1.45 resolve.c
--- resolve.c 25 Jun 2005 00:40:35 -0000 1.45
+++ resolve.c 18 Jul 2005 06:26:18 -0000
@@ -3948,6 +3948,7 @@ resolve_code (gfc_code * code, gfc_names
case EXEC_BACKSPACE:
case EXEC_ENDFILE:
case EXEC_REWIND:
+ case EXEC_FLUSH:
if (gfc_resolve_filepos (code->ext.filepos) == FAILURE)
break;
Index: st.c
===================================================================
RCS file: /cvsroot/gcc/gcc/gcc/fortran/st.c,v
retrieving revision 1.8
diff -u -p -r1.8 st.c
--- st.c 25 Jun 2005 00:40:36 -0000 1.8
+++ st.c 18 Jul 2005 06:26:19 -0000
@@ -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;
Index: trans-io.c
===================================================================
RCS file: /cvsroot/gcc/gcc/gcc/fortran/trans-io.c,v
retrieving revision 1.38
diff -u -p -r1.38 trans-io.c
--- trans-io.c 7 Jul 2005 07:54:43 -0000 1.38
+++ trans-io.c 18 Jul 2005 06:26:20 -0000
@@ -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,15 @@ 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
@@ -769,6 +784,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);
Index: trans-stmt.h
===================================================================
RCS file: /cvsroot/gcc/gcc/gcc/fortran/trans-stmt.h,v
retrieving revision 1.5
diff -u -p -r1.5 trans-stmt.h
--- trans-stmt.h 25 Jun 2005 00:40:36 -0000 1.5
+++ trans-stmt.h 18 Jul 2005 06:26:21 -0000
@@ -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 *);
Index: trans.c
===================================================================
RCS file: /cvsroot/gcc/gcc/gcc/fortran/trans.c,v
retrieving revision 1.26
diff -u -p -r1.26 trans.c
--- trans.c 25 Jun 2005 00:40:36 -0000 1.26
+++ trans.c 18 Jul 2005 06:26:21 -0000
@@ -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;
Index: Makefile.am
===================================================================
RCS file: /cvsroot/gcc/gcc/libgfortran/Makefile.am,v
retrieving revision 1.38
diff -u -p -r1.38 Makefile.am
--- Makefile.am 24 Jun 2005 23:07:13 -0000 1.38
+++ Makefile.am 18 Jul 2005 06:33:24 -0000
@@ -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 \
More information about the Fortran
mailing list