This is the mail archive of the fortran@gcc.gnu.org mailing list for the GNU Fortran project.
Index Nav: | [Date Index] [Subject Index] [Author Index] [Thread Index] | |
---|---|---|
Message Nav: | [Date Prev] [Date Next] | [Thread Prev] [Thread Next] |
Other format: | [Raw text] |
Hello world, here's a patch for internal I/O with negative array strides. This was a bit tricky, due to the separation of stream I/O and the number of places that needed to be touched. Regression-tested on i686-pc-linux-gnu. OK for trunk? Thomas 2008-01-02 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-02 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.
Index: list_read.c =================================================================== --- list_read.c (revision 131146) +++ list_read.c (working copy) @@ -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; Index: io.h =================================================================== --- io.h (revision 131146) +++ io.h (working copy) @@ -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); Index: unit.c =================================================================== --- unit.c (revision 131146) +++ unit.c (working copy) @@ -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; Index: unix.c =================================================================== --- unix.c (revision 131146) +++ unix.c (working copy) @@ -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; Index: transfer.c =================================================================== --- transfer.c (revision 131146) +++ transfer.c (working copy) @@ -2061,42 +2061,63 @@ data_transfer_init (st_parameter_dt *dtp } /* 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) @@ -2113,6 +2134,8 @@ next_array_record (st_parameter_dt *dtp, index = index + (ls[i].idx - ls[i].start) * ls[i].step; } + *finished = carry; + return index; } @@ -2234,7 +2257,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; @@ -2453,6 +2479,8 @@ next_record_w (st_parameter_dt *dtp, int { 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 @@ -2476,8 +2504,9 @@ next_record_w (st_parameter_dt *dtp, int /* 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 */
! { 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
! { 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
Index Nav: | [Date Index] [Subject Index] [Author Index] [Thread Index] | |
---|---|---|
Message Nav: | [Date Prev] [Date Next] | [Thread Prev] [Thread Next] |