re PR fortran/47846 (Deferred-string length: Length is wrong (gfortran.dg/allocate_de...

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

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index c6836f7e67450402498c7f3c65aee1ee80fe4ce3..d79d45e0759fa986e5170a2e108df43f26bab9e4 100644 (file)
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -1,3 +1,9 @@
+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

diff --git a/gcc/fortran/trans-stmt.c b/gcc/fortran/trans-stmt.c
index e1202858bb27d7a18a170f579602a986bceb591b..98fb74c45785d6a0d4e6d1eacb52d568c51a68d2 100644 (file)
--- 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