diff options
| author | Tobias Burnus <burnus@net-b.de> | 2011-02-27 15:12:31 +0100 |
|---|---|---|
| committer | Tobias Burnus <burnus@gcc.gnu.org> | 2011-02-27 15:12:31 +0100 |
| commit | 2573aab954b1dc8da8d690b4425856c870bba01e (patch) | |
| tree | c3ecc6036d7aa8fd95025c34b104aacf5a4c0194 /gcc | |
| parent | d33a8058b3f4b84a55586821b20d06982805364f (diff) | |
| download | gcc-2573aab954b1dc8da8d690b4425856c870bba01e.zip gcc-2573aab954b1dc8da8d690b4425856c870bba01e.tar.gz gcc-2573aab954b1dc8da8d690b4425856c870bba01e.tar.bz2 | |
re PR fortran/47846 (Deferred-string length: Length is wrong (gfortran.dg/allocate_deferred_char_scalar_1.f03))
2011-02-27 Tobias Burnus <burnus@net-b.de>
PR fortran/47846
* trans-stmt.c (gfc_trans_allocate): Fix allocation with
type-spec of deferred-length strings.
From-SVN: r170539
Diffstat (limited to 'gcc')
| -rw-r--r-- | gcc/fortran/ChangeLog | 6 | ||||
| -rw-r--r-- | gcc/fortran/trans-stmt.c | 19 |
2 files changed, 25 insertions, 0 deletions
diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog index c6836f7..d79d45e 100644 --- a/gcc/fortran/ChangeLog +++ b/gcc/fortran/ChangeLog @@ -1,5 +1,11 @@ 2011-02-26 Tobias Burnus <burnus@net-b.de> + PR fortran/47846 + * trans-stmt.c (gfc_trans_allocate): Fix allocation with + type-spec of deferred-length strings. + +2011-02-26 Tobias Burnus <burnus@net-b.de> + PR fortran/47886 * openmp.c (gfc_resolve_omp_directive): Resolve if() condition of OpenMP's task. diff --git a/gcc/fortran/trans-stmt.c b/gcc/fortran/trans-stmt.c index e120285..98fb74c 100644 --- a/gcc/fortran/trans-stmt.c +++ b/gcc/fortran/trans-stmt.c @@ -4581,6 +4581,25 @@ gfc_trans_allocate (gfc_code * code) TREE_TYPE (tmp), tmp, fold_convert (TREE_TYPE (tmp), memsz)); } + else if (al->expr->ts.type == BT_CHARACTER && al->expr->ts.deferred) + { + gcc_assert (code->ext.alloc.ts.u.cl && code->ext.alloc.ts.u.cl->length); + gfc_init_se (&se_sz, NULL); + gfc_conv_expr (&se_sz, code->ext.alloc.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); + /* Store the string length. */ + tmp = al->expr->ts.u.cl->backend_decl; + gfc_add_modify (&se.pre, tmp, fold_convert (TREE_TYPE (tmp), + se_sz.expr)); + tmp = TREE_TYPE (gfc_typenode_for_spec (&code->ext.alloc.ts)); + tmp = TYPE_SIZE_UNIT (tmp); + memsz = fold_build2_loc (input_location, MULT_EXPR, + TREE_TYPE (tmp), tmp, + fold_convert (TREE_TYPE (se_sz.expr), + se_sz.expr)); + } else if (code->ext.alloc.ts.type != BT_UNKNOWN) memsz = TYPE_SIZE_UNIT (gfc_typenode_for_spec (&code->ext.alloc.ts)); else |