procyberian/gcc
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

re PR libfortran/37839 (st_parameter_dt has unwanted padding, is out of sync with compiler)

Browse source 
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.

From-SVN: r142111
This commit is contained in:
Jakub Jelinek 2008-11-22 09:10:41 +01:00 • committed by Jakub Jelinek
parent 220904438f
commit e14568432a
16 changed files with 187 additions and 208 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

13
gcc/fortran/ChangeLog
View file

@ -1,3 +1,16 @@
2008-11-22 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.
2008-11-20 Jakub Jelinek <jakub@redhat.com>
PR middle-end/29215

5
gcc/fortran/io.c
View file

@ -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 *inquire)
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 *inquire)
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)

8
gcc/fortran/ioparm.def
View file

@ -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)

10
gcc/fortran/trans-io.c
View file

@ -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);

10
gcc/testsuite/ChangeLog
View file

@ -1,3 +1,13 @@
2008-11-22 Jakub Jelinek <jakub@redhat.com>
PR libfortran/37839
* 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.
2008-11-21 Jakub Jelinek <jakub@redhat.com>
PR middle-end/38200

21
gcc/testsuite/gfortran.dg/f2003_inquire_1.f03 Normal file
View file

@ -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

1
gcc/testsuite/gfortran.dg/f2003_io_1.f03
View file

@ -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

1
gcc/testsuite/gfortran.dg/f2003_io_4.f03
View file

@ -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

1
gcc/testsuite/gfortran.dg/f2003_io_5.f03
View file

@ -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

1
gcc/testsuite/gfortran.dg/f2003_io_6.f03
View file

@ -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

1
gcc/testsuite/gfortran.dg/f2003_io_7.f03
View file

@ -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

23
libgfortran/ChangeLog
View file

@ -1,3 +1,26 @@
2008-11-22 Jakub Jelinek <jakub@redhat.com>
PR libfortran/37839
* 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.
2008-11-20 Jerry DeLisle <jvdelisle@gcc.gnu.org>
PR libfortran/37472

2
libgfortran/io/file_pos.c
View file

@ -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);
}

6
libgfortran/io/inquire.c
View file

@ -43,7 +43,6 @@ inquire_via_unit (st_parameter_inquire *iqp, gfc_unit * u)
{
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 *iqp, gfc_unit * u)
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_inquire *iqp)
{
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_inquire *iqp)
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);

268
libgfortran/io/io.h
View file

@ -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;

24
libgfortran/io/transfer.c
View file

@ -300,7 +300,7 @@ read_sf (st_parameter_dt *dtp, int *length, int no_error)
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, void *buf, size_t *nbytes)
}
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 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;
dtp->u.p.current_unit->strm_pos += (gfc_offset) length;
@ -1829,11 +1829,7 @@ data_transfer_init (st_parameter_dt *dtp, int read_flag)
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, int read_flag)
/* 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, int read_flag)
/* 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, int read_flag)
/* 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, int read_flag)
/* 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, int read_flag)
/* 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)
{