This is the mail archive of the
fortran@gcc.gnu.org
mailing list for the GNU Fortran project.
Re: [fortran] patch for PR 12921 - Direct Access I/O doesn't work
Spoke too soon !! they do not abort, which is different than a pass:)
On Sat, 2004-02-28 at 08:49, Bud Davis wrote:
> Tests FM916 FM917 FM921 of the NIST F77 test suite now pass with this
> patch.
>
> Prior status:
>
> 155 files compiled
> 37 files did not compile
> 138 files executed
> 54 files executed with bad status
>
> with this patch:
>
> 155 files compiled
> 37 files did not compile
> 141 files executed
> 51 files executed with bad status
>
>
> --bud
>
> On Sat, 2004-02-28 at 06:55, bud davis wrote:
> > Description:
> >
> > Direct I/O had several problems.
> >
> > #1> RECL= parameter was passed to the runtime as a pointer not a value.
> > #2> The test for "ACCESS parameter conflicts with SEQUENTIAL access in
> > OPEN statement"
> > was coded such that it always failed for ACCESS = "DIRECT"
> > #3> Calculation of maximum record size was broken.
> >
> > Testcases:
> >
> > None provided at this time. A comprehensive test needs to be written to
> > verify direct I/O.
> >
> > Here is the original PR code:
> >
> > program testio
> > real(4) pi
> > open(9,file="test.dat",access="direct",form="unformatted",status="new",recl=4)
> > pi = 4.*atan(1.0)
> > write(9,rec=1) pi
> > close(9)
> > end program testio
> >
> > If it is added to the testsuite, the status needs to be changed to "old" to
> > allow the test to be ran more than once.
> >
> >
> > Changelog:
> >
> > 2004-02-28 Bud Davis <bdavis9659@comcast.net>
> >
> > * trans-io.c (gfc_trans_open): Change RECL= to a value parameter.
> > * io.h, transfer.c, open.c : recl_in changed from ptr to variable.
> > * open.c (new_unit): Moved test for positioned direct access error.
> > * open.c (init_units): Corrected calculation of max records.
> >
> >
> > Testing:
> >
> > No additional testsuite failures, i686/linux
> >
> >
> > Patch:
> >
> > Index: gcc/gcc/fortran/trans-io.c
> > ===================================================================
> > RCS file: /cvs/gcc/gcc/gcc/fortran/Attic/trans-io.c,v
> > retrieving revision 1.1.2.7
> > diff -c -3 -p -r1.1.2.7 trans-io.c
> > *** gcc/gcc/fortran/trans-io.c 1 Jan 2004 12:09:12 -0000 1.1.2.7
> > --- gcc/gcc/fortran/trans-io.c 28 Feb 2004 11:46:15 -0000
> > *************** gfc_trans_open (gfc_code * code)
> > *** 544,550 ****
> > set_string (&block, &post_block, ioparm_form, ioparm_form_len,
> > p->form);
> >
> > if (p->recl)
> > ! set_parameter_ref (&block, ioparm_recl_in, p->recl);
> >
> > if (p->blank)
> > set_string (&block, &post_block, ioparm_blank, ioparm_blank_len,
> > --- 544,550 ----
> > set_string (&block, &post_block, ioparm_form, ioparm_form_len,
> > p->form);
> >
> > if (p->recl)
> > ! set_parameter_value (&block, ioparm_recl_in, p->recl);
> >
> > if (p->blank)
> > set_string (&block, &post_block, ioparm_blank, ioparm_blank_len,
> > Index: gcc/libgfortran/io/io.h
> > ===================================================================
> > RCS file: /cvs/gcc/gcc/libgfortran/io/Attic/io.h,v
> > retrieving revision 1.1.2.4
> > diff -c -3 -p -r1.1.2.4 io.h
> > *** gcc/libgfortran/io/io.h 19 Sep 2003 19:11:12 -0000 1.1.2.4
> > --- gcc/libgfortran/io/io.h 28 Feb 2004 11:46:50 -0000
> > *************** typedef struct
> > *** 172,180 ****
> > }
> > library_return;
> >
> > ! int *iostat, *exist, *opened, *number, *named, *rec, *nextrec, *size;
> >
> > ! off_t *recl_in, *recl_out;
> >
> > char *file;
> > int file_len;
> > --- 172,180 ----
> > }
> > library_return;
> >
> > ! int *iostat, *exist, *opened, *number, *named, rec, *nextrec, *size;
> >
> > ! offset_t recl_in, *recl_out;
> >
> > char *file;
> > int file_len;
> > Index: gcc/libgfortran/io/open.c
> > ===================================================================
> > RCS file: /cvs/gcc/gcc/libgfortran/io/Attic/open.c,v
> > retrieving revision 1.1.2.4
> > diff -c -3 -p -r1.1.2.4 open.c
> > *** gcc/libgfortran/io/open.c 29 Oct 2003 06:47:56 -0000 1.1.2.4
> > --- gcc/libgfortran/io/open.c 28 Feb 2004 11:46:51 -0000
> > *************** edit_modes (unit_t * u, unit_flags * fla
> > *** 170,176 ****
> > generate_error (ERROR_BAD_OPTION,
> > "Cannot change FORM parameter in OPEN statement");
> >
> > ! if (ioparm.recl_in != NULL && *ioparm.recl_in != u->recl)
> > generate_error (ERROR_BAD_OPTION,
> > "Cannot change RECL parameter in OPEN statement");
> >
> > --- 170,176 ----
> > generate_error (ERROR_BAD_OPTION,
> > "Cannot change FORM parameter in OPEN statement");
> >
> > ! if (ioparm.recl_in != 0 && ioparm.recl_in != u->recl)
> > generate_error (ERROR_BAD_OPTION,
> > "Cannot change RECL parameter in OPEN statement");
> >
> > *************** new_unit (unit_flags * flags)
> > *** 306,337 ****
> > }
> > }
> >
> > ! if (flags->position == POSITION_UNSPECIFIED)
> > ! flags->position = POSITION_ASIS;
> > ! else
> > ! {
> > ! if (flags->access == ACCESS_DIRECT)
> > ! {
> > ! generate_error (ERROR_OPTION_CONFLICT,
> > ! "ACCESS parameter conflicts with SEQUENTIAL
> > access in "
> > ! "OPEN statement");
> > ! goto cleanup;
> > ! }
> > ! }
> >
> > if (flags->status == STATUS_UNSPECIFIED)
> > flags->status = STATUS_UNKNOWN;
> >
> > /* Checks */
> >
> > ! if (flags->access == ACCESS_DIRECT && ioparm.recl_in == NULL)
> > {
> > generate_error (ERROR_MISSING_OPTION,
> > "Missing RECL parameter in OPEN statement");
> > goto cleanup;
> > }
> >
> > ! if (ioparm.recl_in != NULL && *ioparm.recl_in <= 0)
> > {
> > generate_error (ERROR_BAD_OPTION,
> > "RECL parameter is non-positive in OPEN statement");
> > --- 306,336 ----
> > }
> > }
> >
> > ! if (flags->position != POSITION_ASIS && flags->access == ACCESS_DIRECT)
> > ! {
> > ! generate_error (ERROR_OPTION_CONFLICT,
> > ! "ACCESS parameter conflicts with SEQUENTIAL
> > access in "
> > ! "OPEN statement");
> > ! goto cleanup;
> > ! }
> > ! else
> > ! if (flags->position == POSITION_UNSPECIFIED)
> > ! flags->position = POSITION_ASIS;
> > !
> >
> > if (flags->status == STATUS_UNSPECIFIED)
> > flags->status = STATUS_UNKNOWN;
> >
> > /* Checks */
> >
> > ! if (flags->access == ACCESS_DIRECT && ioparm.recl_in == 0)
> > {
> > generate_error (ERROR_MISSING_OPTION,
> > "Missing RECL parameter in OPEN statement");
> > goto cleanup;
> > }
> >
> > ! if (ioparm.recl_in != 0 && ioparm.recl_in <= 0)
> > {
> > generate_error (ERROR_BAD_OPTION,
> > "RECL parameter is non-positive in OPEN statement");
> > *************** new_unit (unit_flags * flags)
> > *** 393,399 ****
> >
> > /* Unspecified recl ends up with a processor dependent value */
> >
> > ! u->recl = (ioparm.recl_in != NULL) ? *ioparm.recl_in : DEFAULT_RECL;
> > u->last_record = 0;
> > u->current_record = 0;
> >
> > --- 392,398 ----
> >
> > /* Unspecified recl ends up with a processor dependent value */
> >
> > ! u->recl = (ioparm.recl_in != 0) ? ioparm.recl_in : DEFAULT_RECL;
> > u->last_record = 0;
> > u->current_record = 0;
> >
> > Index: gcc/libgfortran/io/transfer.c
> > ===================================================================
> > RCS file: /cvs/gcc/gcc/libgfortran/io/Attic/transfer.c,v
> > retrieving revision 1.1.2.7
> > diff -c -3 -p -r1.1.2.7 transfer.c
> > *** gcc/libgfortran/io/transfer.c 7 Feb 2004 15:33:29 -0000
> > 1.1.2.7
> > --- gcc/libgfortran/io/transfer.c 28 Feb 2004 11:46:52 -0000
> > *************** data_transfer_init (int read_flag)
> > *** 1001,1013 ****
> >
> > if (ioparm.rec != NULL)
> > {
> > ! if (*ioparm.rec <= 0)
> > {
> > generate_error (ERROR_BAD_OPTION, "Record number must be
> > positive");
> > return;
> > }
> >
> > ! if (*ioparm.rec >= current_unit->maxrec)
> > {
> > generate_error (ERROR_BAD_OPTION, "Record number too large");
> > return;
> > --- 1001,1013 ----
> >
> > if (ioparm.rec != NULL)
> > {
> > ! if (ioparm.rec <= 0)
> > {
> > generate_error (ERROR_BAD_OPTION, "Record number must be
> > positive");
> > return;
> > }
> >
> > ! if (ioparm.rec >= current_unit->maxrec)
> > {
> > generate_error (ERROR_BAD_OPTION, "Record number too large");
> > return;
> > *************** data_transfer_init (int read_flag)
> > *** 1016,1022 ****
> > /* Position the file */
> >
> > if (sseek (current_unit->s,
> > ! (*ioparm.rec - 1) * current_unit->recl) == FAILURE)
> > generate_error (ERROR_OS, NULL);
> > }
> >
> > --- 1016,1022 ----
> > /* Position the file */
> >
> > if (sseek (current_unit->s,
> > ! (ioparm.rec - 1) * current_unit->recl) == FAILURE)
> > generate_error (ERROR_OS, NULL);
> > }
> >
> > Index: gcc/libgfortran/io/unit.c
> > ===================================================================
> > RCS file: /cvs/gcc/gcc/libgfortran/io/Attic/unit.c,v
> > retrieving revision 1.1.2.3
> > diff -c -3 -p -r1.1.2.3 unit.c
> > *** gcc/libgfortran/io/unit.c 19 Sep 2003 19:11:12 -0000 1.1.2.3
> > --- gcc/libgfortran/io/unit.c 28 Feb 2004 11:46:52 -0000
> > *************** init_units (void)
> > *** 291,296 ****
> > --- 291,297 ----
> > {
> > offset_t m, n;
> > unit_t *u;
> > + int i;
> >
> > if (options.stdin_unit >= 0)
> > { /* STDIN */
> > *************** init_units (void)
> > *** 337,353 ****
> > /* Calculate the maximum file offset in a portable manner. It is
> > * assumed to be a power of two minus 1. */
> >
> > ! /* TODO: this looks really broken. glibc info pages say 2^31 or
> > 2^63. */
> > ! m = 1;
> > ! n = 3;
> > !
> > ! while (n > m)
> > ! {
> > ! m = (m << 1) | 1;
> > ! n = (n << 1) | 1;
> > ! }
> >
> > - g.max_offset = (m - 1) + m;
> > }
> >
> >
> > --- 338,349 ----
> > /* Calculate the maximum file offset in a portable manner. It is
> > * assumed to be a power of two minus 1. */
> >
> > ! /* this works when max_offset is 32 bits. */
> > !
> > ! g.max_offset = 0;
> > ! for (i=0; i < sizeof(g.max_offset) * 8 - 1; i++)
> > ! g.max_offset = g.max_offset + ((offset_t) 1 << i);
> >
> > }
> >
> >
> >
>