direct_io_2.f90: New test.

2004-11-28  Bud Davis  <bdavis9659@comcast.net>

        * gcc/gcc/gfortran.dg/direct_io_2.f90: New test.

        * gcc/libgfortran/io/unix.c (mmap_alloc_w_a): check for a write
	to a location less than the mapped area.

From-SVN: r91426

diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog
index 2f203ae13796f5209ebd84bb40d3ad94faf8fde8..7de43cf6b03a5fecdba203f5eff0150d705c2cf2 100644 (file)
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -1,3 +1,7 @@
+2004-11-28  Bud Davis  <bdavis9659@comcast.net>
+ 
+        * gfortran.dg/direct_io_2.f90: New test.
+
 2004-11-28  Hans-Peter Nilsson  <hp@bitrange.com>
 
        PR target/18334

diff --git a/gcc/testsuite/gfortran.dg/direct_io_2.f90 b/gcc/testsuite/gfortran.dg/direct_io_2.f90
new file mode 100644 (file)
index 0000000..847ce29
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/direct_io_2.f90
@@ -0,0 +1,44 @@
+! { dg-do run }
+!
+! this testcase derived from NIST test FM413.FOR
+! tests writing direct access files in ascending and descending
+! REC's.
+      PROGRAM FM413
+      IMPLICIT LOGICAL (L)
+      IMPLICIT CHARACTER*14 (C)
+      OPEN (7, ACCESS = 'DIRECT', RECL = 80, STATUS='REPLACE' )
+      IRECN = 13
+      IREC = 13
+      DO 4132 I = 1,100
+      IREC = IREC + 2
+      IRECN = IRECN + 2
+      WRITE(7, REC = IREC) IPROG, IFILE, ITOTR, IRLGN, IRECN, IEOF,ICON21, ICON22, ICON31, ICON32, ICON33, ICON34, ICON55, ICON56
+ 4132 CONTINUE
+      IRECN = 216
+      IREC = 216
+      DO 4133 I=1,100
+      IREC = IREC - 2
+      IRECN = IRECN - 2
+      WRITE(7, REC = IREC) IPROG, IFILE, ITOTR, IRLGN, IRECN, IEOF,ICON21, ICON22, ICON31, ICON32, ICON33, ICON34, ICON55, ICON56
+ 4133 CONTINUE
+      IRECCK = 13
+      IRECN = 0
+      IREC = 13
+      IVCOMP = 0
+      DO 4134 I = 1,100
+      IREC = IREC + 2
+      IRECCK = IRECCK + 2
+      READ(7, REC = IREC) IPROG, IFILE, ITOTR, IRLGN, IRECN, IEOF,IVON21, IVON22, IVON31, IVON32, IVON33, IVON34, IVON55, IVON56
+      IF (IRECN .NE. IRECCK) CALL ABORT
+ 4134 CONTINUE
+      IRECCK = 216
+      IRECN = 0
+      IREC = 216
+      DO 4135 I = 1,100
+      IREC = IREC - 2
+      IRECCK = IRECCK - 2
+      READ(7, REC = IREC)  IPROG, IFILE, ITOTR, IRLGN, IRECN, IEOF,IVON21, IVON22, IVON31, IVON32, IVON33, IVON34, IVON55, IVON56
+      IF (IRECN .NE. IRECCK) CALL ABORT
+ 4135 CONTINUE
+      STOP
+      END

diff --git a/libgfortran/ChangeLog b/libgfortran/ChangeLog
index a27c75d77d540c2af8ec7477913bd5b95cb869fb..761ec22886d44005ea1a2f359311df11513ce6b0 100644 (file)
--- a/libgfortran/ChangeLog
+++ b/libgfortran/ChangeLog
@@ -1,3 +1,8 @@
+2004-11-28  Bud Davis  <bdavis9659@comcast.net>
+
+       * io/unix.c (mmap_alloc_w_a): check for a write to a location
+       less than the mapped area.
+
 2004-11-27  Bud Davis  <bdavis9659@comcast.net>
 
        PR fortran/18364

diff --git a/libgfortran/io/unix.c b/libgfortran/io/unix.c
index 45d8cfd633f84a21375e80bfefbff68e632c3eba..2e9d9a4ba8c25f4c78e822c948113bac663e70b1 100644 (file)
--- a/libgfortran/io/unix.c
+++ b/libgfortran/io/unix.c
@@ -667,7 +667,8 @@ mmap_alloc_w_at (unix_stream * s, int *len, gfc_offset where)
     }
 
   if ((s->buffer == NULL || s->buffer_offset > where ||
-       where + *len > s->buffer_offset + s->active) &&
+       where + *len > s->buffer_offset + s->active ||
+       where < s->buffer_offset + s->active) &&
       mmap_alloc (s, where, len) == FAILURE)
     return NULL;