This is the mail archive of the
gcc-patches@gcc.gnu.org
mailing list for the GCC project.
PATCH: PR fortran/23634: temporary array of character ICE with non constant size
- From: "H. J. Lu" <hjl at lucon dot org>
- To: gcc-patches at gcc dot gnu dot org
- Cc: fortran at gcc dot gnu dot org
- Date: Mon, 3 Apr 2006 21:10:28 -0700
- Subject: PATCH: PR fortran/23634: temporary array of character ICE with non constant size
This patch works for me on the testcase below. I can build tonto with
the modified gfortran. But I got a run time error. I don't know if my
patch is correct or it is a different bug.
H.J.
----
2006-04-03 H.J. Lu <hongjiu.lu@intel.com>
PR fortran/23634
* trans-array.c (gfc_conv_expr_descriptor): Properly copy
temporary character with non constant size.
--- gcc/fortran/trans-array.c.variable 2006-04-03 17:45:51.000000000 -0700
+++ gcc/fortran/trans-array.c 2006-04-03 18:09:52.000000000 -0700
@@ -3973,23 +3973,32 @@ gfc_conv_expr_descriptor (gfc_se * se, g
loop.temp_ss->next = gfc_ss_terminator;
if (expr->ts.type == BT_CHARACTER)
{
- gcc_assert (expr->ts.cl && expr->ts.cl->length
- && expr->ts.cl->length->expr_type == EXPR_CONSTANT);
- loop.temp_ss->string_length = gfc_conv_mpz_to_tree
- (expr->ts.cl->length->value.integer,
- expr->ts.cl->length->ts.kind);
- expr->ts.cl->backend_decl = loop.temp_ss->string_length;
- }
- loop.temp_ss->data.temp.type = gfc_typenode_for_spec (&expr->ts);
-
- /* ... which can hold our string, if present. */
- if (expr->ts.type == BT_CHARACTER)
- {
- loop.temp_ss->string_length = TYPE_SIZE_UNIT (loop.temp_ss->data.temp.type);
+ if (expr->ts.cl
+ && expr->ts.cl->length
+ && expr->ts.cl->length->expr_type == EXPR_CONSTANT)
+ {
+ expr->ts.cl->backend_decl
+ = gfc_conv_mpz_to_tree (expr->ts.cl->length->value.integer,
+ expr->ts.cl->length->ts.kind);
+ loop.temp_ss->data.temp.type
+ = gfc_typenode_for_spec (&expr->ts);
+ loop.temp_ss->string_length
+ = TYPE_SIZE_UNIT (loop.temp_ss->data.temp.type);
+ }
+ else
+ {
+ loop.temp_ss->data.temp.type
+ = gfc_typenode_for_spec (&expr->ts);
+ loop.temp_ss->string_length = expr->ts.cl->backend_decl;
+ }
se->string_length = loop.temp_ss->string_length;
}
else
- loop.temp_ss->string_length = NULL;
+ {
+ loop.temp_ss->data.temp.type
+ = gfc_typenode_for_spec (&expr->ts);
+ loop.temp_ss->string_length = NULL;
+ }
loop.temp_ss->data.temp.dimen = loop.dimen;
gfc_add_ss_to_loop (&loop, loop.temp_ss);
}
-----
program main
character (5) :: a = 'hello'
call option_stopwatch_s (5, a)
end program main
subroutine option_stopwatch_s(n, a)
integer :: n
character (*) :: a
character(len=n) :: default_clock
default_clock = a
print *, 'option_stopwatch_s: ', a
print *, 'option_stopwatch_s: ', default_clock
call option_stopwatch_a((/default_clock/))
end subroutine option_stopwatch_s
subroutine option_stopwatch_a (a)
character (*) :: a
print *, 'option_stopwatch_a: ', a
if (a .ne. 'hello') call abort
end subroutine option_stopwatch_a