------- Comment #7 from pault at gcc dot gnu dot org 2007-05-22 21:56 -------
The patch below does the job but needs some sorting out. In particular, the
function call generated by the calculation of the character length needs to be
supressed, in case the function has side effects.
It's regtesting now but I am pretty sure that it is OK.
Paul
Index: gcc/fortran/trans-array.c
===================================================================
*** gcc/fortran/trans-array.c (revision 124953)
--- gcc/fortran/trans-array.c (working copy)
*************** get_array_ctor_var_strlen (gfc_expr * ex
*** 1368,1374 ****
Returns TRUE if all elements are character constants. */
bool
! get_array_ctor_strlen (gfc_constructor * c, tree * len)
{
bool is_const;
--- 1368,1374 ----
Returns TRUE if all elements are character constants. */
bool
! get_array_ctor_strlen (stmtblock_t * block, gfc_constructor * c, tree * len)
{
bool is_const;
*************** get_array_ctor_strlen (gfc_constructor *
*** 1384,1390 ****
break;
case EXPR_ARRAY:
! if (!get_array_ctor_strlen (c->expr->value.constructor, len))
is_const = false;
break;
--- 1384,1390 ----
break;
case EXPR_ARRAY:
! if (!get_array_ctor_strlen (block, c->expr->value.constructor, len))
is_const = false;
break;
*************** get_array_ctor_strlen (gfc_constructor *
*** 1396,1411 ****
default:
is_const = false;
- /* Hope that whatever we have possesses a constant character
- length! */
if (!(*len && INTEGER_CST_P (*len)) && c->expr->ts.cl)
{
! gfc_conv_const_charlen (c->expr->ts.cl);
! *len = c->expr->ts.cl->backend_decl;
}
! /* TODO: For now we just ignore anything we don't know how to
! handle, and hope we can figure it out a different way. */
! break;
}
}
--- 1396,1418 ----
default:
is_const = false;
if (!(*len && INTEGER_CST_P (*len)) && c->expr->ts.cl)
{
! gfc_se argse;
! gfc_ss *ss;
! ss = gfc_walk_expr (c->expr);
! gfc_init_se (&argse, NULL);
! if (ss == gfc_ss_terminator)
! gfc_conv_expr (&argse, c->expr);
! else
! gfc_conv_expr_descriptor (&argse, c->expr, ss);
! *len = gfc_evaluate_now (argse.string_length, &argse.pre);
! gfc_add_block_to_block (block, &argse.pre);
! gfc_add_block_to_block (block, &argse.post);
! c->expr->ts.cl->backend_decl = *len;
}
!
! break;
}
}
*************** gfc_trans_array_constructor (gfc_loopinf
*** 1595,1604 ****
c = ss->expr->value.constructor;
if (ss->expr->ts.type == BT_CHARACTER)
{
! bool const_string = get_array_ctor_strlen (c, &ss->string_length);
if (!ss->string_length)
gfc_todo_error ("complex character array constructors");
type = gfc_get_character_type_len (ss->expr->ts.kind,
ss->string_length);
if (const_string)
type = build_pointer_type (type);
--- 1602,1614 ----
c = ss->expr->value.constructor;
if (ss->expr->ts.type == BT_CHARACTER)
{
! bool const_string = get_array_ctor_strlen (&loop->pre, c,
&ss->string_length);
if (!ss->string_length)
gfc_todo_error ("complex character array constructors");
+ ss->expr->ts.cl->backend_decl = ss->string_length;
+
+
type = gfc_get_character_type_len (ss->expr->ts.kind,
ss->string_length);
if (const_string)
type = build_pointer_type (type);
Index: gcc/fortran/trans.h
===================================================================
*** gcc/fortran/trans.h (revision 124953)
--- gcc/fortran/trans.h (working copy)
*************** extern GTY(()) tree gfc_static_ctors;
*** 434,440 ****
void gfc_generate_constructors (void);
/* Get the string length of an array constructor. */
! bool get_array_ctor_strlen (gfc_constructor *, tree *);
/* Generate a runtime error check. */
void gfc_trans_runtime_check (tree, const char *, stmtblock_t *, locus *);
--- 434,440 ----
void gfc_generate_constructors (void);
/* Get the string length of an array constructor. */
! bool get_array_ctor_strlen (stmtblock_t *, gfc_constructor *, tree *);
/* Generate a runtime error check. */
void gfc_trans_runtime_check (tree, const char *, stmtblock_t *, locus *);
Index: gcc/fortran/trans-intrinsic.c
===================================================================
*** gcc/fortran/trans-intrinsic.c (revision 124953)
--- gcc/fortran/trans-intrinsic.c (working copy)
*************** gfc_conv_intrinsic_len (gfc_se * se, gfc
*** 2537,2543 ****
/* Obtain the string length from the function used by
trans-array.c(gfc_trans_array_constructor). */
len = NULL_TREE;
! get_array_ctor_strlen (arg->value.constructor, &len);
break;
case EXPR_VARIABLE:
--- 2537,2543 ----
/* Obtain the string length from the function used by
trans-array.c(gfc_trans_array_constructor). */
len = NULL_TREE;
! get_array_ctor_strlen (&se->pre, arg->value.constructor, &len);
break;
case EXPR_VARIABLE:
--
pault at gcc dot gnu dot org changed:
What |Removed |Added
----------------------------------------------------------------------------
AssignedTo|unassigned at gcc dot gnu |pault at gcc dot gnu dot org
|dot org |
Status|REOPENED |ASSIGNED
Last reconfirmed|2007-03-16 15:23:52 |2007-05-22 21:56:32
date| |
http://gcc.gnu.org/bugzilla/show_bug.cgi?id=31219
