re PR fortran/58771 (ICE in transfer_expr, at fortran/trans-io.c:2164)
2013-11-17 Paul Thomas <pault@gcc.gnu.org> PR fortran/58771 * trans-io.c (transfer_expr): If the backend_decl for a derived type is missing, build it with gfc_typenode_for_spec. 2013-11-17 Paul Thomas <pault@gcc.gnu.org> PR fortran/58771 * gfortran.dg/derived_external_function_1.f90 : New test From-SVN: r204913
This commit is contained in:
Paul Thomas
parent
7abc8dd03b
commit
d96c3d282c
|
|
@ -1,3 +1,9 @@
|
|||
2013-11-17 Paul Thomas <pault@gcc.gnu.org>
|
||||
|
||||
PR fortran/58771
|
||||
* trans-io.c (transfer_expr): If the backend_decl for a derived
|
||||
type is missing, build it with gfc_typenode_for_spec.
|
||||
|
||||
2013-11-02 Janus Weil <janus@gcc.gnu.org>
|
||||
|
||||
Backport from mainline
|
||||
|
|
|
|||
|
|
@ -244,16 +244,16 @@ gfc_trans_io_runtime_check (tree cond, tree var, int error_code,
|
|||
|
||||
/* The code to generate the error. */
|
||||
gfc_start_block (&block);
|
||||
|
||||
|
||||
arg1 = gfc_build_addr_expr (NULL_TREE, var);
|
||||
|
||||
|
||||
arg2 = build_int_cst (integer_type_node, error_code),
|
||||
|
||||
|
||||
asprintf (&message, "%s", _(msgid));
|
||||
arg3 = gfc_build_addr_expr (pchar_type_node,
|
||||
gfc_build_localized_cstring_const (message));
|
||||
free (message);
|
||||
|
||||
|
||||
tmp = build_call_expr_loc (input_location,
|
||||
gfor_fndecl_generate_error, 3, arg1, arg2, arg3);
|
||||
|
||||
|
|
@ -522,7 +522,7 @@ set_parameter_value (stmtblock_t *block, tree var, enum iofield type,
|
|||
gfc_trans_io_runtime_check (cond, var, LIBERROR_BAD_UNIT,
|
||||
"Unit number in I/O statement too small",
|
||||
&se.pre);
|
||||
|
||||
|
||||
/* UNIT numbers should be less than the max. */
|
||||
val = gfc_conv_mpz_to_tree (gfc_integer_kinds[i].huge, 4);
|
||||
cond = fold_build2_loc (input_location, GT_EXPR, boolean_type_node,
|
||||
|
|
@ -1002,7 +1002,7 @@ gfc_trans_open (gfc_code * code)
|
|||
if (p->convert)
|
||||
mask |= set_string (&block, &post_block, var, IOPARM_open_convert,
|
||||
p->convert);
|
||||
|
||||
|
||||
if (p->newunit)
|
||||
mask |= set_parameter_ref (&block, &post_block, var, IOPARM_open_newunit,
|
||||
p->newunit);
|
||||
|
|
@ -1236,7 +1236,7 @@ gfc_trans_inquire (gfc_code * code)
|
|||
{
|
||||
mask |= set_parameter_ref (&block, &post_block, var, IOPARM_inquire_exist,
|
||||
p->exist);
|
||||
|
||||
|
||||
if (p->unit && !p->iostat)
|
||||
{
|
||||
p->iostat = create_dummy_iostat ();
|
||||
|
|
@ -1324,7 +1324,7 @@ gfc_trans_inquire (gfc_code * code)
|
|||
if (p->pad)
|
||||
mask |= set_string (&block, &post_block, var, IOPARM_inquire_pad,
|
||||
p->pad);
|
||||
|
||||
|
||||
if (p->convert)
|
||||
mask |= set_string (&block, &post_block, var, IOPARM_inquire_convert,
|
||||
p->convert);
|
||||
|
|
@ -1546,7 +1546,7 @@ transfer_namelist_element (stmtblock_t * block, const char * var_name,
|
|||
tree dtype;
|
||||
tree dt_parm_addr;
|
||||
tree decl = NULL_TREE;
|
||||
int n_dim;
|
||||
int n_dim;
|
||||
int itype;
|
||||
int rank = 0;
|
||||
|
||||
|
|
@ -2029,7 +2029,7 @@ transfer_expr (gfc_se * se, gfc_typespec * ts, tree addr_expr, gfc_code * code)
|
|||
if (gfc_notification_std (GFC_STD_GNU) != SILENT)
|
||||
{
|
||||
gfc_error_now ("Derived type '%s' at %L has PRIVATE components",
|
||||
ts->u.derived->name, code != NULL ? &(code->loc) :
|
||||
ts->u.derived->name, code != NULL ? &(code->loc) :
|
||||
&gfc_current_locus);
|
||||
return;
|
||||
}
|
||||
|
|
@ -2038,7 +2038,7 @@ transfer_expr (gfc_se * se, gfc_typespec * ts, tree addr_expr, gfc_code * code)
|
|||
ts->kind = ts->u.derived->ts.kind;
|
||||
ts->f90_type = ts->u.derived->ts.f90_type;
|
||||
}
|
||||
|
||||
|
||||
kind = ts->kind;
|
||||
function = NULL;
|
||||
arg2 = NULL;
|
||||
|
|
@ -2120,7 +2120,7 @@ transfer_expr (gfc_se * se, gfc_typespec * ts, tree addr_expr, gfc_code * code)
|
|||
function = iocall[IOCALL_X_CHARACTER_WIDE];
|
||||
else
|
||||
function = iocall[IOCALL_X_CHARACTER_WIDE_WRITE];
|
||||
|
||||
|
||||
tmp = gfc_build_addr_expr (NULL_TREE, dt_parm);
|
||||
tmp = build_call_expr_loc (input_location,
|
||||
function, 4, tmp, addr_expr, arg2, arg3);
|
||||
|
|
@ -2152,6 +2152,12 @@ transfer_expr (gfc_se * se, gfc_typespec * ts, tree addr_expr, gfc_code * code)
|
|||
expr = build_fold_indirect_ref_loc (input_location,
|
||||
expr);
|
||||
|
||||
/* Make sure that the derived type has been built. An external
|
||||
function, if only referenced in an io statement requires this
|
||||
check (see PR58771). */
|
||||
if (ts->u.derived->backend_decl == NULL_TREE)
|
||||
tmp = gfc_typenode_for_spec (ts);
|
||||
|
||||
for (c = ts->u.derived->components; c; c = c->next)
|
||||
{
|
||||
field = c->backend_decl;
|
||||
|
|
@ -2287,7 +2293,7 @@ gfc_trans_transfer (gfc_code * code)
|
|||
transfer_array_desc (&se, &expr->ts, tmp);
|
||||
goto finish_block_label;
|
||||
}
|
||||
|
||||
|
||||
/* Initialize the scalarizer. */
|
||||
gfc_init_loopinfo (&loop);
|
||||
gfc_add_ss_to_loop (&loop, ss);
|
||||
|
|
|
|||
|
|
@ -1,3 +1,8 @@
|
|||
2013-11-17 Paul Thomas <pault@gcc.gnu.org>
|
||||
|
||||
PR fortran/58771
|
||||
* gfortran.dg/derived_external_function_1.f90 : New test
|
||||
|
||||
2013-11-02 Janus Weil <janus@gcc.gnu.org>
|
||||
|
||||
Backport from mainline
|
||||
|
|
|
|||
|
|
@ -0,0 +1,27 @@
|
|||
! { dg-do run }
|
||||
!
|
||||
! PR fortran/58771
|
||||
!
|
||||
! Contributed by Vittorio Secca <zeccav@gmail.com>
|
||||
!
|
||||
! ICEd on the write statement with f() because the derived type backend
|
||||
! declaration not built.
|
||||
!
|
||||
module m
|
||||
type t
|
||||
integer(4) g
|
||||
end type
|
||||
end
|
||||
|
||||
type(t) function f() result(ff)
|
||||
use m
|
||||
ff%g = 42
|
||||
end
|
||||
|
||||
use m
|
||||
character (20) :: line1, line2
|
||||
type(t) f
|
||||
write (line1, *) f()
|
||||
write (line2, *) 42_4
|
||||
if (line1 .ne. line2) call abort
|
||||
end
|
||||
Loading…
Reference in New Issue