[Patch, fortran] PR31219 - ICE on array of character function results
Paul Richard Thomas
paul.richard.thomas@gmail.com
Wed May 23 10:21:00 GMT 2007
:ADDPATCH fortran:
This problem was caused by the character length of a procedure result
being used for an array constructor character length. If this were
not constant, an ICE would ensue because the function result is out of
scope. Instead, the function must be called and the string length
calculated by the interface routines in trans-expr.c. Since the
function call is not required and could produce unwanted side-effects
this is suppressed by a new bitfield in gfc_se. The testcase is the
reporter's.
Regtested on FC5/x86_ia64 - OK for trunk?
Thanks for the report, Jost.
Paul
2007-05-23 Paul Thomas <pault@gcc.gnu.org>
PR fortran/31219
* trans.h : Add no_function_call bitfield to gfc_se structure.
Add stmtblock_t argument to prototype of get_array_ctor_strlen.
* trans-array.c (get_array_ctor_all_strlen): New function.
(get_array_ctor_strlen): Add new stmtblock_t argument and call
new function for character elements that are not constants,
arrays or variables.
* trans-intrinsic (gfc_conv_intrinsic_len): Add new argument
to call of get_array_ctor_strlen.
2007-05-23 Paul Thomas <pault@gcc.gnu.org>
PR fortran/31219
* gfortran.dg/array_constructor_17.f90: New test.
-------------- next part --------------
Index: gcc/fortran/trans.h
===================================================================
*** gcc/fortran/trans.h (r?vision 124902)
--- gcc/fortran/trans.h (copie de travail)
*************** typedef struct gfc_se
*** 72,77 ****
--- 72,80 ----
are NULL. Used by intrinsic size. */
unsigned data_not_needed:1;
+ /* If set, gfc_conv_function_call does not put byref calls into se->pre. */
+ unsigned no_function_call:1;
+
/* Scalarization parameters. */
struct gfc_se *parent;
struct gfc_ss *ss;
*************** 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 *);
--- 437,443 ----
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-array.c
===================================================================
*** gcc/fortran/trans-array.c (r?vision 124903)
--- gcc/fortran/trans-array.c (copie de travail)
*************** get_array_ctor_var_strlen (gfc_expr * ex
*** 1364,1374 ****
}
/* Figure out the string length of a character array constructor.
Returns TRUE if all elements are character constants. */
bool
! get_array_ctor_strlen (gfc_constructor * c, tree * len)
{
bool is_const;
--- 1364,1417 ----
}
+ /* A catch-all to obtain the string length for anything that is not a
+ constant, array or variable. */
+ static void
+ get_array_ctor_all_strlen (stmtblock_t *block, gfc_expr *e, tree *len)
+ {
+ gfc_se se;
+ gfc_ss *ss;
+
+ /* Don't bother if we already know the length is a constant. */
+ if (*len && INTEGER_CST_P (*len))
+ return;
+
+ if (!e->ref && e->ts.cl->length
+ && e->ts.cl->length->expr_type == EXPR_CONSTANT)
+ {
+ /* This is easy. */
+ gfc_conv_const_charlen (e->ts.cl);
+ *len = e->ts.cl->backend_decl;
+ }
+ else
+ {
+ /* Otherwise, be brutal even if inefficient. */
+ ss = gfc_walk_expr (e);
+ gfc_init_se (&se, NULL);
+
+ /* No function call, in case of side effects. */
+ se.no_function_call = 1;
+ if (ss == gfc_ss_terminator)
+ gfc_conv_expr (&se, e);
+ else
+ gfc_conv_expr_descriptor (&se, e, ss);
+
+ /* Fix the value. */
+ *len = gfc_evaluate_now (se.string_length, &se.pre);
+
+ gfc_add_block_to_block (block, &se.pre);
+ gfc_add_block_to_block (block, &se.post);
+
+ e->ts.cl->backend_decl = *len;
+ }
+ }
+
+
/* Figure out the string length of a character array constructor.
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;
--- 1427,1433 ----
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 *
*** 1395,1410 ****
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;
}
}
--- 1438,1444 ----
default:
is_const = false;
! get_array_ctor_all_strlen (block, c->expr, len);
break;
}
}
*************** gfc_trans_array_constructor (gfc_loopinf
*** 1595,1603 ****
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)
--- 1629,1640 ----
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)
Index: gcc/fortran/trans-intrinsic.c
===================================================================
*** gcc/fortran/trans-intrinsic.c (r?vision 124902)
--- gcc/fortran/trans-intrinsic.c (copie de travail)
*************** 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:
Index: gcc/testsuite/gfortran.dg/array_constructor_17.f90
===================================================================
*** gcc/testsuite/gfortran.dg/array_constructor_17.f90 (r?vision 0)
--- gcc/testsuite/gfortran.dg/array_constructor_17.f90 (r?vision 0)
***************
*** 0 ****
--- 1,23 ----
+ ! { dg-do run }
+ ! Tests the fix for PR31219, in which the character length of
+ ! the functions in the array constructor was not being obtained
+ ! correctly and this caused an ICE.
+ !
+ ! Contributed by Joost VandeVondele <jv244@cam.ac.uk>
+ !
+ INTEGER :: J
+ CHARACTER(LEN = 8) :: str
+ J = 3
+ write (str,'(2A4)') (/( F(I, J), I = 1, 2)/)
+ IF (str .NE. " ODD EVE") call abort ()
+ CONTAINS
+ FUNCTION F (K,J) RESULT(I)
+ INTEGER :: K, J
+ CHARACTER(LEN = J) :: I
+ IF (MODULO (K, 2) .EQ. 0) THEN
+ I = "EVEN"
+ ELSE
+ I = "ODD"
+ ENDIF
+ END FUNCTION
+ END
More information about the Fortran
mailing list