OpenE2K
/
gcc
2
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity

re PR fortran/31219 (ICE on array of character function results) 

2007-05-26 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-26 Paul Thomas <pault@gcc.gnu.org>

	PR fortran/31219
	* gfortran.dg/array_constructor_17.f90: New test.

From-SVN: r125088
This commit is contained in:
Paul Thomas 2007-05-26 11:25:36 +00:00
parent 150594ba69
commit 0ee8e25059
6 changed files with 121 additions and 15 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

14
gcc/fortran/ChangeLog
View File

@ -1,3 +1,17 @@
2007-05-26 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 Kazu Hirata <kazu@codesourcery.com>
* intrinsic.texi: Fix typos.

70
gcc/fortran/trans-array.c
View File

@ -1366,11 +1366,54 @@ get_array_ctor_var_strlen (gfc_expr * expr, tree * len)
}
/* 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 * c, tree * len)
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 * c, tree * len)
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_loopinfo * loop, gfc_ss * ss)
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, gfc_expr * expr, gfc_ss * ss, int g77)
&& 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

2
gcc/fortran/trans-intrinsic.c
View File

@ -2537,7 +2537,7 @@ gfc_conv_intrinsic_len (gfc_se * se, gfc_expr * expr)
/* 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:

5
gcc/fortran/trans.h
View File

@ -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 *);

5
gcc/testsuite/ChangeLog
View File

@ -1,3 +1,8 @@
2007-05-26 Paul Thomas <pault@gcc.gnu.org>
PR fortran/31219
* gfortran.dg/array_constructor_17.f90: New test.
2007-05-25 Andrew Pinski <andrew_pinski@playstation.sony.com>
PR tree-opt/32090

40
gcc/testsuite/gfortran.dg/array_constructor_17.f90 Normal file
View File

@ -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