[PATCH] Fix Fortran 2003 IO and related ABI issues (PR libfortran/37839)
Jakub Jelinek
jakub@redhat.com
Fri Nov 21 13:46:00 GMT 2008
Hi!
As I've explained in the PR, there are several issues with the recent
additions of F2003 IO support, some of them cause incompatibilities
between f951 expected field layout and libgfortran on some arches
(and incompatibilities between 4.3 f951 generated code and 4.4
libgfortran) and INQUIRE additions not being tested at all and broken for
most of the newly added fields.
The following patch tries to fix it. Bootstrapped/regtested on x86_64-linux
and dg.exp=f2003*.f03 tested also on x86_64-linux/-m32 and
powerpc64-linux/{-m32,-m64}. I have also run a gfortran 4.3 compiled x86_64
and i386 program and verified under debugger that stack after dt_parm_*
vars isn't clobbered by the calls. Ok for trunk?
2008-11-21 Jakub Jelinek <jakub@redhat.com>
PR libfortran/37839
* trans-io.c (gfc_build_io_library_fndecls): Decrease pad size back
to 16 pointers plus 32 integers. Don't use max integer kind
alignment, only gfc_intio_kind's alignment.
(gfc_trans_inquire): Only set flags2 if mask2 is non-zero.
* ioparm.def: Fix order, bitmasks and types of inquire round, sign
and pending fields. Move u in dt before id.
* io.c (gfc_free_inquire): Free decimal and size exprs.
(match_inquire_element): Match size instead of matching blank twice.
(gfc_resolve_inquire): Resolve size.
* gfortran.dg/f2003_inquire_1.f03: New test.
* gfortran.dg/f2003_io_1.f03: Remove xfail.
* gfortran.dg/f2003_io_4.f03: Likewise.
* gfortran.dg/f2003_io_5.f03: Likewise.
* gfortran.dg/f2003_io_6.f03: Likewise.
* gfortran.dg/f2003_io_7.f03: Likewise.
* io/io.h (IOPARM_INQUIRE_HAS_ROUND, IOPARM_INQUIRE_HAS_SIGN,
IOPARM_INQUIRE_HAS_PENDING): Adjust values.
(st_parameter_inquire): Reorder and fix types of round, sign and
pending fields.
(st_parameter_43, st_parameter_44): Removed.
(st_parameter_dt): Put back struct definition directly to u.p
declaration. Change type of u.p.size_used from gfc_offset to
GFC_IO_INT. Decrease back size of u.pad to 16 pointers and
32 ints. Put id, pos, asynchronous, blank, decimal, delim,
pad, round and sign fields after the union.
* io/inquire.c (inquire_via_unit, inquire_via_filename): Only read
flags2 if it is defined.
* io/transfer.c (read_sf, read_block_form, write_block): Cast
additions to size_used to GFC_IO_INT instead of gfc_offset.
(data_transfer_init): Clear whole u.p struct. Adjust
for moving id, pos, asynchronous, blank, decimal, delim, pad,
round and sign fields from u.p directly into st_parameter_dt.
(finalize_transfer): Don't cast size_used to GFC_IO_INT.
* io/file_pos.c (st_endfile): Clear whole u.p struct.
--- gcc/fortran/trans-io.c.jj 2008-09-30 16:56:44.000000000 +0200
+++ gcc/fortran/trans-io.c 2008-11-21 12:11:44.000000000 +0100
@@ -291,9 +291,9 @@ gfc_build_io_library_fndecls (void)
= build_pointer_type (gfc_intio_type_node);
types[IOPARM_type_parray] = pchar_type_node;
types[IOPARM_type_pchar] = pchar_type_node;
- pad_size = 32 * TREE_INT_CST_LOW (TYPE_SIZE_UNIT (pchar_type_node));
+ pad_size = 16 * TREE_INT_CST_LOW (TYPE_SIZE_UNIT (pchar_type_node));
pad_size += 32 * TREE_INT_CST_LOW (TYPE_SIZE_UNIT (integer_type_node));
- pad_idx = build_index_type (build_int_cst (NULL_TREE, pad_size));
+ pad_idx = build_index_type (build_int_cst (NULL_TREE, pad_size - 1));
types[IOPARM_type_pad] = build_array_type (char_type_node, pad_idx);
/* pad actually contains pointers and integers so it needs to have an
@@ -301,7 +301,7 @@ gfc_build_io_library_fndecls (void)
types. See the st_parameter_dt structure in libgfortran/io/io.h for
what really goes into this space. */
TYPE_ALIGN (types[IOPARM_type_pad]) = MAX (TYPE_ALIGN (pchar_type_node),
- TYPE_ALIGN (gfc_get_int_type (gfc_max_integer_kind)));
+ TYPE_ALIGN (gfc_get_int_type (gfc_intio_kind)));
for (ptype = IOPARM_ptype_common; ptype < IOPARM_ptype_num; ptype++)
gfc_build_st_parameter (ptype, types);
@@ -1315,10 +1315,8 @@ gfc_trans_inquire (gfc_code * code)
mask2 |= set_parameter_ref (&block, &post_block,var, IOPARM_inquire_id,
p->id);
- set_parameter_const (&block, var, IOPARM_inquire_flags2, mask2);
-
if (mask2)
- mask |= IOPARM_inquire_flags2;
+ mask |= set_parameter_const (&block, var, IOPARM_inquire_flags2, mask2);
set_parameter_const (&block, var, IOPARM_common_flags, mask);
--- gcc/fortran/ioparm.def.jj 2008-09-30 16:56:44.000000000 +0200
+++ gcc/fortran/ioparm.def 2008-11-21 10:18:35.000000000 +0100
@@ -63,9 +63,9 @@ IOPARM (inquire, flags2, 1 << 31, int4)
IOPARM (inquire, asynchronous, 1 << 0, char1)
IOPARM (inquire, decimal, 1 << 1, char2)
IOPARM (inquire, encoding, 1 << 2, char1)
-IOPARM (inquire, pending, 1 << 3, pint4)
-IOPARM (inquire, round, 1 << 4, char1)
-IOPARM (inquire, sign, 1 << 5, char2)
+IOPARM (inquire, round, 1 << 3, char2)
+IOPARM (inquire, sign, 1 << 4, char1)
+IOPARM (inquire, pending, 1 << 5, pint4)
IOPARM (inquire, size, 1 << 6, pint4)
IOPARM (inquire, id, 1 << 7, pint4)
IOPARM (wait, common, 0, common)
@@ -83,6 +83,7 @@ IOPARM (dt, format, 1 << 12, char1)
IOPARM (dt, advance, 1 << 13, char2)
IOPARM (dt, internal_unit, 1 << 14, char1)
IOPARM (dt, namelist_name, 1 << 15, char2)
+IOPARM (dt, u, 0, pad)
IOPARM (dt, id, 1 << 16, pint4)
IOPARM (dt, pos, 1 << 17, intio)
IOPARM (dt, asynchronous, 1 << 18, char1)
@@ -92,4 +93,3 @@ IOPARM (dt, delim, 1 << 21, char2)
IOPARM (dt, pad, 1 << 22, char1)
IOPARM (dt, round, 1 << 23, char2)
IOPARM (dt, sign, 1 << 24, char1)
-IOPARM (dt, u, 0, pad)
--- gcc/fortran/io.c.jj 2008-11-15 11:13:57.000000000 +0100
+++ gcc/fortran/io.c 2008-11-21 11:24:34.000000000 +0100
@@ -3540,9 +3540,11 @@ gfc_free_inquire (gfc_inquire *inquire)
gfc_free_expr (inquire->convert);
gfc_free_expr (inquire->strm_pos);
gfc_free_expr (inquire->asynchronous);
+ gfc_free_expr (inquire->decimal);
gfc_free_expr (inquire->pending);
gfc_free_expr (inquire->id);
gfc_free_expr (inquire->sign);
+ gfc_free_expr (inquire->size);
gfc_free_expr (inquire->round);
gfc_free (inquire);
}
@@ -3584,7 +3586,7 @@ match_inquire_element (gfc_inquire *inqu
RETM m = match_vtag (&tag_s_async, &inquire->asynchronous);
RETM m = match_vtag (&tag_s_delim, &inquire->delim);
RETM m = match_vtag (&tag_s_decimal, &inquire->decimal);
- RETM m = match_vtag (&tag_s_blank, &inquire->blank);
+ RETM m = match_vtag (&tag_size, &inquire->size);
RETM m = match_vtag (&tag_s_encoding, &inquire->encoding);
RETM m = match_vtag (&tag_s_round, &inquire->round);
RETM m = match_vtag (&tag_s_sign, &inquire->sign);
@@ -3761,6 +3763,7 @@ gfc_resolve_inquire (gfc_inquire *inquir
RESOLVE_TAG (&tag_s_sign, inquire->sign);
RESOLVE_TAG (&tag_s_round, inquire->round);
RESOLVE_TAG (&tag_pending, inquire->pending);
+ RESOLVE_TAG (&tag_size, inquire->size);
RESOLVE_TAG (&tag_id, inquire->id);
if (gfc_reference_st_label (inquire->err, ST_LABEL_TARGET) == FAILURE)
--- gcc/testsuite/gfortran.dg/f2003_inquire_1.f03.jj 2008-11-21 10:59:51.000000000 +0100
+++ gcc/testsuite/gfortran.dg/f2003_inquire_1.f03 2008-11-21 13:19:11.000000000 +0100
@@ -0,0 +1,21 @@
+! { dg-do run { target fd_truncate } }
+! { dg-options "-std=gnu" }
+character(25) :: sround, ssign, sasynchronous, sdecimal, sencoding
+integer :: vsize, vid
+logical :: vpending
+
+open(10, file='mydata', asynchronous="yes", blank="null", &
+& decimal="comma", encoding="utf-8", sign="plus")
+
+inquire(unit=10, round=sround, sign=ssign, size=vsize, id=vid, &
+& pending=vpending, asynchronous=sasynchronous, decimal=sdecimal, &
+& encoding=sencoding)
+
+if (ssign.ne."PLUS") call abort
+if (sasynchronous.ne."YES") call abort
+if (sdecimal.ne."COMMA") call abort
+if (sencoding.ne."UTF-8") call abort
+if (vpending) call abort
+
+close(10, status="delete")
+end
--- gcc/testsuite/gfortran.dg/f2003_io_7.f03.jj 2008-11-19 09:51:51.000000000 +0100
+++ gcc/testsuite/gfortran.dg/f2003_io_7.f03 2008-11-21 10:52:09.000000000 +0100
@@ -1,5 +1,4 @@
! { dg-do run { target fd_truncate } }
-! { dg-xfail-run-if "PR37839" { { ia64-*-hpux* hppa*-*-* powerpc*-*-* sparc*-*-* } && ilp32 } { "*" } { "" } }
! Test case prepared by Jerry DeLisle <jvdelisle@gcc.gnu.org>
! Test of sign=, decimal=, and blank= .
program iotests
--- gcc/testsuite/gfortran.dg/f2003_io_5.f03.jj 2008-11-19 09:51:51.000000000 +0100
+++ gcc/testsuite/gfortran.dg/f2003_io_5.f03 2008-11-21 10:51:42.000000000 +0100
@@ -1,5 +1,4 @@
! { dg-do run { target fd_truncate } }
-! { dg-xfail-run-if "PR37839" { { ia64-*-hpux* hppa*-*-* powerpc*-*-* sparc*-*-* } && ilp32 } { "*" } { "" } }
! Test case prepared by Jerry DeLisle <jvdelisle@gcc.gnu.org>
! Test of decimal="comma" in namelist and complex
integer :: i
--- gcc/testsuite/gfortran.dg/f2003_io_6.f03.jj 2008-11-19 09:51:51.000000000 +0100
+++ gcc/testsuite/gfortran.dg/f2003_io_6.f03 2008-11-21 10:51:52.000000000 +0100
@@ -1,5 +1,4 @@
! { dg-do run }
-! { dg-xfail-run-if "PR37839" { { ia64-*-hpux* hppa*-*-* powerpc*-*-* sparc*-*-* } && ilp32 } { "*" } { "" } }
! Test case prepared by Jerry DeLisle <jvdelisle@gcc.gnu.org>
! Test of decimal="comma" in namelist, checks separators
implicit none
--- gcc/testsuite/gfortran.dg/f2003_io_1.f03.jj 2008-11-19 09:51:51.000000000 +0100
+++ gcc/testsuite/gfortran.dg/f2003_io_1.f03 2008-11-21 10:51:07.000000000 +0100
@@ -1,6 +1,5 @@
! { dg-do run { target fd_truncate } }
! { dg-options "-std=gnu" }
-! { dg-xfail-run-if "PR37839" { { ia64-*-hpux* hppa*-*-* powerpc*-*-* sparc*-*-* } && ilp32 } { "*" } { "" } }
! Test case prepared by Jerry DeLisle <jvdelisle@gcc.gnu.org>
real :: a(4), b(4)
real :: c
--- gcc/testsuite/gfortran.dg/f2003_io_4.f03.jj 2008-11-19 09:51:51.000000000 +0100
+++ gcc/testsuite/gfortran.dg/f2003_io_4.f03 2008-11-21 10:51:32.000000000 +0100
@@ -1,5 +1,4 @@
! { dg-do run { target fd_truncate } }
-! { dg-xfail-run-if "PR37839" { { ia64-*-hpux* hppa*-*-* powerpc*-*-* sparc*-*-* } && ilp32 } { "*" } { "" } }
! Test case prepared by Jerry DeLisle <jvdelisle@gcc.gnu.org>
! Test of decimal= feature
--- libgfortran/io/inquire.c.jj 2008-09-30 16:57:36.000000000 +0200
+++ libgfortran/io/inquire.c 2008-11-21 11:29:01.000000000 +0100
@@ -43,7 +43,6 @@ inquire_via_unit (st_parameter_inquire *
{
const char *p;
GFC_INTEGER_4 cf = iqp->common.flags;
- GFC_INTEGER_4 cf2 = iqp->flags2;
if ((cf & IOPARM_INQUIRE_HAS_EXIST) != 0)
{
@@ -254,6 +253,8 @@ inquire_via_unit (st_parameter_inquire *
if (cf & IOPARM_INQUIRE_HAS_FLAGS2)
{
+ GFC_INTEGER_4 cf2 = iqp->flags2;
+
if ((cf2 & IOPARM_INQUIRE_HAS_PENDING) != 0)
*iqp->pending = 0;
@@ -525,7 +526,6 @@ inquire_via_filename (st_parameter_inqui
{
const char *p;
GFC_INTEGER_4 cf = iqp->common.flags;
- GFC_INTEGER_4 cf2 = iqp->flags2;
if ((cf & IOPARM_INQUIRE_HAS_EXIST) != 0)
*iqp->exist = file_exists (iqp->file, iqp->file_len);
@@ -586,6 +586,8 @@ inquire_via_filename (st_parameter_inqui
if (cf & IOPARM_INQUIRE_HAS_FLAGS2)
{
+ GFC_INTEGER_4 cf2 = iqp->flags2;
+
if ((cf2 & IOPARM_INQUIRE_HAS_ENCODING) != 0)
cf_strcpy (iqp->encoding, iqp->encoding_len, undefined);
--- libgfortran/io/io.h.jj 2008-10-20 16:59:11.000000000 +0200
+++ libgfortran/io/io.h 2008-11-21 10:48:31.000000000 +0100
@@ -310,9 +310,9 @@ st_parameter_filepos;
#define IOPARM_INQUIRE_HAS_ASYNCHRONOUS (1 << 0)
#define IOPARM_INQUIRE_HAS_DECIMAL (1 << 1)
#define IOPARM_INQUIRE_HAS_ENCODING (1 << 2)
-#define IOPARM_INQUIRE_HAS_PENDING (1 << 3)
-#define IOPARM_INQUIRE_HAS_ROUND (1 << 4)
-#define IOPARM_INQUIRE_HAS_SIGN (1 << 5)
+#define IOPARM_INQUIRE_HAS_ROUND (1 << 3)
+#define IOPARM_INQUIRE_HAS_SIGN (1 << 4)
+#define IOPARM_INQUIRE_HAS_PENDING (1 << 5)
#define IOPARM_INQUIRE_HAS_SIZE (1 << 6)
#define IOPARM_INQUIRE_HAS_ID (1 << 7)
@@ -343,9 +343,9 @@ typedef struct
CHARACTER1 (asynchronous);
CHARACTER2 (decimal);
CHARACTER1 (encoding);
- CHARACTER2 (pending);
- CHARACTER1 (round);
- CHARACTER2 (sign);
+ CHARACTER2 (round);
+ CHARACTER1 (sign);
+ GFC_INTEGER_4 *pending;
GFC_INTEGER_4 *size;
GFC_INTEGER_4 *id;
}
@@ -377,172 +377,6 @@ struct format_data;
#define IOPARM_DT_IONML_SET (1 << 31)
-typedef struct st_parameter_43
-{
- void (*transfer) (struct st_parameter_dt *, bt, void *, int,
- size_t, size_t);
- struct gfc_unit *current_unit;
- /* Item number in a formatted data transfer. Also used in namelist
- read_logical as an index into line_buffer. */
- int item_count;
- unit_mode mode;
- unit_blank blank_status;
- unit_sign sign_status;
- int scale_factor;
- int max_pos; /* Maximum righthand column written to. */
- /* Number of skips + spaces to be done for T and X-editing. */
- int skips;
- /* Number of spaces to be done for T and X-editing. */
- int pending_spaces;
- /* Whether an EOR condition was encountered. Value is:
- 0 if no EOR was encountered
- 1 if an EOR was encountered due to a 1-byte marker (LF)
- 2 if an EOR was encountered due to a 2-bytes marker (CRLF) */
- int sf_seen_eor;
- unit_advance advance_status;
- unsigned reversion_flag : 1; /* Format reversion has occurred. */
- unsigned first_item : 1;
- unsigned seen_dollar : 1;
- unsigned eor_condition : 1;
- unsigned no_leading_blank : 1;
- unsigned char_flag : 1;
- unsigned input_complete : 1;
- unsigned at_eol : 1;
- unsigned comma_flag : 1;
- /* A namelist specific flag used in the list directed library
- to flag that calls are being made from namelist read (eg. to
- ignore comments or to treat '/' as a terminator) */
- unsigned namelist_mode : 1;
- /* A namelist specific flag used in the list directed library
- to flag read errors and return, so that an attempt can be
- made to read a new object name. */
- unsigned nml_read_error : 1;
- /* A sequential formatted read specific flag used to signal that a
- character string is being read so don't use commas to shorten a
- formatted field width. */
- unsigned sf_read_comma : 1;
- /* A namelist specific flag used to enable reading input from
- line_buffer for logical reads. */
- unsigned line_buffer_enabled : 1;
- /* An internal unit specific flag used to identify that the associated
- unit is internal. */
- unsigned unit_is_internal : 1;
- /* An internal unit specific flag to signify an EOF condition for list
- directed read. */
- unsigned at_eof : 1;
- /* 16 unused bits. */
-
- char last_char;
- char nml_delim;
-
- int repeat_count;
- int saved_length;
- int saved_used;
- bt saved_type;
- char *saved_string;
- char *scratch;
- char *line_buffer;
- struct format_data *fmt;
- jmp_buf *eof_jump;
- namelist_info *ionml;
- /* A flag used to identify when a non-standard expanded namelist read
- has occurred. */
- int expanded_read;
- /* Storage area for values except for strings. Must be large
- enough to hold a complex value (two reals) of the largest
- kind. */
- char value[32];
- gfc_offset size_used;
-} st_parameter_43;
-
-
-typedef struct st_parameter_44
-{
- GFC_INTEGER_4 *id;
- GFC_IO_INT pos;
- CHARACTER1 (asynchronous);
- CHARACTER2 (blank);
- CHARACTER1 (decimal);
- CHARACTER2 (delim);
- CHARACTER1 (pad);
- CHARACTER2 (round);
- CHARACTER1 (sign);
- void (*transfer) (struct st_parameter_dt *, bt, void *, int,
- size_t, size_t);
- struct gfc_unit *current_unit;
- /* Item number in a formatted data transfer. Also used in namelist
- read_logical as an index into line_buffer. */
- int item_count;
- unit_mode mode;
- unit_blank blank_status;
- unit_sign sign_status;
- int scale_factor;
- int max_pos; /* Maximum righthand column written to. */
- /* Number of skips + spaces to be done for T and X-editing. */
- int skips;
- /* Number of spaces to be done for T and X-editing. */
- int pending_spaces;
- /* Whether an EOR condition was encountered. Value is:
- 0 if no EOR was encountered
- 1 if an EOR was encountered due to a 1-byte marker (LF)
- 2 if an EOR was encountered due to a 2-bytes marker (CRLF) */
- int sf_seen_eor;
- unit_advance advance_status;
- unsigned reversion_flag : 1; /* Format reversion has occurred. */
- unsigned first_item : 1;
- unsigned seen_dollar : 1;
- unsigned eor_condition : 1;
- unsigned no_leading_blank : 1;
- unsigned char_flag : 1;
- unsigned input_complete : 1;
- unsigned at_eol : 1;
- unsigned comma_flag : 1;
- /* A namelist specific flag used in the list directed library
- to flag that calls are being made from namelist read (eg. to
- ignore comments or to treat '/' as a terminator) */
- unsigned namelist_mode : 1;
- /* A namelist specific flag used in the list directed library
- to flag read errors and return, so that an attempt can be
- made to read a new object name. */
- unsigned nml_read_error : 1;
- /* A sequential formatted read specific flag used to signal that a
- character string is being read so don't use commas to shorten a
- formatted field width. */
- unsigned sf_read_comma : 1;
- /* A namelist specific flag used to enable reading input from
- line_buffer for logical reads. */
- unsigned line_buffer_enabled : 1;
- /* An internal unit specific flag used to identify that the associated
- unit is internal. */
- unsigned unit_is_internal : 1;
- /* An internal unit specific flag to signify an EOF condition for list
- directed read. */
- unsigned at_eof : 1;
- /* 16 unused bits. */
-
- char last_char;
- char nml_delim;
-
- int repeat_count;
- int saved_length;
- int saved_used;
- bt saved_type;
- char *saved_string;
- char *scratch;
- char *line_buffer;
- struct format_data *fmt;
- jmp_buf *eof_jump;
- namelist_info *ionml;
- /* A flag used to identify when a non-standard expanded namelist read
- has occurred. */
- int expanded_read;
- /* Storage area for values except for strings. Must be large
- enough to hold a complex value (two reals) of the largest
- kind. */
- char value[32];
- gfc_offset size_used;
-} st_parameter_44;
-
typedef struct st_parameter_dt
{
st_parameter_common common;
@@ -557,13 +391,97 @@ typedef struct st_parameter_dt
to reserve enough space. */
union
{
- st_parameter_43 q;
- st_parameter_44 p;
+ struct
+ {
+ void (*transfer) (struct st_parameter_dt *, bt, void *, int,
+ size_t, size_t);
+ struct gfc_unit *current_unit;
+ /* Item number in a formatted data transfer. Also used in namelist
+ read_logical as an index into line_buffer. */
+ int item_count;
+ unit_mode mode;
+ unit_blank blank_status;
+ unit_sign sign_status;
+ int scale_factor;
+ int max_pos; /* Maximum righthand column written to. */
+ /* Number of skips + spaces to be done for T and X-editing. */
+ int skips;
+ /* Number of spaces to be done for T and X-editing. */
+ int pending_spaces;
+ /* Whether an EOR condition was encountered. Value is:
+ 0 if no EOR was encountered
+ 1 if an EOR was encountered due to a 1-byte marker (LF)
+ 2 if an EOR was encountered due to a 2-bytes marker (CRLF) */
+ int sf_seen_eor;
+ unit_advance advance_status;
+ unsigned reversion_flag : 1; /* Format reversion has occurred. */
+ unsigned first_item : 1;
+ unsigned seen_dollar : 1;
+ unsigned eor_condition : 1;
+ unsigned no_leading_blank : 1;
+ unsigned char_flag : 1;
+ unsigned input_complete : 1;
+ unsigned at_eol : 1;
+ unsigned comma_flag : 1;
+ /* A namelist specific flag used in the list directed library
+ to flag that calls are being made from namelist read (eg. to
+ ignore comments or to treat '/' as a terminator) */
+ unsigned namelist_mode : 1;
+ /* A namelist specific flag used in the list directed library
+ to flag read errors and return, so that an attempt can be
+ made to read a new object name. */
+ unsigned nml_read_error : 1;
+ /* A sequential formatted read specific flag used to signal that a
+ character string is being read so don't use commas to shorten a
+ formatted field width. */
+ unsigned sf_read_comma : 1;
+ /* A namelist specific flag used to enable reading input from
+ line_buffer for logical reads. */
+ unsigned line_buffer_enabled : 1;
+ /* An internal unit specific flag used to identify that the associated
+ unit is internal. */
+ unsigned unit_is_internal : 1;
+ /* An internal unit specific flag to signify an EOF condition for list
+ directed read. */
+ unsigned at_eof : 1;
+ /* 16 unused bits. */
+
+ char last_char;
+ char nml_delim;
+
+ int repeat_count;
+ int saved_length;
+ int saved_used;
+ bt saved_type;
+ char *saved_string;
+ char *scratch;
+ char *line_buffer;
+ struct format_data *fmt;
+ jmp_buf *eof_jump;
+ namelist_info *ionml;
+ /* A flag used to identify when a non-standard expanded namelist read
+ has occurred. */
+ int expanded_read;
+ /* Storage area for values except for strings. Must be large
+ enough to hold a complex value (two reals) of the largest
+ kind. */
+ char value[32];
+ GFC_IO_INT size_used;
+ } p;
/* This pad size must be equal to the pad_size declared in
trans-io.c (gfc_build_io_library_fndecls). The above structure
must be smaller or equal to this array. */
- char pad[32 * sizeof (char *) + 32 * sizeof (int)];
+ char pad[16 * sizeof (char *) + 32 * sizeof (int)];
} u;
+ GFC_INTEGER_4 *id;
+ GFC_IO_INT pos;
+ CHARACTER1 (asynchronous);
+ CHARACTER2 (blank);
+ CHARACTER1 (decimal);
+ CHARACTER2 (delim);
+ CHARACTER1 (pad);
+ CHARACTER2 (round);
+ CHARACTER1 (sign);
}
st_parameter_dt;
--- libgfortran/io/transfer.c.jj 2008-11-17 08:37:27.000000000 +0100
+++ libgfortran/io/transfer.c 2008-11-21 11:38:05.000000000 +0100
@@ -300,7 +300,7 @@ read_sf (st_parameter_dt *dtp, int *leng
dtp->u.p.current_unit->bytes_left -= *length;
if ((dtp->common.flags & IOPARM_DT_HAS_SIZE) != 0)
- dtp->u.p.size_used += (gfc_offset) *length;
+ dtp->u.p.size_used += (GFC_IO_INT) *length;
return base;
}
@@ -377,7 +377,7 @@ read_block_form (st_parameter_dt *dtp, v
}
if ((dtp->common.flags & IOPARM_DT_HAS_SIZE) != 0)
- dtp->u.p.size_used += (gfc_offset) nread;
+ dtp->u.p.size_used += (GFC_IO_INT) nread;
if (nread != *nbytes)
{ /* Short read, this shouldn't happen. */
@@ -625,7 +625,7 @@ write_block (st_parameter_dt *dtp, int l
}
if ((dtp->common.flags & IOPARM_DT_HAS_SIZE) != 0)
- dtp->u.p.size_used += (gfc_offset) length;
+ dtp->u.p.size_used += (GFC_IO_INT) length;
dtp->u.p.current_unit->strm_pos += (gfc_offset) length;
@@ -1829,11 +1829,7 @@ data_transfer_init (st_parameter_dt *dtp
ionml = ((cf & IOPARM_DT_IONML_SET) != 0) ? dtp->u.p.ionml : NULL;
- /* To maintain ABI, &transfer is the start of the private memory area in
- in st_parameter_dt. Memory from the beginning of the structure to this
- point is set by the front end and must not be touched. The number of
- bytes to clear must stay within the sizeof q to avoid over-writing. */
- memset (&dtp->u.p.transfer, 0, sizeof (dtp->u.q));
+ memset (&dtp->u.p, 0, sizeof (dtp->u.p));
dtp->u.p.ionml = ionml;
dtp->u.p.mode = read_flag ? READING : WRITING;
@@ -2077,7 +2073,7 @@ data_transfer_init (st_parameter_dt *dtp
/* Check the decimal mode. */
dtp->u.p.current_unit->decimal_status
= !(cf & IOPARM_DT_HAS_DECIMAL) ? DECIMAL_UNSPECIFIED :
- find_option (&dtp->common, dtp->u.p.decimal, dtp->u.p.decimal_len,
+ find_option (&dtp->common, dtp->decimal, dtp->decimal_len,
decimal_opt, "Bad DECIMAL parameter in data transfer "
"statement");
@@ -2087,7 +2083,7 @@ data_transfer_init (st_parameter_dt *dtp
/* Check the sign mode. */
dtp->u.p.sign_status
= !(cf & IOPARM_DT_HAS_SIGN) ? SIGN_UNSPECIFIED :
- find_option (&dtp->common, dtp->u.p.sign, dtp->u.p.sign_len, sign_opt,
+ find_option (&dtp->common, dtp->sign, dtp->sign_len, sign_opt,
"Bad SIGN parameter in data transfer statement");
if (dtp->u.p.sign_status == SIGN_UNSPECIFIED)
@@ -2096,7 +2092,7 @@ data_transfer_init (st_parameter_dt *dtp
/* Check the blank mode. */
dtp->u.p.blank_status
= !(cf & IOPARM_DT_HAS_BLANK) ? BLANK_UNSPECIFIED :
- find_option (&dtp->common, dtp->u.p.blank, dtp->u.p.blank_len,
+ find_option (&dtp->common, dtp->blank, dtp->blank_len,
blank_opt,
"Bad BLANK parameter in data transfer statement");
@@ -2106,7 +2102,7 @@ data_transfer_init (st_parameter_dt *dtp
/* Check the delim mode. */
dtp->u.p.current_unit->delim_status
= !(cf & IOPARM_DT_HAS_DELIM) ? DELIM_UNSPECIFIED :
- find_option (&dtp->common, dtp->u.p.delim, dtp->u.p.delim_len,
+ find_option (&dtp->common, dtp->delim, dtp->delim_len,
delim_opt, "Bad DELIM parameter in data transfer statement");
if (dtp->u.p.current_unit->delim_status == DELIM_UNSPECIFIED)
@@ -2115,7 +2111,7 @@ data_transfer_init (st_parameter_dt *dtp
/* Check the pad mode. */
dtp->u.p.current_unit->pad_status
= !(cf & IOPARM_DT_HAS_PAD) ? PAD_UNSPECIFIED :
- find_option (&dtp->common, dtp->u.p.pad, dtp->u.p.pad_len, pad_opt,
+ find_option (&dtp->common, dtp->pad, dtp->pad_len, pad_opt,
"Bad PAD parameter in data transfer statement");
if (dtp->u.p.current_unit->pad_status == PAD_UNSPECIFIED)
@@ -2858,7 +2854,7 @@ finalize_transfer (st_parameter_dt *dtp)
GFC_INTEGER_4 cf = dtp->common.flags;
if ((dtp->common.flags & IOPARM_DT_HAS_SIZE) != 0)
- *dtp->size = (GFC_IO_INT) dtp->u.p.size_used;
+ *dtp->size = dtp->u.p.size_used;
if (dtp->u.p.eor_condition)
{
--- libgfortran/io/file_pos.c.jj 2008-10-20 16:59:11.000000000 +0200
+++ libgfortran/io/file_pos.c 2008-11-21 10:31:14.000000000 +0100
@@ -300,7 +300,7 @@ st_endfile (st_parameter_filepos *fpp)
{
st_parameter_dt dtp;
dtp.common = fpp->common;
- memset (&dtp.u.p.transfer, 0, sizeof (dtp.u.q));
+ memset (&dtp.u.p, 0, sizeof (dtp.u.p));
dtp.u.p.current_unit = u;
next_record (&dtp, 1);
}
Jakub
More information about the Gcc-patches
mailing list