Commit e1456843 by Jakub Jelinek Committed by Jakub Jelinek

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

	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
parent 22090443
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> 2008-11-20 Jakub Jelinek <jakub@redhat.com>
PR middle-end/29215 PR middle-end/29215
......
...@@ -3540,9 +3540,11 @@ gfc_free_inquire (gfc_inquire *inquire) ...@@ -3540,9 +3540,11 @@ gfc_free_inquire (gfc_inquire *inquire)
gfc_free_expr (inquire->convert); gfc_free_expr (inquire->convert);
gfc_free_expr (inquire->strm_pos); gfc_free_expr (inquire->strm_pos);
gfc_free_expr (inquire->asynchronous); gfc_free_expr (inquire->asynchronous);
gfc_free_expr (inquire->decimal);
gfc_free_expr (inquire->pending); gfc_free_expr (inquire->pending);
gfc_free_expr (inquire->id); gfc_free_expr (inquire->id);
gfc_free_expr (inquire->sign); gfc_free_expr (inquire->sign);
gfc_free_expr (inquire->size);
gfc_free_expr (inquire->round); gfc_free_expr (inquire->round);
gfc_free (inquire); gfc_free (inquire);
} }
...@@ -3584,7 +3586,7 @@ match_inquire_element (gfc_inquire *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_async, &inquire->asynchronous);
RETM m = match_vtag (&tag_s_delim, &inquire->delim); RETM m = match_vtag (&tag_s_delim, &inquire->delim);
RETM m = match_vtag (&tag_s_decimal, &inquire->decimal); 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_encoding, &inquire->encoding);
RETM m = match_vtag (&tag_s_round, &inquire->round); RETM m = match_vtag (&tag_s_round, &inquire->round);
RETM m = match_vtag (&tag_s_sign, &inquire->sign); RETM m = match_vtag (&tag_s_sign, &inquire->sign);
...@@ -3761,6 +3763,7 @@ gfc_resolve_inquire (gfc_inquire *inquire) ...@@ -3761,6 +3763,7 @@ gfc_resolve_inquire (gfc_inquire *inquire)
RESOLVE_TAG (&tag_s_sign, inquire->sign); RESOLVE_TAG (&tag_s_sign, inquire->sign);
RESOLVE_TAG (&tag_s_round, inquire->round); RESOLVE_TAG (&tag_s_round, inquire->round);
RESOLVE_TAG (&tag_pending, inquire->pending); RESOLVE_TAG (&tag_pending, inquire->pending);
RESOLVE_TAG (&tag_size, inquire->size);
RESOLVE_TAG (&tag_id, inquire->id); RESOLVE_TAG (&tag_id, inquire->id);
if (gfc_reference_st_label (inquire->err, ST_LABEL_TARGET) == FAILURE) if (gfc_reference_st_label (inquire->err, ST_LABEL_TARGET) == FAILURE)
......
...@@ -63,9 +63,9 @@ IOPARM (inquire, flags2, 1 << 31, int4) ...@@ -63,9 +63,9 @@ IOPARM (inquire, flags2, 1 << 31, int4)
IOPARM (inquire, asynchronous, 1 << 0, char1) IOPARM (inquire, asynchronous, 1 << 0, char1)
IOPARM (inquire, decimal, 1 << 1, char2) IOPARM (inquire, decimal, 1 << 1, char2)
IOPARM (inquire, encoding, 1 << 2, char1) IOPARM (inquire, encoding, 1 << 2, char1)
IOPARM (inquire, pending, 1 << 3, pint4) IOPARM (inquire, round, 1 << 3, char2)
IOPARM (inquire, round, 1 << 4, char1) IOPARM (inquire, sign, 1 << 4, char1)
IOPARM (inquire, sign, 1 << 5, char2) IOPARM (inquire, pending, 1 << 5, pint4)
IOPARM (inquire, size, 1 << 6, pint4) IOPARM (inquire, size, 1 << 6, pint4)
IOPARM (inquire, id, 1 << 7, pint4) IOPARM (inquire, id, 1 << 7, pint4)
IOPARM (wait, common, 0, common) IOPARM (wait, common, 0, common)
...@@ -83,6 +83,7 @@ IOPARM (dt, format, 1 << 12, char1) ...@@ -83,6 +83,7 @@ IOPARM (dt, format, 1 << 12, char1)
IOPARM (dt, advance, 1 << 13, char2) IOPARM (dt, advance, 1 << 13, char2)
IOPARM (dt, internal_unit, 1 << 14, char1) IOPARM (dt, internal_unit, 1 << 14, char1)
IOPARM (dt, namelist_name, 1 << 15, char2) IOPARM (dt, namelist_name, 1 << 15, char2)
IOPARM (dt, u, 0, pad)
IOPARM (dt, id, 1 << 16, pint4) IOPARM (dt, id, 1 << 16, pint4)
IOPARM (dt, pos, 1 << 17, intio) IOPARM (dt, pos, 1 << 17, intio)
IOPARM (dt, asynchronous, 1 << 18, char1) IOPARM (dt, asynchronous, 1 << 18, char1)
...@@ -92,4 +93,3 @@ IOPARM (dt, delim, 1 << 21, char2) ...@@ -92,4 +93,3 @@ IOPARM (dt, delim, 1 << 21, char2)
IOPARM (dt, pad, 1 << 22, char1) IOPARM (dt, pad, 1 << 22, char1)
IOPARM (dt, round, 1 << 23, char2) IOPARM (dt, round, 1 << 23, char2)
IOPARM (dt, sign, 1 << 24, char1) IOPARM (dt, sign, 1 << 24, char1)
IOPARM (dt, u, 0, pad)
...@@ -291,9 +291,9 @@ gfc_build_io_library_fndecls (void) ...@@ -291,9 +291,9 @@ gfc_build_io_library_fndecls (void)
= build_pointer_type (gfc_intio_type_node); = build_pointer_type (gfc_intio_type_node);
types[IOPARM_type_parray] = pchar_type_node; types[IOPARM_type_parray] = pchar_type_node;
types[IOPARM_type_pchar] = 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_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); types[IOPARM_type_pad] = build_array_type (char_type_node, pad_idx);
/* pad actually contains pointers and integers so it needs to have an /* pad actually contains pointers and integers so it needs to have an
...@@ -301,7 +301,7 @@ gfc_build_io_library_fndecls (void) ...@@ -301,7 +301,7 @@ gfc_build_io_library_fndecls (void)
types. See the st_parameter_dt structure in libgfortran/io/io.h for types. See the st_parameter_dt structure in libgfortran/io/io.h for
what really goes into this space. */ what really goes into this space. */
TYPE_ALIGN (types[IOPARM_type_pad]) = MAX (TYPE_ALIGN (pchar_type_node), 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++) for (ptype = IOPARM_ptype_common; ptype < IOPARM_ptype_num; ptype++)
gfc_build_st_parameter (ptype, types); gfc_build_st_parameter (ptype, types);
...@@ -1315,10 +1315,8 @@ gfc_trans_inquire (gfc_code * code) ...@@ -1315,10 +1315,8 @@ gfc_trans_inquire (gfc_code * code)
mask2 |= set_parameter_ref (&block, &post_block,var, IOPARM_inquire_id, mask2 |= set_parameter_ref (&block, &post_block,var, IOPARM_inquire_id,
p->id); p->id);
set_parameter_const (&block, var, IOPARM_inquire_flags2, mask2);
if (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); set_parameter_const (&block, var, IOPARM_common_flags, mask);
......
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> 2008-11-21 Jakub Jelinek <jakub@redhat.com>
PR middle-end/38200 PR middle-end/38200
......
! { 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
! { dg-do run { target fd_truncate } } ! { dg-do run { target fd_truncate } }
! { dg-options "-std=gnu" } ! { 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> ! Test case prepared by Jerry DeLisle <jvdelisle@gcc.gnu.org>
real :: a(4), b(4) real :: a(4), b(4)
real :: c real :: c
......
! { dg-do run { target fd_truncate } } ! { 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 case prepared by Jerry DeLisle <jvdelisle@gcc.gnu.org>
! Test of decimal= feature ! Test of decimal= feature
......
! { dg-do run { target fd_truncate } } ! { 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 case prepared by Jerry DeLisle <jvdelisle@gcc.gnu.org>
! Test of decimal="comma" in namelist and complex ! Test of decimal="comma" in namelist and complex
integer :: i integer :: i
......
! { dg-do run } ! { 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 case prepared by Jerry DeLisle <jvdelisle@gcc.gnu.org>
! Test of decimal="comma" in namelist, checks separators ! Test of decimal="comma" in namelist, checks separators
implicit none implicit none
......
! { dg-do run { target fd_truncate } } ! { 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 case prepared by Jerry DeLisle <jvdelisle@gcc.gnu.org>
! Test of sign=, decimal=, and blank= . ! Test of sign=, decimal=, and blank= .
program iotests program iotests
......
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> 2008-11-20 Jerry DeLisle <jvdelisle@gcc.gnu.org>
PR libfortran/37472 PR libfortran/37472
......
...@@ -300,7 +300,7 @@ st_endfile (st_parameter_filepos *fpp) ...@@ -300,7 +300,7 @@ st_endfile (st_parameter_filepos *fpp)
{ {
st_parameter_dt dtp; st_parameter_dt dtp;
dtp.common = fpp->common; 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; dtp.u.p.current_unit = u;
next_record (&dtp, 1); next_record (&dtp, 1);
} }
......
...@@ -43,7 +43,6 @@ inquire_via_unit (st_parameter_inquire *iqp, gfc_unit * u) ...@@ -43,7 +43,6 @@ inquire_via_unit (st_parameter_inquire *iqp, gfc_unit * u)
{ {
const char *p; const char *p;
GFC_INTEGER_4 cf = iqp->common.flags; GFC_INTEGER_4 cf = iqp->common.flags;
GFC_INTEGER_4 cf2 = iqp->flags2;
if ((cf & IOPARM_INQUIRE_HAS_EXIST) != 0) if ((cf & IOPARM_INQUIRE_HAS_EXIST) != 0)
{ {
...@@ -254,6 +253,8 @@ inquire_via_unit (st_parameter_inquire *iqp, gfc_unit * u) ...@@ -254,6 +253,8 @@ inquire_via_unit (st_parameter_inquire *iqp, gfc_unit * u)
if (cf & IOPARM_INQUIRE_HAS_FLAGS2) if (cf & IOPARM_INQUIRE_HAS_FLAGS2)
{ {
GFC_INTEGER_4 cf2 = iqp->flags2;
if ((cf2 & IOPARM_INQUIRE_HAS_PENDING) != 0) if ((cf2 & IOPARM_INQUIRE_HAS_PENDING) != 0)
*iqp->pending = 0; *iqp->pending = 0;
...@@ -525,7 +526,6 @@ inquire_via_filename (st_parameter_inquire *iqp) ...@@ -525,7 +526,6 @@ inquire_via_filename (st_parameter_inquire *iqp)
{ {
const char *p; const char *p;
GFC_INTEGER_4 cf = iqp->common.flags; GFC_INTEGER_4 cf = iqp->common.flags;
GFC_INTEGER_4 cf2 = iqp->flags2;
if ((cf & IOPARM_INQUIRE_HAS_EXIST) != 0) if ((cf & IOPARM_INQUIRE_HAS_EXIST) != 0)
*iqp->exist = file_exists (iqp->file, iqp->file_len); *iqp->exist = file_exists (iqp->file, iqp->file_len);
...@@ -586,6 +586,8 @@ inquire_via_filename (st_parameter_inquire *iqp) ...@@ -586,6 +586,8 @@ inquire_via_filename (st_parameter_inquire *iqp)
if (cf & IOPARM_INQUIRE_HAS_FLAGS2) if (cf & IOPARM_INQUIRE_HAS_FLAGS2)
{ {
GFC_INTEGER_4 cf2 = iqp->flags2;
if ((cf2 & IOPARM_INQUIRE_HAS_ENCODING) != 0) if ((cf2 & IOPARM_INQUIRE_HAS_ENCODING) != 0)
cf_strcpy (iqp->encoding, iqp->encoding_len, undefined); cf_strcpy (iqp->encoding, iqp->encoding_len, undefined);
......
...@@ -300,7 +300,7 @@ read_sf (st_parameter_dt *dtp, int *length, int no_error) ...@@ -300,7 +300,7 @@ read_sf (st_parameter_dt *dtp, int *length, int no_error)
dtp->u.p.current_unit->bytes_left -= *length; dtp->u.p.current_unit->bytes_left -= *length;
if ((dtp->common.flags & IOPARM_DT_HAS_SIZE) != 0) 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; return base;
} }
...@@ -377,7 +377,7 @@ read_block_form (st_parameter_dt *dtp, void *buf, size_t *nbytes) ...@@ -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) 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) if (nread != *nbytes)
{ /* Short read, this shouldn't happen. */ { /* Short read, this shouldn't happen. */
...@@ -625,7 +625,7 @@ write_block (st_parameter_dt *dtp, int length) ...@@ -625,7 +625,7 @@ write_block (st_parameter_dt *dtp, int length)
} }
if ((dtp->common.flags & IOPARM_DT_HAS_SIZE) != 0) 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; dtp->u.p.current_unit->strm_pos += (gfc_offset) length;
...@@ -1829,11 +1829,7 @@ data_transfer_init (st_parameter_dt *dtp, int read_flag) ...@@ -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; 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 memset (&dtp->u.p, 0, sizeof (dtp->u.p));
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));
dtp->u.p.ionml = ionml; dtp->u.p.ionml = ionml;
dtp->u.p.mode = read_flag ? READING : WRITING; dtp->u.p.mode = read_flag ? READING : WRITING;
...@@ -2077,7 +2073,7 @@ data_transfer_init (st_parameter_dt *dtp, int read_flag) ...@@ -2077,7 +2073,7 @@ data_transfer_init (st_parameter_dt *dtp, int read_flag)
/* Check the decimal mode. */ /* Check the decimal mode. */
dtp->u.p.current_unit->decimal_status dtp->u.p.current_unit->decimal_status
= !(cf & IOPARM_DT_HAS_DECIMAL) ? DECIMAL_UNSPECIFIED : = !(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 " decimal_opt, "Bad DECIMAL parameter in data transfer "
"statement"); "statement");
...@@ -2087,7 +2083,7 @@ data_transfer_init (st_parameter_dt *dtp, int read_flag) ...@@ -2087,7 +2083,7 @@ data_transfer_init (st_parameter_dt *dtp, int read_flag)
/* Check the sign mode. */ /* Check the sign mode. */
dtp->u.p.sign_status dtp->u.p.sign_status
= !(cf & IOPARM_DT_HAS_SIGN) ? SIGN_UNSPECIFIED : = !(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"); "Bad SIGN parameter in data transfer statement");
if (dtp->u.p.sign_status == SIGN_UNSPECIFIED) if (dtp->u.p.sign_status == SIGN_UNSPECIFIED)
...@@ -2096,7 +2092,7 @@ data_transfer_init (st_parameter_dt *dtp, int read_flag) ...@@ -2096,7 +2092,7 @@ data_transfer_init (st_parameter_dt *dtp, int read_flag)
/* Check the blank mode. */ /* Check the blank mode. */
dtp->u.p.blank_status dtp->u.p.blank_status
= !(cf & IOPARM_DT_HAS_BLANK) ? BLANK_UNSPECIFIED : = !(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, blank_opt,
"Bad BLANK parameter in data transfer statement"); "Bad BLANK parameter in data transfer statement");
...@@ -2106,7 +2102,7 @@ data_transfer_init (st_parameter_dt *dtp, int read_flag) ...@@ -2106,7 +2102,7 @@ data_transfer_init (st_parameter_dt *dtp, int read_flag)
/* Check the delim mode. */ /* Check the delim mode. */
dtp->u.p.current_unit->delim_status dtp->u.p.current_unit->delim_status
= !(cf & IOPARM_DT_HAS_DELIM) ? DELIM_UNSPECIFIED : = !(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"); delim_opt, "Bad DELIM parameter in data transfer statement");
if (dtp->u.p.current_unit->delim_status == DELIM_UNSPECIFIED) if (dtp->u.p.current_unit->delim_status == DELIM_UNSPECIFIED)
...@@ -2115,7 +2111,7 @@ data_transfer_init (st_parameter_dt *dtp, int read_flag) ...@@ -2115,7 +2111,7 @@ data_transfer_init (st_parameter_dt *dtp, int read_flag)
/* Check the pad mode. */ /* Check the pad mode. */
dtp->u.p.current_unit->pad_status dtp->u.p.current_unit->pad_status
= !(cf & IOPARM_DT_HAS_PAD) ? PAD_UNSPECIFIED : = !(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"); "Bad PAD parameter in data transfer statement");
if (dtp->u.p.current_unit->pad_status == PAD_UNSPECIFIED) if (dtp->u.p.current_unit->pad_status == PAD_UNSPECIFIED)
...@@ -2858,7 +2854,7 @@ finalize_transfer (st_parameter_dt *dtp) ...@@ -2858,7 +2854,7 @@ finalize_transfer (st_parameter_dt *dtp)
GFC_INTEGER_4 cf = dtp->common.flags; GFC_INTEGER_4 cf = dtp->common.flags;
if ((dtp->common.flags & IOPARM_DT_HAS_SIZE) != 0) 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) if (dtp->u.p.eor_condition)
{ {
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment