From patchwork Sat Feb 26 22:28:35 2011 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 7bit X-Patchwork-Submitter: Tobias Burnus X-Patchwork-Id: 84672 Return-Path: X-Original-To: incoming@patchwork.ozlabs.org Delivered-To: patchwork-incoming@bilbo.ozlabs.org Received: from sourceware.org (server1.sourceware.org [209.132.180.131]) by ozlabs.org (Postfix) with SMTP id E9500B70FC for ; Sun, 27 Feb 2011 09:28:49 +1100 (EST) Received: (qmail 18682 invoked by alias); 26 Feb 2011 22:28:47 -0000 Received: (qmail 18667 invoked by uid 22791); 26 Feb 2011 22:28:46 -0000 X-SWARE-Spam-Status: No, hits=-1.8 required=5.0 tests=AWL, BAYES_00, RCVD_IN_DNSWL_NONE X-Spam-Check-By: sourceware.org Received: from mx02.qsc.de (HELO mx02.qsc.de) (213.148.130.14) by sourceware.org (qpsmtpd/0.43rc1) with ESMTP; Sat, 26 Feb 2011 22:28:38 +0000 Received: from [192.168.178.22] (port-92-204-54-176.dynamic.qsc.de [92.204.54.176]) by mx02.qsc.de (Postfix) with ESMTP id 105341DF04; Sat, 26 Feb 2011 23:28:35 +0100 (CET) Message-ID: <4D697E93.4070906@net-b.de> Date: Sat, 26 Feb 2011 23:28:35 +0100 From: Tobias Burnus User-Agent: Mozilla/5.0 (X11; U; Linux x86_64; de; rv:1.9.2.13) Gecko/20101206 SUSE/3.1.7 Thunderbird/3.1.7 MIME-Version: 1.0 To: gcc patches , gfortran Subject: [Patch, Fortran] PR 47846 - Fix wrong-code bug regarding allocate_deferred_char_scalar_1.f03 Mailing-List: contact gcc-patches-help@gcc.gnu.org; run by ezmlm Precedence: bulk List-Id: List-Unsubscribe: List-Archive: List-Post: List-Help: Sender: gcc-patches-owner@gcc.gnu.org Delivered-To: mailing list gcc-patches@gcc.gnu.org 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 2011-02-26 Tobias Burnus 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