diff mbox

[Fortran] PR 47846 - Fix wrong-code bug regarding allocate_deferred_char_scalar_1.f03

Message ID 4D697E93.4070906@net-b.de
State New
Headers show

Commit Message

Tobias Burnus Feb. 26, 2011, 10:28 p.m. UTC 
Fix allocatable strings with deferred type parameter. ALLOCATE with 
type-spec was seemingly not handled at all.

(No new test case needed as the existing one fails on the trunk.)

Build and regtested on x86-64-linux.
OK for the trunk?

Tobias

Comments

Paul Richard Thomas Feb. 27, 2011, 12:59 p.m. UTC | #1 
Dear Tobias,

Apart from some white space issues (8 spaces rather than tabs) the
patch is OK for trunk.

Thanks for the patch.

Paul

On Sat, Feb 26, 2011 at 11:28 PM, Tobias Burnus <burnus@net-b.de> wrote:
> Fix allocatable strings with deferred type parameter. ALLOCATE with
> type-spec was seemingly not handled at all.
>
> (No new test case needed as the existing one fails on the trunk.)
>
> Build and regtested on x86-64-linux.
> OK for the trunk?
>
> Tobias
>
diff mbox

Patch

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.

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