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.

git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@170539 138bc75d-0d04-0410-961f-82ee72b054a4

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index c6836f7..d79d45e 100644 (file)
--- 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 (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