From cf4abc57c8be3b23d98fcbe6db5e1d2883f5cb5b Mon Sep 17 00:00:00 2001 From: tkoenig Date: Thu, 3 Jan 2008 19:49:38 +0000 Subject: [PATCH] 2008-01-03 Thomas Koenig 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 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 --- gcc/testsuite/ChangeLog | 6 +++ gcc/testsuite/gfortran.dg/internal_readwrite_1.f90 | 15 ++++++ gcc/testsuite/gfortran.dg/internal_readwrite_2.f90 | 14 ++++++ libgfortran/ChangeLog | 18 +++++++ libgfortran/io/io.h | 8 ++-- libgfortran/io/list_read.c | 7 ++- libgfortran/io/transfer.c | 55 +++++++++++++++++----- libgfortran/io/unit.c | 8 +++- libgfortran/io/unix.c | 4 +- 9 files changed, 113 insertions(+), 22 deletions(-) create mode 100644 gcc/testsuite/gfortran.dg/internal_readwrite_1.f90 create mode 100644 gcc/testsuite/gfortran.dg/internal_readwrite_2.f90 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 + + PR libfortran/34565 + * gfortran.dg/internal_readwrite_1.f90: New test. + * gfortran.dg/internal_readwrite_2.f90: New test. + 2008-01-03 Tom Tromey 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 + + 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; idim[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; -- 2.7.4