mirror of git://gcc.gnu.org/git/gcc.git
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
This commit is contained in:
parent
220904438f
commit
e14568432a
|
|
@ -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>
|
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)
|
||||||
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)
|
||||||
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)
|
||||||
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)
|
||||||
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)
|
||||||
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)
|
||||||
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)
|
||||||
= 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)
|
||||||
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)
|
||||||
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);
|
||||||
|
|
||||||
|
|
|
||||||
|
|
@ -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>
|
2008-11-21 Jakub Jelinek <jakub@redhat.com>
|
||||||
|
|
||||||
PR middle-end/38200
|
PR middle-end/38200
|
||||||
|
|
|
||||||
|
|
@ -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,6 +1,5 @@
|
||||||
! { 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
|
||||||
|
|
|
||||||
|
|
@ -1,5 +1,4 @@
|
||||||
! { 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
|
||||||
|
|
||||||
|
|
|
||||||
|
|
@ -1,5 +1,4 @@
|
||||||
! { 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
|
||||||
|
|
|
||||||
|
|
@ -1,5 +1,4 @@
|
||||||
! { 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
|
||||||
|
|
|
||||||
|
|
@ -1,5 +1,4 @@
|
||||||
! { 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
|
||||||
|
|
|
||||||
|
|
@ -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>
|
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)
|
||||||
{
|
{
|
||||||
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)
|
||||||
{
|
{
|
||||||
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)
|
||||||
|
|
||||||
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)
|
||||||
{
|
{
|
||||||
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)
|
||||||
|
|
||||||
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);
|
||||||
|
|
||||||
|
|
|
||||||
|
|
@ -310,9 +310,9 @@ st_parameter_filepos;
|
||||||
#define IOPARM_INQUIRE_HAS_ASYNCHRONOUS (1 << 0)
|
#define IOPARM_INQUIRE_HAS_ASYNCHRONOUS (1 << 0)
|
||||||
#define IOPARM_INQUIRE_HAS_DECIMAL (1 << 1)
|
#define IOPARM_INQUIRE_HAS_DECIMAL (1 << 1)
|
||||||
#define IOPARM_INQUIRE_HAS_ENCODING (1 << 2)
|
#define IOPARM_INQUIRE_HAS_ENCODING (1 << 2)
|
||||||
#define IOPARM_INQUIRE_HAS_PENDING (1 << 3)
|
#define IOPARM_INQUIRE_HAS_ROUND (1 << 3)
|
||||||
#define IOPARM_INQUIRE_HAS_ROUND (1 << 4)
|
#define IOPARM_INQUIRE_HAS_SIGN (1 << 4)
|
||||||
#define IOPARM_INQUIRE_HAS_SIGN (1 << 5)
|
#define IOPARM_INQUIRE_HAS_PENDING (1 << 5)
|
||||||
#define IOPARM_INQUIRE_HAS_SIZE (1 << 6)
|
#define IOPARM_INQUIRE_HAS_SIZE (1 << 6)
|
||||||
#define IOPARM_INQUIRE_HAS_ID (1 << 7)
|
#define IOPARM_INQUIRE_HAS_ID (1 << 7)
|
||||||
|
|
||||||
|
|
@ -343,9 +343,9 @@ typedef struct
|
||||||
CHARACTER1 (asynchronous);
|
CHARACTER1 (asynchronous);
|
||||||
CHARACTER2 (decimal);
|
CHARACTER2 (decimal);
|
||||||
CHARACTER1 (encoding);
|
CHARACTER1 (encoding);
|
||||||
CHARACTER2 (pending);
|
CHARACTER2 (round);
|
||||||
CHARACTER1 (round);
|
CHARACTER1 (sign);
|
||||||
CHARACTER2 (sign);
|
GFC_INTEGER_4 *pending;
|
||||||
GFC_INTEGER_4 *size;
|
GFC_INTEGER_4 *size;
|
||||||
GFC_INTEGER_4 *id;
|
GFC_INTEGER_4 *id;
|
||||||
}
|
}
|
||||||
|
|
@ -377,172 +377,6 @@ struct format_data;
|
||||||
#define IOPARM_DT_IONML_SET (1 << 31)
|
#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
|
typedef struct st_parameter_dt
|
||||||
{
|
{
|
||||||
st_parameter_common common;
|
st_parameter_common common;
|
||||||
|
|
@ -557,13 +391,97 @@ typedef struct st_parameter_dt
|
||||||
to reserve enough space. */
|
to reserve enough space. */
|
||||||
union
|
union
|
||||||
{
|
{
|
||||||
st_parameter_43 q;
|
struct
|
||||||
st_parameter_44 p;
|
{
|
||||||
|
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
|
/* This pad size must be equal to the pad_size declared in
|
||||||
trans-io.c (gfc_build_io_library_fndecls). The above structure
|
trans-io.c (gfc_build_io_library_fndecls). The above structure
|
||||||
must be smaller or equal to this array. */
|
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;
|
} 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;
|
st_parameter_dt;
|
||||||
|
|
||||||
|
|
|
||||||
|
|
@ -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)
|
||||||
}
|
}
|
||||||
|
|
||||||
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)
|
||||||
}
|
}
|
||||||
|
|
||||||
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)
|
||||||
|
|
||||||
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)
|
||||||
/* 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)
|
||||||
/* 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)
|
||||||
/* 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)
|
||||||
/* 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)
|
||||||
/* 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)
|
||||||
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)
|
||||||
{
|
{
|
||||||
|
|
|
||||||
Loading…
Reference in New Issue