This is the mail archive of the
fortran@gcc.gnu.org
mailing list for the GNU Fortran project.
Re: [Patch, fortran] PR31219 - ICE on array of character function results
- From: "Paul Richard Thomas" <paul dot richard dot thomas at gmail dot com>
- To: "Tobias Burnus" <burnus at net-b dot de>
- Cc: "fortran at gcc dot gnu dot org List" <fortran at gcc dot gnu dot org>, "gcc-patches List" <gcc-patches at gcc dot gnu dot org>
- Date: Fri, 25 May 2007 22:13:44 +0200
- Subject: Re: [Patch, fortran] PR31219 - ICE on array of character function results
- Dkim-signature: a=rsa-sha1; c=relaxed/relaxed; d=gmail.com; s=beta; h=domainkey-signature:received:received:message-id:date:from:to:subject:cc:in-reply-to:mime-version:content-type:references; b=nyQF6SDT94S1EBbJC4c0ZYRf9PWQZ66mqDZ5vkApPN/60p/oxcIHLGiCff/tQNFsDlxBSL3oCQCwZUJs8phjTtjmSUv4+rQBmA1vd0ARze2HPCJ8pv53FveRxWxwqEkbLEwMjfNVDnjtMHc2GuEmZdY7GWzFl1oQBVkwMZVm41A=
- Domainkey-signature: a=rsa-sha1; c=nofws; d=gmail.com; s=beta; h=received:message-id:date:from:to:subject:cc:in-reply-to:mime-version:content-type:references; b=mVxRzsGhGBwJR7308rJQS+Qer9v/+KQyc6C5vUDgxkMMsGhXykHRuW4EEI5IW4bhwe/Ia9KZluftb3rrPfMBmEVEA1iCv9ahpPb+Q5r26qcNYIKol3w81+xhDhdEkyA4LYrTNGxm/+fxFSdP2m8kX9ZRD4LqRfbvN3EDuqNNUIM=
- References: <339c37f20705230321u46860be7ka2fd50269c499d08@mail.gmail.com> <4654630F.5080707@net-b.de> <339c37f20705240738k421687d0u868084f643bd58e9@mail.gmail.com>
Tobias,
Attached is a new version that runs #1 as well. This latter is
incorporated in the testscase.
Bootstrapped and regtested on x86_ia64/FC5 - OK for trunk?
Paul
2007-05-25 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.
(gfc_conv_array_parameter): Call get_array_ctor_strlen to get
good string length.
* trans-intrinsic (gfc_conv_intrinsic_len): Add new argument
to call of get_array_ctor_strlen.
2007-05-25 Paul Thomas <pault@gcc.gnu.org>
PR fortran/31219
* gfortran.dg/array_constructor_17.f90: New test.
Index: /svn/trunk/gcc/fortran/trans-array.c
===================================================================
--- /svn/trunk/gcc/fortran/trans-array.c (revision 125063)
+++ /svn/trunk/gcc/fortran/trans-array.c (working copy)
@@ -1366,11 +1366,54 @@ get_array_ctor_var_strlen (gfc_expr * ex
}
+/* 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 (gfc_constructor * c, tree * len)
+get_array_ctor_strlen (stmtblock_t *block, gfc_constructor * c, tree * len)
{
bool is_const;
@@ -1386,7 +1429,7 @@ get_array_ctor_strlen (gfc_constructor *
break;
case EXPR_ARRAY:
- if (!get_array_ctor_strlen (c->expr->value.constructor, len))
+ if (!get_array_ctor_strlen (block, c->expr->value.constructor, len))
is_const = false;
break;
@@ -1397,16 +1440,7 @@ get_array_ctor_strlen (gfc_constructor *
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. */
+ get_array_ctor_all_strlen (block, c->expr, len);
break;
}
}
@@ -1597,10 +1631,13 @@ gfc_trans_array_constructor (gfc_loopinf
c = ss->expr->value.constructor;
if (ss->expr->ts.type == BT_CHARACTER)
{
- bool const_string = get_array_ctor_strlen (c, &ss->string_length);
+ 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);
@@ -4782,6 +4819,13 @@ gfc_conv_array_parameter (gfc_se * se, g
&& expr->ref->u.ar.type == AR_FULL);
sym = full_array_var ? expr->symtree->n.sym : NULL;
+ if (expr->expr_type == EXPR_ARRAY && expr->ts.type == BT_CHARACTER)
+ {
+ get_array_ctor_strlen (&se->pre, expr->value.constructor, &tmp);
+ expr->ts.cl->backend_decl = gfc_evaluate_now (tmp, &se->pre);
+ se->string_length = expr->ts.cl->backend_decl;
+ }
+
/* Is this the result of the enclosing procedure? */
this_array_result = (full_array_var && sym->attr.flavor == FL_PROCEDURE);
if (this_array_result
Index: /svn/trunk/gcc/fortran/trans.h
===================================================================
--- /svn/trunk/gcc/fortran/trans.h (revision 125063)
+++ /svn/trunk/gcc/fortran/trans.h (working copy)
@@ -72,6 +72,9 @@ typedef struct gfc_se
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;
@@ -434,7 +437,7 @@ extern GTY(()) tree gfc_static_ctors;
void gfc_generate_constructors (void);
/* Get the string length of an array constructor. */
-bool get_array_ctor_strlen (gfc_constructor *, tree *);
+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: /svn/trunk/gcc/fortran/trans-intrinsic.c
===================================================================
--- /svn/trunk/gcc/fortran/trans-intrinsic.c (revision 125063)
+++ /svn/trunk/gcc/fortran/trans-intrinsic.c (working copy)
@@ -2537,7 +2537,7 @@ gfc_conv_intrinsic_len (gfc_se * se, gfc
/* 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);
+ get_array_ctor_strlen (&se->pre, arg->value.constructor, &len);
break;
case EXPR_VARIABLE:
Index: /svn/trunk/gcc/testsuite/gfortran.dg/array_constructor_10.s
===================================================================
Index: /svn/trunk/gcc/testsuite/gfortran.dg/array_constructor_17.f90
===================================================================
--- /svn/trunk/gcc/testsuite/gfortran.dg/array_constructor_17.f90 (revision 0)
+++ /svn/trunk/gcc/testsuite/gfortran.dg/array_constructor_17.f90 (revision 0)
@@ -0,0 +1,40 @@
+! { 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 ()
+
+! Comment #1 from F-X Coudert (noted by T. Burnus) that
+! actually exercises a different part of the bug.
+ call gee( (/g (3)/) )
+
+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
+
+ function g(k) result(i)
+ integer :: k
+ character(len = k) :: i
+ i = '1234'
+ end function
+ subroutine gee(a)
+ character(*),dimension(1) :: a
+ if(len (a) /= 3) call abort ()
+ if(a(1) /= '123') call abort ()
+ end subroutine gee
+
+END