re PR fortran/38291 (Rejects I/O with POS= if FMT=*)

2008-12-05  Jerry DeLisle  <jvdelisle@gcc.gnu.org>

	PR fortran/38291
	* io.c (match_dt_element): Use dt->pos in matcher.
	(gfc_free_dt): Free dt->pos after use.
	(gfc_resolve_dt): Use dt->pos in resolution of stream position tag.

2008-12-05  Jerry DeLisle  <jvdelisle@gcc.gnu.org>

	PR libfortran/38291
	* io/transfer.c (data_transfer_init): Add checks for POS= valid range.
	Add check for unit opened with ACCESS="stream". Flush and seek if
	current stream position does not match. Check ENDFILE on read.

From-SVN: r142515

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index f17cbac..5cdbb23 100644 (file)
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -1,3 +1,10 @@
+2008-12-05  Jerry DeLisle  <jvdelisle@gcc.gnu.org>
+
+       PR fortran/38291
+       * io.c (match_dt_element): Use dt->pos in matcher.
+       (gfc_free_dt): Free dt->pos after use.
+       (gfc_resolve_dt): Use dt->pos in resolution of stream position tag.
+
 2008-12-05  Sebastian Pop  <sebastian.pop@amd.com>
 
        PR bootstrap/38262

diff --git a/gcc/fortran/io.c b/gcc/fortran/io.c
index 85b712f..97f304b 100644 (file)
--- a/gcc/fortran/io.c
+++ b/gcc/fortran/io.c
@@ -2412,7 +2412,7 @@ match_dt_element (io_kind k, gfc_dt *dt)
   m = match_etag (&tag_rec, &dt->rec);
   if (m != MATCH_NO)
     return m;
-  m = match_etag (&tag_spos, &dt->rec);
+  m = match_etag (&tag_spos, &dt->pos);
   if (m != MATCH_NO)
     return m;
   m = match_out_tag (&tag_iomsg, &dt->iomsg);
@@ -2478,6 +2478,7 @@ gfc_free_dt (gfc_dt *dt)
   gfc_free_expr (dt->blank);
   gfc_free_expr (dt->decimal);
   gfc_free_expr (dt->extra_comma);
+  gfc_free_expr (dt->pos);
   gfc_free (dt);
 }
 
@@ -2491,7 +2492,7 @@ gfc_resolve_dt (gfc_dt *dt)
 
   RESOLVE_TAG (&tag_format, dt->format_expr);
   RESOLVE_TAG (&tag_rec, dt->rec);
-  RESOLVE_TAG (&tag_spos, dt->rec);
+  RESOLVE_TAG (&tag_spos, dt->pos);
   RESOLVE_TAG (&tag_advance, dt->advance);
   RESOLVE_TAG (&tag_id, dt->id);
   RESOLVE_TAG (&tag_iomsg, dt->iomsg);

diff --git a/libgfortran/ChangeLog b/libgfortran/ChangeLog
index bb860d4..7aba026 100644 (file)
--- a/libgfortran/ChangeLog
+++ b/libgfortran/ChangeLog
@@ -1,3 +1,10 @@
+2008-12-05  Jerry DeLisle  <jvdelisle@gcc.gnu.org>
+
+       PR libfortran/38291
+       * io/transfer.c (data_transfer_init): Add checks for POS= valid range.
+       Add check for unit opened with ACCESS="stream". Flush and seek if
+       current stream position does not match. Check ENDFILE on read.
+
 2008-12-04  Jerry DeLisle  <jvdelisle@gcc.gnu.org>
 
        PR fortran/38285

diff --git a/libgfortran/io/transfer.c b/libgfortran/io/transfer.c
index c4fae32..4ddfd9f 100644 (file)
--- a/libgfortran/io/transfer.c
+++ b/libgfortran/io/transfer.c
@@ -2116,6 +2116,62 @@ data_transfer_init (st_parameter_dt *dtp, int read_flag)
   
   if (dtp->u.p.current_unit->pad_status == PAD_UNSPECIFIED)
        dtp->u.p.current_unit->pad_status = dtp->u.p.current_unit->flags.pad;
+  
+  /* Check the POS= specifier: that it is in range and that it is used with a
+     unit that has been connected for STREAM access. F2003 9.5.1.10.  */
+  
+  if (((cf & IOPARM_DT_HAS_POS) != 0))
+    {
+      if (is_stream_io (dtp))
+       {
+
+         if (dtp->pos <= 0)
+           {
+             generate_error (&dtp->common, LIBERROR_BAD_OPTION,
+                             "POS=specifier must be positive");
+             return;
+           }
+
+         if (dtp->rec >= dtp->u.p.current_unit->maxrec)
+           {
+             generate_error (&dtp->common, LIBERROR_BAD_OPTION,
+                             "POS=specifier too large");
+             return;
+           }
+
+         dtp->rec = dtp->pos;
+
+         if (dtp->u.p.mode == READING)
+           {
+             /* Required for compatibility between 4.3 and 4.4 runtime. Check
+             to see if we might be reading what we wrote before  */
+             if (dtp->u.p.current_unit->mode == WRITING)
+               flush(dtp->u.p.current_unit->s);
+
+             if (dtp->pos < file_length (dtp->u.p.current_unit->s))
+               dtp->u.p.current_unit->endfile = NO_ENDFILE;
+           }
+
+         if (dtp->pos != dtp->u.p.current_unit->strm_pos)
+           {
+             fbuf_flush (dtp->u.p.current_unit, 1);
+             flush (dtp->u.p.current_unit->s);
+             if (sseek (dtp->u.p.current_unit->s, dtp->pos - 1) == FAILURE)
+               {
+                 generate_error (&dtp->common, LIBERROR_OS, NULL);
+                 return;
+               }
+             dtp->u.p.current_unit->strm_pos = dtp->pos;
+           }
+       }
+      else
+       {
+         generate_error (&dtp->common, LIBERROR_BAD_OPTION,
+                         "POS=specifier not allowed, "
+                         "Try OPEN with ACCESS='stream'");
+         return;
+       }
+    }
 
   /* Sanity checks on the record number.  */
   if ((cf & IOPARM_DT_HAS_REC) != 0)
@@ -2139,10 +2195,10 @@ data_transfer_init (st_parameter_dt *dtp, int read_flag)
       if (dtp->u.p.mode == READING
          && dtp->u.p.current_unit->mode == WRITING
          && !is_internal_unit (dtp))
-        {
-          fbuf_flush (dtp->u.p.current_unit, 1);      
+       {
+         fbuf_flush (dtp->u.p.current_unit, 1);      
          flush(dtp->u.p.current_unit->s);
-        }
+       }
 
       /* Check whether the record exists to be read.  Only
         a partial record needs to exist.  */
@@ -2156,29 +2212,17 @@ data_transfer_init (st_parameter_dt *dtp, int read_flag)
        }
 
       /* Position the file.  */
-      if (!is_stream_io (dtp))
+      if (sseek (dtp->u.p.current_unit->s, (gfc_offset) (dtp->rec - 1)
+                * dtp->u.p.current_unit->recl) == FAILURE)
        {
-         if (sseek (dtp->u.p.current_unit->s, (gfc_offset) (dtp->rec - 1)
-                    * dtp->u.p.current_unit->recl) == FAILURE)
-           {
-             generate_error (&dtp->common, LIBERROR_OS, NULL);
-             return;
-           }
+         generate_error (&dtp->common, LIBERROR_OS, NULL);
+         return;
        }
-      else
-        {
-         if (dtp->u.p.current_unit->strm_pos != dtp->rec)
-           {
-             fbuf_flush (dtp->u.p.current_unit, 1);
-             flush (dtp->u.p.current_unit->s);
-             if (sseek (dtp->u.p.current_unit->s, dtp->rec - 1) == FAILURE)
-               {
-                 generate_error (&dtp->common, LIBERROR_OS, NULL);
-                 return;
-               }
-             dtp->u.p.current_unit->strm_pos = dtp->rec;
-           }
-        }
+
+      /* This is required to maintain compatibility between
+        4.3 and 4.4 runtime.  */
+      if (is_stream_io (dtp))
+       dtp->u.p.current_unit->strm_pos = dtp->rec;
 
     }