From patchwork Fri Jun 7 16:11:45 2013 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 7bit X-Patchwork-Submitter: Tobias Burnus X-Patchwork-Id: 249751 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]) (using TLSv1 with cipher DHE-RSA-AES256-SHA (256/256 bits)) (Client CN "localhost", Issuer "www.qmailtoaster.com" (not verified)) by ozlabs.org (Postfix) with ESMTPS id D9F972C00A0 for ; Sat, 8 Jun 2013 02:11:55 +1000 (EST) DomainKey-Signature: a=rsa-sha1; c=nofws; d=gcc.gnu.org; h=list-id :list-unsubscribe:list-archive:list-post:list-help:sender :message-id:date:from:mime-version:cc:subject:content-type; q= dns; s=default; b=rGCboQuVh7/aFGct5knlrBEbQtJHn+MfV9DXGUQGXEDWq6 9snfbBUwHGdRtXQh/1AvfrDo92n5UMOUqdOKftqxr0XpgzCjVVS6w7LOAw6lDme/ p7JoM6T2WZN//Tg7zc2ZwEFWnpjNeueGlBigAf0DMhJvhYNLAtlxam3P3UQ/k= DKIM-Signature: v=1; a=rsa-sha1; c=relaxed; d=gcc.gnu.org; h=list-id :list-unsubscribe:list-archive:list-post:list-help:sender :message-id:date:from:mime-version:cc:subject:content-type; s= default; bh=pCmjSO23YHbD7VT2RtK5gRHNKI0=; b=aGbXjVSbtb8Tvz1ov4Rm 3au8BIR0JTB/j9BqLTcD+3/hlfwB070HrOVDFPyLnvGhln4Q+Gscq1B3JCJdzIZ3 rRQD9RdDUsc+XazMvx+AChi4kG8s+JA2R6JkXvYq/ogh7aU+OROyKbIHTmHaECIr +jFht6jKUApTh3cK8FyprqI= Received: (qmail 14595 invoked by alias); 7 Jun 2013 16:11:49 -0000 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 Received: (qmail 14581 invoked by uid 89); 7 Jun 2013 16:11:49 -0000 X-Spam-SWARE-Status: No, score=-1.7 required=5.0 tests=AWL, BAYES_00, MISSING_HEADERS, RCVD_IN_DNSWL_NONE autolearn=no version=3.3.1 X-Spam-User: qpsmtpd, 2 recipients Received: from mx02.qsc.de (HELO mx02.qsc.de) (213.148.130.14) by sourceware.org (qpsmtpd/0.84/v0.84-167-ge50287c) with ESMTP; Fri, 07 Jun 2013 16:11:49 +0000 Received: from archimedes.net-b.de (port-92-195-31-211.dynamic.qsc.de [92.195.31.211]) by mx02.qsc.de (Postfix) with ESMTP id 0E2952766F; Fri, 7 Jun 2013 18:11:45 +0200 (CEST) Message-ID: <51B20641.4040509@net-b.de> Date: Fri, 07 Jun 2013 18:11:45 +0200 From: Tobias Burnus User-Agent: Mozilla/5.0 (X11; Linux x86_64; rv:17.0) Gecko/20130510 Thunderbird/17.0.6 MIME-Version: 1.0 CC: gcc patches , gfortran Subject: [Patch, Fortran] PR57553 - fix two STORAGE_SIZE bugs X-Virus-Found: No This patch fixes two issues: * storage_size('aa') was rejected as constant expression - as ts.u.cl->length == 0. * In trans*.c, there was a fold_convert missing (-> ICE). Additionally, I have replaced the detour to generate a tree containing the value "8" via a fortran expression. Build and regtested on x86-64-gnu-linux. OK for the trunk? Tobias 2013-06-07 Tobias Burnus PR fortran/57553 * simplify.c (gfc_simplify_storage_size): Handle literal strings. * trans-intrinsic.c (gfc_conv_intrinsic_storage_size): Add missing fold_convert. diff --git a/gcc/fortran/simplify.c b/gcc/fortran/simplify.c index 815043b..683d58b 100644 --- a/gcc/fortran/simplify.c +++ b/gcc/fortran/simplify.c @@ -5717,7 +5717,7 @@ gfc_simplify_storage_size (gfc_expr *x, if (x->ts.type == BT_CLASS || x->ts.deferred) return NULL; - if (x->ts.type == BT_CHARACTER + if (x->ts.type == BT_CHARACTER && x->expr_type != EXPR_CONSTANT && (!x->ts.u.cl || !x->ts.u.cl->length || x->ts.u.cl->length->expr_type != EXPR_CONSTANT)) return NULL; diff --git a/gcc/fortran/trans-intrinsic.c b/gcc/fortran/trans-intrinsic.c index eca907e..3fbf193 100644 --- a/gcc/fortran/trans-intrinsic.c +++ b/gcc/fortran/trans-intrinsic.c @@ -5249,12 +5249,10 @@ static void gfc_conv_intrinsic_storage_size (gfc_se *se, gfc_expr *expr) { gfc_expr *arg; - gfc_se argse,eight; + gfc_se argse; tree type, result_type, tmp; arg = expr->value.function.actual->expr; - gfc_init_se (&eight, NULL); - gfc_conv_expr (&eight, gfc_get_int_expr (expr->ts.kind, NULL, 8)); gfc_init_se (&argse, NULL); result_type = gfc_get_int_type (expr->ts.kind); @@ -5285,11 +5283,12 @@ gfc_conv_intrinsic_storage_size (gfc_se *se, gfc_expr *expr) if (arg->ts.type == BT_CHARACTER) tmp = size_of_string_in_bytes (arg->ts.kind, argse.string_length); else - tmp = fold_convert (result_type, size_in_bytes (type)); + tmp = size_in_bytes (type); + tmp = fold_convert (result_type, tmp); done: se->expr = fold_build2_loc (input_location, MULT_EXPR, result_type, tmp, - eight.expr); + build_int_cst (result_type, BITS_PER_UNIT)); gfc_add_block_to_block (&se->pre, &argse.pre); } --- /dev/null 2013-06-07 09:13:23.024185858 +0200 +++ gcc/gcc/testsuite/gfortran.dg/storage_size_4.f90 2013-06-07 17:34:12.719284544 +0200 @@ -0,0 +1,23 @@ +! { dg-do compile } +! { dg-options "-fdump-tree-original" } +! +! PR fortran/57553 +! +! Ensure that there is no ICE and that compile-time simplication works. +! + use iso_fortran_env + implicit none + integer, parameter :: ESize = storage_size('a') + integer, parameter :: ESize2 = storage_size('aa') + if ( ESize/CHARACTER_STORAGE_SIZE /= 1) call abort() + if ( ESize2/CHARACTER_STORAGE_SIZE /= 2) call abort() +end + +subroutine S ( A ) + character(len=*), intent(in) :: A + integer :: ESize = 4 + esize = ( storage_size(a) + 7 ) / 8 +end + +! { dg-final { scan-tree-dump-not "abort" "original" } } +! { dg-final { cleanup-tree-dump "original" } }