[fortran] patch for PR 12921 - Direct Access I/O doesn't work
Bud Davis
bdavis9659@comcast.net
Sat Feb 28 20:23:00 GMT 2004
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);
>
> }
>
>
>
More information about the Gcc-patches
mailing list