procyberian/gcc
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

re PR fortran/35846 (ICE on nested character constructors)

Browse source 
2008-09-21  Daniel Kraft  <d@domob.eu>

	PR fortran/35846
	* trans.h (gfc_conv_string_length): New argument `expr'.
	* trans-expr.c (flatten_array_ctors_without_strlen): New method.
	(gfc_conv_string_length): New argument `expr' that is used in a new
	special case handling if cl->length is NULL.
	(gfc_conv_subref_array_arg): Pass expr to gfc_conv_string_length.
	* trans-array.c (gfc_conv_expr_descriptor): Ditto.
	(gfc_trans_auto_array_allocation): Pass NULL as new expr.
	(gfc_trans_g77_array), (gfc_trans_dummy_array_bias): Ditto.
	(gfc_trans_deferred_array): Ditto.
	(gfc_trans_array_constructor): Save and restore old values of globals
	used for bounds checking.
	* trans-decl.c (gfc_trans_dummy_character): Ditto.
	(gfc_trans_auto_character_variable): Ditto.

2008-09-21  Daniel Kraft  <d@domob.eu>

	PR fortran/35846
	* gfortran.dg/nested_array_constructor_1.f90: New test.
	* gfortran.dg/nested_array_constructor_2.f90: New test.
	* gfortran.dg/nested_array_constructor_3.f90: New test.
	* gfortran.dg/nested_array_constructor_4.f90: New test.
	* gfortran.dg/nested_array_constructor_5.f90: New test.
	* gfortran.dg/nested_array_constructor_6.f90: New test.

From-SVN: r140529
This commit is contained in:
Daniel Kraft 2008-09-21 17:33:37 +02:00 • committed by Daniel Kraft
parent 74a9b89764
commit 4b7f8314ba
12 changed files with 250 additions and 15 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

17
gcc/fortran/ChangeLog
View file

@ -1,3 +1,20 @@
2008-09-21 Daniel Kraft <d@domob.eu>
PR fortran/35846
* trans.h (gfc_conv_string_length): New argument `expr'.
* trans-expr.c (flatten_array_ctors_without_strlen): New method.
(gfc_conv_string_length): New argument `expr' that is used in a new
special case handling if cl->length is NULL.
(gfc_conv_subref_array_arg): Pass expr to gfc_conv_string_length.
* trans-array.c (gfc_conv_expr_descriptor): Ditto.
(gfc_trans_auto_array_allocation): Pass NULL as new expr.
(gfc_trans_g77_array), (gfc_trans_dummy_array_bias): Ditto.
(gfc_trans_deferred_array): Ditto.
(gfc_trans_array_constructor): Save and restore old values of globals
used for bounds checking.
* trans-decl.c (gfc_trans_dummy_character): Ditto.
(gfc_trans_auto_character_variable): Ditto.
2008-09-21 Daniel Kraft <d@domob.eu>
* decl.c (match_procedure_in_type): Changed misleading error message

28
gcc/fortran/trans-array.c
View file

@ -1694,6 +1694,13 @@ gfc_trans_array_constructor (gfc_loopinfo * loop, gfc_ss * ss, locus * where)
tree type;
tree loopfrom;
bool dynamic;
bool old_first_len, old_typespec_chararray_ctor;
tree old_first_len_val;
/* Save the old values for nested checking. */
old_first_len = first_len;
old_first_len_val = first_len_val;
old_typespec_chararray_ctor = typespec_chararray_ctor;
/* Do bounds-checking here and in gfc_trans_array_ctor_element only if no
typespec was given for the array constructor. */
@ -1792,7 +1799,7 @@ gfc_trans_array_constructor (gfc_loopinfo * loop, gfc_ss * ss, locus * where)
if (size && compare_tree_int (size, nelem) == 0)
{
gfc_trans_constant_array_constructor (loop, ss, type);
return;
goto finish;
}
}
}
@ -1849,6 +1856,12 @@ gfc_trans_array_constructor (gfc_loopinfo * loop, gfc_ss * ss, locus * where)
gcc_unreachable ();
}
#endif
finish:
/* Restore old values of globals. */
first_len = old_first_len;
first_len_val = old_first_len_val;
typespec_chararray_ctor = old_typespec_chararray_ctor;
}
@ -4080,7 +4093,7 @@ gfc_trans_auto_array_allocation (tree decl, gfc_symbol * sym, tree fnbody)
if (sym->ts.type == BT_CHARACTER
&& onstack && !INTEGER_CST_P (sym->ts.cl->backend_decl))
{
gfc_conv_string_length (sym->ts.cl, &block);
gfc_conv_string_length (sym->ts.cl, NULL, &block);
gfc_trans_vla_type_sizes (sym, &block);
@ -4104,7 +4117,7 @@ gfc_trans_auto_array_allocation (tree decl, gfc_symbol * sym, tree fnbody)
if (sym->ts.type == BT_CHARACTER
&& !INTEGER_CST_P (sym->ts.cl->backend_decl))
gfc_conv_string_length (sym->ts.cl, &block);
gfc_conv_string_length (sym->ts.cl, NULL, &block);
size = gfc_trans_array_bounds (type, sym, &offset, &block);
@ -4170,7 +4183,7 @@ gfc_trans_g77_array (gfc_symbol * sym, tree body)
if (sym->ts.type == BT_CHARACTER
&& TREE_CODE (sym->ts.cl->backend_decl) == VAR_DECL)
gfc_conv_string_length (sym->ts.cl, &block);
gfc_conv_string_length (sym->ts.cl, NULL, &block);
/* Evaluate the bounds of the array. */
gfc_trans_array_bounds (type, sym, &offset, &block);
@ -4262,7 +4275,7 @@ gfc_trans_dummy_array_bias (gfc_symbol * sym, tree tmpdesc, tree body)
if (sym->ts.type == BT_CHARACTER
&& TREE_CODE (sym->ts.cl->backend_decl) == VAR_DECL)
gfc_conv_string_length (sym->ts.cl, &block);
gfc_conv_string_length (sym->ts.cl, NULL, &block);
checkparm = (sym->as->type == AS_EXPLICIT && flag_bounds_check);
@ -4848,7 +4861,6 @@ gfc_conv_expr_descriptor (gfc_se * se, gfc_expr * expr, gfc_ss * ss)
break;
}
gfc_init_loopinfo (&loop);
/* Associate the SS with the loop. */
@ -4872,7 +4884,7 @@ gfc_conv_expr_descriptor (gfc_se * se, gfc_expr * expr, gfc_ss * ss)
loop.temp_ss->next = gfc_ss_terminator;
if (expr->ts.type == BT_CHARACTER && !expr->ts.cl->backend_decl)
gfc_conv_string_length (expr->ts.cl, &se->pre);
gfc_conv_string_length (expr->ts.cl, expr, &se->pre);
loop.temp_ss->data.temp.type = gfc_typenode_for_spec (&expr->ts);
@ -5672,7 +5684,7 @@ gfc_trans_deferred_array (gfc_symbol * sym, tree body)
if (sym->ts.type == BT_CHARACTER
&& !INTEGER_CST_P (sym->ts.cl->backend_decl))
{
gfc_conv_string_length (sym->ts.cl, &fnblock);
gfc_conv_string_length (sym->ts.cl, NULL, &fnblock);
gfc_trans_vla_type_sizes (sym, &fnblock);
}

4
gcc/fortran/trans-decl.c
View file

@ -2583,7 +2583,7 @@ gfc_trans_dummy_character (gfc_symbol *sym, gfc_charlen *cl, tree fnbody)
gfc_start_block (&body);
/* Evaluate the string length expression. */
gfc_conv_string_length (cl, &body);
gfc_conv_string_length (cl, NULL, &body);
gfc_trans_vla_type_sizes (sym, &body);
@ -2607,7 +2607,7 @@ gfc_trans_auto_character_variable (gfc_symbol * sym, tree fnbody)
gfc_start_block (&body);
/* Evaluate the string length expression. */
gfc_conv_string_length (sym->ts.cl, &body);
gfc_conv_string_length (sym->ts.cl, NULL, &body);
gfc_trans_vla_type_sizes (sym, &body);

93
gcc/fortran/trans-expr.c
View file

@ -241,17 +241,102 @@ gfc_get_expr_charlen (gfc_expr *e)
return length;
}
/* For each character array constructor subexpression without a ts.cl->length,
replace it by its first element (if there aren't any elements, the length
should already be set to zero). */
static void
flatten_array_ctors_without_strlen (gfc_expr* e)
{
gfc_actual_arglist* arg;
gfc_constructor* c;
if (!e)
return;
switch (e->expr_type)
{
case EXPR_OP:
flatten_array_ctors_without_strlen (e->value.op.op1);
flatten_array_ctors_without_strlen (e->value.op.op2);
break;
case EXPR_COMPCALL:
/* TODO: Implement as with EXPR_FUNCTION when needed. */
gcc_unreachable ();
case EXPR_FUNCTION:
for (arg = e->value.function.actual; arg; arg = arg->next)
flatten_array_ctors_without_strlen (arg->expr);
break;
case EXPR_ARRAY:
/* We've found what we're looking for. */
if (e->ts.type == BT_CHARACTER && !e->ts.cl->length)
{
gfc_expr* new_expr;
gcc_assert (e->value.constructor);
new_expr = e->value.constructor->expr;
e->value.constructor->expr = NULL;
flatten_array_ctors_without_strlen (new_expr);
gfc_replace_expr (e, new_expr);
break;
}
/* Otherwise, fall through to handle constructor elements. */
case EXPR_STRUCTURE:
for (c = e->value.constructor; c; c = c->next)
flatten_array_ctors_without_strlen (c->expr);
break;
default:
break;
}
}
/* Generate code to initialize a string length variable. Returns the
value. */
value. For array constructors, cl->length might be NULL and in this case,
the first element of the constructor is needed. expr is the original
expression so we can access it but can be NULL if this is not needed. */
void
gfc_conv_string_length (gfc_charlen * cl, stmtblock_t * pblock)
gfc_conv_string_length (gfc_charlen * cl, gfc_expr * expr, stmtblock_t * pblock)
{
gfc_se se;
gfc_init_se (&se, NULL);
/* If cl->length is NULL, use gfc_conv_expr to obtain the string length but
"flatten" array constructors by taking their first element; all elements
should be the same length or a cl->length should be present. */
if (!cl->length)
{
gfc_expr* expr_flat;
gcc_assert (expr);
expr_flat = gfc_copy_expr (expr);
flatten_array_ctors_without_strlen (expr_flat);
gfc_resolve_expr (expr_flat);
gfc_conv_expr (&se, expr_flat);
gfc_add_block_to_block (pblock, &se.pre);
cl->backend_decl = convert (gfc_charlen_type_node, se.string_length);
gfc_free_expr (expr_flat);
return;
}
/* Convert cl->length. */
gcc_assert (cl->length);
gfc_conv_expr_type (&se, cl->length, gfc_charlen_type_node);
se.expr = fold_build2 (MAX_EXPR, gfc_charlen_type_node, se.expr,
build_int_cst (gfc_charlen_type_node, 0));
@ -2092,7 +2177,7 @@ gfc_conv_subref_array_arg (gfc_se * parmse, gfc_expr * expr,
/* Build an ss for the temporary. */
if (expr->ts.type == BT_CHARACTER && !expr->ts.cl->backend_decl)
gfc_conv_string_length (expr->ts.cl, &parmse->pre);
gfc_conv_string_length (expr->ts.cl, expr, &parmse->pre);
base_type = gfc_typenode_for_spec (&expr->ts);
if (GFC_ARRAY_TYPE_P (base_type)

2
gcc/fortran/trans.h
View file

@ -340,7 +340,7 @@ tree gfc_conv_string_tmp (gfc_se *, tree, tree);
/* Get the string length variable belonging to an expression. */
tree gfc_get_expr_charlen (gfc_expr *);
/* Initialize a string length variable. */
void gfc_conv_string_length (gfc_charlen *, stmtblock_t *);
void gfc_conv_string_length (gfc_charlen *, gfc_expr *, stmtblock_t *);
/* Ensure type sizes can be gimplified. */
void gfc_trans_vla_type_sizes (gfc_symbol *, stmtblock_t *);

10
gcc/testsuite/ChangeLog
View file

@ -1,3 +1,13 @@
2008-09-21 Daniel Kraft <d@domob.eu>
PR fortran/35846
* gfortran.dg/nested_array_constructor_1.f90: New test.
* gfortran.dg/nested_array_constructor_2.f90: New test.
* gfortran.dg/nested_array_constructor_3.f90: New test.
* gfortran.dg/nested_array_constructor_4.f90: New test.
* gfortran.dg/nested_array_constructor_5.f90: New test.
* gfortran.dg/nested_array_constructor_6.f90: New test.
2008-09-21 Daniel Kraft <d@domob.eu>
* gfortran.dg/typebound_proc_4.f03: Changed expected error for not

19
gcc/testsuite/gfortran.dg/nested_array_constructor_1.f90 Normal file
View file

@ -0,0 +1,19 @@
! { dg-do compile }
! This test is run with result-checking and -fbounds-check as
! nested_array_constructor_2.f90
! PR fortran/35846
! This used to ICE because the charlength of the trim-expression was
! NULL.
! Contributed by Tobias Burnus <burnus@gcc.gnu.org>
implicit none
character(len=2) :: c(3)
c = 'a'
c = (/ (/ trim(c(1)), 'a' /)//'c', 'cd' /)
print *, c
end

22
gcc/testsuite/gfortran.dg/nested_array_constructor_2.f90 Normal file
View file

@ -0,0 +1,22 @@
! { dg-do run }
! { dg-options "-fbounds-check" }
! PR fortran/35846
! This used to ICE because the charlength of the trim-expression was
! NULL.
! Contributed by Tobias Burnus <burnus@gcc.gnu.org>
implicit none
character(len=2) :: c(3)
c = 'a'
c = (/ (/ trim(c(1)), 'a' /)//'c', 'cd' /)
print *, c
if (c(1) /= 'ac' .or. c(2) /= 'ac' .or. c(3) /= 'cd') then
call abort ()
end if
end

22
gcc/testsuite/gfortran.dg/nested_array_constructor_3.f90 Normal file
View file

@ -0,0 +1,22 @@
! { dg-do run }
! PR fortran/35846
! Alternate test that also produced an ICE because of a missing length.
PROGRAM test
IMPLICIT NONE
CHARACTER(LEN=2) :: x
x = 'a'
CALL sub ( (/ TRIM(x), 'a' /) // 'c')
END PROGRAM
SUBROUTINE sub(str)
IMPLICIT NONE
CHARACTER(LEN=*) :: str(2)
WRITE (*,*) str
IF (str(1) /= 'ac' .OR. str(2) /= 'ac') THEN
CALL abort ()
END IF
END SUBROUTINE sub

17
gcc/testsuite/gfortran.dg/nested_array_constructor_4.f90 Normal file
View file

@ -0,0 +1,17 @@
! { dg-do run }
! PR fortran/35846
! Alternate test that also produced an ICE because of a missing length.
PROGRAM test
IMPLICIT NONE
CHARACTER(LEN=2) :: x
INTEGER :: length
x = 'a'
length = LEN ( (/ TRIM(x), 'a' /) // 'c')
IF (length /= 2) THEN
CALL abort ()
END IF
END PROGRAM

16
gcc/testsuite/gfortran.dg/nested_array_constructor_5.f90 Normal file
View file

@ -0,0 +1,16 @@
! { dg-do compile }
! PR fortran/35846
! This used to ICE because the charlength of the trim-expression was
! NULL, but it is switched around to test for the right operand of // being
! not a constant, too.
implicit none
character(len=2) :: c(2)
c = 'a'
c = (/ (/ trim(c(1)), 'a' /) // (/ trim(c(1)), 'a' /) /)
print *, c
end

15
gcc/testsuite/gfortran.dg/nested_array_constructor_6.f90 Normal file
View file

@ -0,0 +1,15 @@
! { dg-do compile }
! PR fortran/35846
! Nested three levels deep.
! Contributed by Tobias Burnus <burnus@gcc.gnu.org>
implicit none
character(len=3) :: c(3)
c = 'a'
c = (/ (/ 'A'//(/ trim(c(1)), 'a' /)/)//'c', 'dcd' /)
print *, c(1)
print *, c(2)
print *, c(3)
end