2008-01-03 Thomas Koenig <tkoenig@gcc.gnu.org>

	PR libfortran/34565
	* io/io.h:  Adjust protoypes for open_internal(),
	next_array_record() and init_loop_spec().
	* io/list_read.c (next_char):  Use argument "finished"
	of next_array_record to check for end on internal file.
	* io/unit.c:  Calculate the offset for an array
	internal file and supply this informatin to open_internal().
	* io/unix.c (open_internal):  Set the offset for the internal
	file on open.
	* io/transfer.c (init_loop_spec):  Calculate the starting
	record in case of negative strides.  Return size of 0 for
	an empty array.
	(next_array_record):  Use an extra flag to signal that the
	array is finished.
	(next_record_r):  Use the new flag to next_array_record().
	(next_record_w):  Likewise.

2008-01-03  Thomas Koenig  <tkoenig@gcc.gnu.org>

	PR libfortran/34565
	* gfortran.dg/internal_readwrite_1.f90:  New test.
	* gfortran.dg/internal_readwrite_2.f90:  New test.

git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@131305 138bc75d-0d04-0410-961f-82ee72b054a4

diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog
index 962dc97..b2891dc 100644 (file)
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -1,3 +1,9 @@
+2008-01-03  Thomas Koenig  <tkoenig@gcc.gnu.org>
+
+       PR libfortran/34565
+       * gfortran.dg/internal_readwrite_1.f90:  New test.
+       * gfortran.dg/internal_readwrite_2.f90:  New test.
+
 2008-01-03  Tom Tromey  <tromey@redhat.com>
 
        PR preprocessor/34602:

diff --git a/gcc/testsuite/gfortran.dg/internal_readwrite_1.f90 b/gcc/testsuite/gfortran.dg/internal_readwrite_1.f90
new file mode 100644 (file)
index 0000000..405f581
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/internal_readwrite_1.f90
@@ -0,0 +1,15 @@
+! { dg-do run }
+! PR 34565 - internal writes with negative strides
+! didn't work.
+program main
+  implicit none
+  integer :: i
+  integer :: lo, up, st
+  character(len=2) :: c (5)
+  integer, dimension(5) :: n
+  c = (/ 'a', 'b', 'c', 'd', 'e' /)
+  write (unit=c(5:1:-2),fmt="(A)") '5','3', '1'
+  write (unit=c(2:4:2),fmt="(A)") '2', '4'
+  read  (c(5:1:-1),fmt="(I2)") (n(i), i=5,1,-1)
+  if (any(n /= (/ (i,i=1,5) /))) call abort
+end program main

diff --git a/gcc/testsuite/gfortran.dg/internal_readwrite_2.f90 b/gcc/testsuite/gfortran.dg/internal_readwrite_2.f90
new file mode 100644 (file)
index 0000000..48b6586
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/internal_readwrite_2.f90
@@ -0,0 +1,14 @@
+! { dg-do run }
+! PR 34565 - intenal writes with negative strides.  This
+! test case tries out a negative stride in a higher
+! dimension.
+program main
+  implicit none
+  integer :: i
+  integer, parameter :: n1=2, n2=3, n3=5
+  character(len=n1*n2*n3*2) :: line
+  character(len=2), dimension(n1,n2,n3):: c
+  write (unit=c(:,n2:1:-1,:),fmt="(I2)") (i,i=1,n1*n2*n3)
+  line = transfer(c,mold=line)
+  if (line /=" 5 6 3 4 1 21112 910 7 8171815161314232421221920293027282526") call abort
+end program main

diff --git a/libgfortran/ChangeLog b/libgfortran/ChangeLog
index e69de29..c15f5d5 100644 (file)
--- a/libgfortran/ChangeLog
+++ b/libgfortran/ChangeLog
@@ -0,0 +1,18 @@
+2008-01-03  Thomas Koenig  <tkoenig@gcc.gnu.org>
+
+       PR libfortran/34565
+       * io/io.h:  Adjust protoypes for open_internal(),
+       next_array_record() and init_loop_spec().
+       * io/list_read.c (next_char):  Use argument "finished"
+       of next_array_record to check for end on internal file.
+       * io/unit.c:  Calculate the offset for an array
+       internal file and supply this informatin to open_internal().
+       * io/unix.c (open_internal):  Set the offset for the internal
+       file on open.
+       * io/transfer.c (init_loop_spec):  Calculate the starting
+       record in case of negative strides.  Return size of 0 for
+       an empty array.
+       (next_array_record):  Use an extra flag to signal that the
+       array is finished.
+       (next_record_r):  Use the new flag to next_array_record().
+       (next_record_w):  Likewise.

diff --git a/libgfortran/io/io.h b/libgfortran/io/io.h
index 688a9cb..3e020ec 100644 (file)
--- a/libgfortran/io/io.h
+++ b/libgfortran/io/io.h
@@ -569,7 +569,7 @@ internal_proto(compare_files);
 extern stream *open_external (st_parameter_open *, unit_flags *);
 internal_proto(open_external);
 
-extern stream *open_internal (char *, int);
+extern stream *open_internal (char *, int, gfc_offset);
 internal_proto(open_internal);
 
 extern stream *input_stream (void);
@@ -734,10 +734,12 @@ internal_proto(read_sf);
 extern void *write_block (st_parameter_dt *, int);
 internal_proto(write_block);
 
-extern gfc_offset next_array_record (st_parameter_dt *, array_loop_spec *);
+extern gfc_offset next_array_record (st_parameter_dt *, array_loop_spec *,
+                                    int*);
 internal_proto(next_array_record);
 
-extern gfc_offset init_loop_spec (gfc_array_char *, array_loop_spec *);
+extern gfc_offset init_loop_spec (gfc_array_char *, array_loop_spec *,
+                                 gfc_offset *);
 internal_proto(init_loop_spec);
 
 extern void next_record (st_parameter_dt *, int);

diff --git a/libgfortran/io/list_read.c b/libgfortran/io/list_read.c
index 06fd8a1..f00fb77 100644 (file)
--- a/libgfortran/io/list_read.c
+++ b/libgfortran/io/list_read.c
@@ -171,11 +171,14 @@ next_char (st_parameter_dt *dtp)
       /* Check for "end-of-record" condition.  */
       if (dtp->u.p.current_unit->bytes_left == 0)
        {
+         int finished;
+
          c = '\n';
-         record = next_array_record (dtp, dtp->u.p.current_unit->ls);
+         record = next_array_record (dtp, dtp->u.p.current_unit->ls,
+                                     &finished);
 
          /* Check for "end-of-file" condition.  */      
-         if (record == 0)
+         if (finished)
            {
              dtp->u.p.at_eof = 1;
              goto done;

diff --git a/libgfortran/io/transfer.c b/libgfortran/io/transfer.c
index 48f6033..9b9e28e 100644 (file)
--- a/libgfortran/io/transfer.c
+++ b/libgfortran/io/transfer.c
@@ -2068,42 +2068,63 @@ data_transfer_init (st_parameter_dt *dtp, int read_flag)
 }
 
 /* Initialize an array_loop_spec given the array descriptor.  The function
-   returns the index of the last element of the array.  */
+   returns the index of the last element of the array, and also returns
+   starting record, where the first I/O goes to (necessary in case of
+   negative strides).  */
    
 gfc_offset
-init_loop_spec (gfc_array_char *desc, array_loop_spec *ls)
+init_loop_spec (gfc_array_char *desc, array_loop_spec *ls,
+               gfc_offset *start_record)
 {
   int rank = GFC_DESCRIPTOR_RANK(desc);
   int i;
   gfc_offset index; 
+  int empty;
 
+  empty = 0;
   index = 1;
+  *start_record = 0;
+
   for (i=0; i<rank; i++)
     {
       ls[i].idx = desc->dim[i].lbound;
       ls[i].start = desc->dim[i].lbound;
       ls[i].end = desc->dim[i].ubound;
       ls[i].step = desc->dim[i].stride;
-      
-      index += (desc->dim[i].ubound - desc->dim[i].lbound)
-                      * desc->dim[i].stride;
+      empty = empty || (desc->dim[i].ubound < desc->dim[i].lbound);
+
+      if (desc->dim[i].stride > 0)
+       {
+         index += (desc->dim[i].ubound - desc->dim[i].lbound)
+           * desc->dim[i].stride;
+       }
+      else
+       {
+         index -= (desc->dim[i].ubound - desc->dim[i].lbound)
+           * desc->dim[i].stride;
+         *start_record -= (desc->dim[i].ubound - desc->dim[i].lbound)
+           * desc->dim[i].stride;
+       }
     }
-  return index;
+
+  if (empty)
+    return 0;
+  else
+    return index;
 }
 
 /* Determine the index to the next record in an internal unit array by
-   by incrementing through the array_loop_spec.  TODO:  Implement handling
-   negative strides. */
+   by incrementing through the array_loop_spec.  */
    
 gfc_offset
-next_array_record (st_parameter_dt *dtp, array_loop_spec *ls)
+next_array_record (st_parameter_dt *dtp, array_loop_spec *ls, int *finished)
 {
   int i, carry;
   gfc_offset index;
   
   carry = 1;
   index = 0;
-  
+
   for (i = 0; i < dtp->u.p.current_unit->rank; i++)
     {
       if (carry)
@@ -2120,6 +2141,8 @@ next_array_record (st_parameter_dt *dtp, array_loop_spec *ls)
       index = index + (ls[i].idx - ls[i].start) * ls[i].step;
     }
 
+  *finished = carry;
+
   return index;
 }
 
@@ -2241,7 +2264,10 @@ next_record_r (st_parameter_dt *dtp)
        {
          if (is_array_io (dtp))
            {
-             record = next_array_record (dtp, dtp->u.p.current_unit->ls);
+             int finished;
+
+             record = next_array_record (dtp, dtp->u.p.current_unit->ls,
+                                         &finished);
 
              /* Now seek to this record.  */
              record = record * dtp->u.p.current_unit->recl;
@@ -2460,6 +2486,8 @@ next_record_w (st_parameter_dt *dtp, int done)
        {
          if (is_array_io (dtp))
            {
+             int finished;
+
              length = (int) dtp->u.p.current_unit->bytes_left;
              
              /* If the farthest position reached is greater than current
@@ -2483,8 +2511,9 @@ next_record_w (st_parameter_dt *dtp, int done)
 
              /* Now that the current record has been padded out,
                 determine where the next record in the array is. */
-             record = next_array_record (dtp, dtp->u.p.current_unit->ls);
-             if (record == 0)
+             record = next_array_record (dtp, dtp->u.p.current_unit->ls,
+                                         &finished);
+             if (finished)
                dtp->u.p.current_unit->endfile = AT_ENDFILE;
              
              /* Now seek to this record */

diff --git a/libgfortran/io/unit.c b/libgfortran/io/unit.c
index b81f4cc..48efb9b 100644 (file)
--- a/libgfortran/io/unit.c
+++ b/libgfortran/io/unit.c
@@ -369,6 +369,7 @@ gfc_unit *
 get_internal_unit (st_parameter_dt *dtp)
 {
   gfc_unit * iunit;
+  gfc_offset start_record = 0;
 
   /* Allocate memory for a unit structure.  */
 
@@ -405,12 +406,15 @@ get_internal_unit (st_parameter_dt *dtp)
       iunit->ls = (array_loop_spec *)
        get_mem (iunit->rank * sizeof (array_loop_spec));
       dtp->internal_unit_len *=
-       init_loop_spec (dtp->internal_unit_desc, iunit->ls);
+       init_loop_spec (dtp->internal_unit_desc, iunit->ls, &start_record);
+
+      start_record *= iunit->recl;
     }
 
   /* Set initial values for unit parameters.  */
 
-  iunit->s = open_internal (dtp->internal_unit, dtp->internal_unit_len);
+  iunit->s = open_internal (dtp->internal_unit - start_record,
+                           dtp->internal_unit_len, -start_record);
   iunit->bytes_left = iunit->recl;
   iunit->last_record=0;
   iunit->maxrec=0;

diff --git a/libgfortran/io/unix.c b/libgfortran/io/unix.c
index 93484ea..91d5adb 100644 (file)
--- a/libgfortran/io/unix.c
+++ b/libgfortran/io/unix.c
@@ -1078,7 +1078,7 @@ empty_internal_buffer(stream *strm)
 /* open_internal()-- Returns a stream structure from an internal file */
 
 stream *
-open_internal (char *base, int length)
+open_internal (char *base, int length, gfc_offset offset)
 {
   int_stream *s;
 
@@ -1086,7 +1086,7 @@ open_internal (char *base, int length)
   memset (s, '\0', sizeof (int_stream));
 
   s->buffer = base;
-  s->buffer_offset = 0;
+  s->buffer_offset = offset;
 
   s->logical_offset = 0;
   s->active = s->file_length = length;