diff options
Diffstat (limited to 'gcc')
| -rw-r--r-- | gcc/fortran/ChangeLog | 10 | ||||
| -rw-r--r-- | gcc/fortran/dump-parse-tree.c | 9 | ||||
| -rw-r--r-- | gcc/fortran/iresolve.c | 23 | ||||
| -rw-r--r-- | gcc/fortran/trans-stmt.c | 52 | ||||
| -rw-r--r-- | gcc/testsuite/ChangeLog | 5 | ||||
| -rw-r--r-- | gcc/testsuite/gfortran.dg/allocate_deferred_char_scalar_2.f03 | 21 |
6 files changed, 99 insertions, 21 deletions
diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog index e146d76..ae08fdc 100644 --- a/gcc/fortran/ChangeLog +++ b/gcc/fortran/ChangeLog @@ -1,3 +1,13 @@ +2011-01-31 Paul Thomas <pault@gcc.gnu.org> + + PR fortran/47519 + * trans-stmt.c (gfc_trans_allocate): Improve handling of + deferred character lengths with SOURCE. + * iresolve.c (gfc_resolve_repeat): Calculate character + length from source length and ncopies. + * dump-parse-tree.c (show_code_node): Show MOLD and SOURCE + expressions for ALLOCATE. + 2011-01-31 Janus Weil <janus@gcc.gnu.org> PR fortran/47463 diff --git a/gcc/fortran/dump-parse-tree.c b/gcc/fortran/dump-parse-tree.c index 24e9ea5..424feb1 100644 --- a/gcc/fortran/dump-parse-tree.c +++ b/gcc/fortran/dump-parse-tree.c @@ -1605,6 +1605,15 @@ show_code_node (int level, gfc_code *c) show_expr (c->expr2); } + if (c->expr3) + { + if (c->expr3->mold) + fputs (" MOLD=", dumpfile); + else + fputs (" SOURCE=", dumpfile); + show_expr (c->expr3); + } + for (a = c->ext.alloc.list; a; a = a->next) { fputc (' ', dumpfile); diff --git a/gcc/fortran/iresolve.c b/gcc/fortran/iresolve.c index ec9dd42..d8309d2 100644 --- a/gcc/fortran/iresolve.c +++ b/gcc/fortran/iresolve.c @@ -35,6 +35,7 @@ along with GCC; see the file COPYING3. If not see #include "gfortran.h" #include "intrinsic.h" #include "constructor.h" +#include "arith.h" /* Given printf-like arguments, return a stable version of the result string. @@ -2044,11 +2045,31 @@ gfc_resolve_rename (gfc_expr *f, gfc_expr *p1 ATTRIBUTE_UNUSED, void gfc_resolve_repeat (gfc_expr *f, gfc_expr *string, - gfc_expr *ncopies ATTRIBUTE_UNUSED) + gfc_expr *ncopies) { + int len; + gfc_expr *tmp; f->ts.type = BT_CHARACTER; f->ts.kind = string->ts.kind; f->value.function.name = gfc_get_string ("__repeat_%d", string->ts.kind); + + /* If possible, generate a character length. */ + if (f->ts.u.cl == NULL) + f->ts.u.cl = gfc_new_charlen (gfc_current_ns, NULL); + + tmp = NULL; + if (string->expr_type == EXPR_CONSTANT) + { + len = string->value.character.length; + tmp = gfc_get_int_expr (gfc_default_integer_kind, NULL , len); + } + else if (string->ts.u.cl && string->ts.u.cl->length) + { + tmp = gfc_copy_expr (string->ts.u.cl->length); + } + + if (tmp) + f->ts.u.cl->length = gfc_multiply (tmp, gfc_copy_expr (ncopies)); } diff --git a/gcc/fortran/trans-stmt.c b/gcc/fortran/trans-stmt.c index 161b309..2ac6989 100644 --- a/gcc/fortran/trans-stmt.c +++ b/gcc/fortran/trans-stmt.c @@ -4522,15 +4522,30 @@ gfc_trans_allocate (gfc_code * code) gfc_conv_expr (&se_sz, code->expr3); memsz = se_sz.string_length; } - else + else if (code->expr3->ts.u.cl + && code->expr3->ts.u.cl->length) + { + gfc_conv_expr (&se_sz, code->expr3->ts.u.cl->length); + gfc_add_block_to_block (&se.pre, &se_sz.pre); + se_sz.expr = gfc_evaluate_now (se_sz.expr, &se.pre); + gfc_add_block_to_block (&se.pre, &se_sz.post); + memsz = se_sz.expr; + } + else if (code->ext.alloc.ts.u.cl + && code->ext.alloc.ts.u.cl->length) { gfc_conv_expr (&se_sz, code->ext.alloc.ts.u.cl->length); memsz = se_sz.expr; } - if (TREE_CODE (se.string_length) == VAR_DECL) - gfc_add_modify (&block, se.string_length, - fold_convert (TREE_TYPE (se.string_length), - memsz)); + else + { + /* This is likely to be inefficient. */ + gfc_conv_expr (&se_sz, code->expr3); + gfc_add_block_to_block (&se.pre, &se_sz.pre); + se_sz.expr = gfc_evaluate_now (se_sz.expr, &se.pre); + gfc_add_block_to_block (&se.pre, &se_sz.post); + memsz = se_sz.string_length; + } } else /* Otherwise use the stored string length. */ @@ -4539,7 +4554,7 @@ gfc_trans_allocate (gfc_code * code) /* Store the string length. */ if (tmp && TREE_CODE (tmp) == VAR_DECL) - gfc_add_modify (&block, tmp, fold_convert (TREE_TYPE (tmp), + gfc_add_modify (&se.pre, tmp, fold_convert (TREE_TYPE (tmp), memsz)); /* Convert to size in bytes, using the character KIND. */ @@ -4556,18 +4571,8 @@ gfc_trans_allocate (gfc_code * code) if (expr->ts.type == BT_CHARACTER && memsz == NULL_TREE) { - if (expr->ts.deferred) - { - gfc_se se_sz; - gfc_init_se (&se_sz, NULL); - gfc_conv_expr (&se_sz, code->ext.alloc.ts.u.cl->length); - memsz = se_sz.expr; - gfc_add_modify (&block, se.string_length, - fold_convert (TREE_TYPE (se.string_length), - memsz)); - } - else - memsz = se.string_length; + memsz = se.string_length; + /* Convert to size in bytes, using the character KIND. */ tmp = TREE_TYPE (gfc_typenode_for_spec (&code->ext.alloc.ts)); tmp = TYPE_SIZE_UNIT (tmp); @@ -4664,8 +4669,15 @@ gfc_trans_allocate (gfc_code * code) tmp = gfc_finish_block (&call.pre); } else - tmp = gfc_trans_assignment (gfc_expr_to_initialize (expr), - rhs, false, false); + { + /* Switch off automatic reallocation since we have just done + the ALLOCATE. */ + int realloc_lhs = gfc_option.flag_realloc_lhs; + gfc_option.flag_realloc_lhs = 0; + tmp = gfc_trans_assignment (gfc_expr_to_initialize (expr), + rhs, false, false); + gfc_option.flag_realloc_lhs = realloc_lhs; + } gfc_free_expr (rhs); gfc_add_expr_to_block (&block, tmp); } diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog index 0c17d83..824f3ca 100644 --- a/gcc/testsuite/ChangeLog +++ b/gcc/testsuite/ChangeLog @@ -1,3 +1,8 @@ +2011-01-31 Paul Thomas <pault@gcc.gnu.org> + + PR fortran/47519 + * gfortran.dg/allocate_deferred_char_scalar_2.f03: New test. + 2011-01-31 Janus Weil <janus@gcc.gnu.org> PR fortran/47463 diff --git a/gcc/testsuite/gfortran.dg/allocate_deferred_char_scalar_2.f03 b/gcc/testsuite/gfortran.dg/allocate_deferred_char_scalar_2.f03 new file mode 100644 index 0000000..1f0f433 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/allocate_deferred_char_scalar_2.f03 @@ -0,0 +1,21 @@ +! { dg-do run } +! Test the fix for PR47519, in which the character length was not +! calculated for the SOURCE expressions below and an ICE resulted. +! +! Contributed by Tobias Burnus <burnus@gcc.gnu.org> +! +program note7_35 + implicit none + character(:), allocatable :: name + character(:), allocatable :: src + integer n + n = 10 + allocate(name, SOURCE=repeat('x',n)) + if (name .ne. 'xxxxxxxxxx') call abort + if (len (name) .ne. 10 ) call abort + deallocate(name) + src = 'xyxy' + allocate(name, SOURCE=repeat(src,n)) + if (name(37:40) .ne. 'xyxy') call abort + if (len (name) .ne. 40 ) call abort +end program note7_35 |