aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
Diffstat
-rw-r--r--gcc/testsuite/ChangeLog6
-rw-r--r--gcc/testsuite/gfortran.dg/internal_readwrite_1.f9015
-rw-r--r--gcc/testsuite/gfortran.dg/internal_readwrite_2.f9014
-rw-r--r--libgfortran/ChangeLog18
-rw-r--r--libgfortran/io/io.h8
-rw-r--r--libgfortran/io/list_read.c7
-rw-r--r--libgfortran/io/transfer.c55
-rw-r--r--libgfortran/io/unit.c8
-rw-r--r--libgfortran/io/unix.c4
9 files changed, 113 insertions, 22 deletions
diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog
index 962dc97..b2891dc 100644
--- 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
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
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
--- 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
--- 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
--- 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
--- 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
--- 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
--- 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;
generated by cgit v1.1 at 2025-02-21 21:59:02 +0000