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

login
register
mail settings
Submitter Tobias Burnus
Date Feb. 26, 2011, 10:28 p.m.
Message ID <4D697E93.4070906@net-b.de>
Download mbox | patch
Permalink /patch/84672/
State New
Headers show

Comments

Tobias Burnus - Feb. 26, 2011, 10:28 p.m.
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
Paul Richard Thomas - Feb. 27, 2011, 12:59 p.m.
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
>

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