OSDN Git Service

2005-08-07 Janne Blomqvist <jblomqvi@cc.hut.fi>
authorkargl <kargl@138bc75d-0d04-0410-961f-82ee72b054a4>
Sun, 7 Aug 2005 22:56:19 +0000 (22:56 +0000)
committerkargl <kargl@138bc75d-0d04-0410-961f-82ee72b054a4>
Sun, 7 Aug 2005 22:56:19 +0000 (22:56 +0000)
        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

17 files changed:
gcc/fortran/ChangeLog
gcc/fortran/dump-parse-tree.c
gcc/fortran/gfortran.h
gcc/fortran/io.c
gcc/fortran/match.c
gcc/fortran/match.h
gcc/fortran/parse.c
gcc/fortran/resolve.c
gcc/fortran/st.c
gcc/fortran/trans-io.c
gcc/fortran/trans-stmt.h
gcc/fortran/trans.c
gcc/testsuite/ChangeLog
gcc/testsuite/gfortran.dg/flush_1.f90 [new file with mode: 0644]
libgfortran/ChangeLog
libgfortran/Makefile.am
libgfortran/Makefile.in

index 6c5eb5c..f3384c0 100644 (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.
index 2968c6c..8f039d2 100644 (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;
index dea08c3..83e71c4 100644 (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;
 
index abfeead..78899aa 100644 (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 *********************/
 
index 22a0263..87737fc 100644 (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)
index 58d0828..e8f8b8b 100644 (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);
index 24e5c99..2894e50 100644 (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";
index d0fa4d9..d855a7f 100644 (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;
 
index 8b2476a..dc0a01e 100644 (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;
 
index 2af6eb3..b25e80a 100644 (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);
 
index 520ddee..c1e5513 100644 (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 *);
index 1ff4ef2..0ee8459 100644 (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;
index 5ed686f..42a216a 100644 (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
diff --git a/gcc/testsuite/gfortran.dg/flush_1.f90 b/gcc/testsuite/gfortran.dg/flush_1.f90
new file mode 100644 (file)
index 0000000..51b7fa0
--- /dev/null
@@ -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
index cff23fa..aed0280 100644 (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.
index e13aaa5..9d6af64 100644 (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 \
index 86bd9d7..15aa5e3 100644 (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