[fortran] patch for PR 12921 - Direct Access I/O doesn't work
bud davis
bdavis9659@comcast.net
Sat Feb 28 14:49:00 GMT 2004
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 Fortran
mailing list