From patchwork Sun May 10 13:58:37 2015 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 8bit X-Patchwork-Submitter: Mikael Morin X-Patchwork-Id: 470455 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.2 with cipher ECDHE-RSA-AES256-GCM-SHA384 (256/256 bits)) (No client certificate requested) by ozlabs.org (Postfix) with ESMTPS id B8559140B0D for ; Sun, 10 May 2015 23:59:08 +1000 (AEST) Authentication-Results: ozlabs.org; dkim=pass (1024-bit key; unprotected) header.d=gcc.gnu.org header.i=@gcc.gnu.org header.b=icTn9sHv; dkim-atps=neutral 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:to:subject:references :in-reply-to:content-type; q=dns; s=default; b=TGEG3VoaIX2+It5I1 TEdm03F/hPVHAQ0lKS7IK0itiaJaTnBq9Tfr7JwB+6gbSMSPZD4dljnseZ1ZJJ85 nReZ3GBPsy1H+a5dX5NwWxogHY43ErFMtflxfvb75JNaHLQk9QEJYbza2NECCRz0 2PANJre+aBwZxVJDq0F3/jtBPM= 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:to:subject:references :in-reply-to:content-type; s=default; bh=aTznOFaK7IvwC3KcyCMzXNQ b3MA=; b=icTn9sHvgecKZyGYrBjVSo9sVHFUYBsBNN5E7hFYTY/owQQpvqvWord +J44LqU6w1shX41rjKpNOS+pCGUgb87IGDvGcBnA4AXiJypBH65evddtFE/2iCr4 pcxuezOwBDzBtUerGOg52OKBy6lq37dEuNOqFAYR+GpPsuWiBSng= Received: (qmail 21021 invoked by alias); 10 May 2015 13:59:00 -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 20997 invoked by uid 89); 10 May 2015 13:58:59 -0000 Authentication-Results: sourceware.org; auth=none X-Virus-Found: No X-Spam-SWARE-Status: No, score=-1.5 required=5.0 tests=AWL, BAYES_00, KAM_ASCII_DIVIDERS, RCVD_IN_DNSWL_NONE, SPF_PASS, T_RP_MATCHES_RCVD autolearn=no version=3.3.2 X-Spam-User: qpsmtpd, 2 recipients X-HELO: smtp22.services.sfr.fr Received: from smtp22.services.sfr.fr (HELO smtp22.services.sfr.fr) (93.17.128.11) by sourceware.org (qpsmtpd/0.93/v0.84-503-g423c35a) with (AES256-SHA encrypted) ESMTPS; Sun, 10 May 2015 13:58:58 +0000 Received: from filter.sfr.fr (localhost [86.72.15.254]) by msfrf2206.sfr.fr (SMTP Server) with ESMTP id 283EB70000E4; Sun, 10 May 2015 15:58:55 +0200 (CEST) Authentication-Results: sfrmc.priv.atos.fr; dkim=none (no signature); dkim-adsp=none (no policy) header.from=mikael.morin@sfr.fr Received: from tolstoi.localhost (254.15.72.86.rev.sfr.net [86.72.15.254]) (using TLSv1 with cipher DHE-RSA-AES128-SHA (128/128 bits)) (No client certificate requested) by msfrf2206.sfr.fr (SMTP Server) with ESMTP id 3FC3170000A7; Sun, 10 May 2015 15:58:54 +0200 (CEST) X-SFR-UUID: 20150510135854261.3FC3170000A7@msfrf2206.sfr.fr Message-ID: <554F640D.5020506@sfr.fr> Date: Sun, 10 May 2015 15:58:37 +0200 From: Mikael Morin User-Agent: Mozilla/5.0 (X11; Linux x86_64; rv:31.0) Gecko/20100101 Thunderbird/31.6.0 MIME-Version: 1.0 To: Thomas Koenig , "fortran@gcc.gnu.org" , gcc-patches Subject: Re: [Patch, Fortran] Simplify lbound References: <553B7BA4.6040103@netcologne.de> <553BD925.3050401@sfr.fr> <553E83B4.8020005@netcologne.de> <5542722E.3030307@sfr.fr> <5543EA34.6060304@sfr.fr> <5546872F.7040507@netcologne.de> In-Reply-To: <5546872F.7040507@netcologne.de> X-IsSubscribed: yes Le 03/05/2015 22:38, Thomas Koenig a écrit : > Hi Mikael, > > Looks good. > > In general, it is better to restrict changes to existing test cases to > the necessary minimum that they still pass, and add new code to new > test cases. This makes regressions easier to track. > > So, OK with that change. > Here is what I have committed. Mikael Index: testsuite/gfortran.dg/bound_simplification_5.f90 =================================================================== --- testsuite/gfortran.dg/bound_simplification_5.f90 (révision 0) +++ testsuite/gfortran.dg/bound_simplification_5.f90 (révision 222979) @@ -0,0 +1,75 @@ +! { dg-do run } +! { dg-additional-options "-fcoarray=single -fdump-tree-original" } +! +! Check that {L,U}{,CO}BOUND intrinsics are properly simplified. +! + implicit none + + type :: t + integer :: c + end type t + + type(t) :: d(3:8) = t(7) + type(t) :: e[5:9,-1:*] + type(t) :: h(3), j(4), k(0) + + !Test full arrays vs subarrays + if (lbound(d, 1) /= 3) call abort + if (lbound(d(3:5), 1) /= 1) call abort + if (lbound(d%c, 1) /= 1) call abort + if (ubound(d, 1) /= 8) call abort + if (ubound(d(3:5), 1) /= 3) call abort + if (ubound(d%c, 1) /= 6) call abort + + if (lcobound(e, 1) /= 5) call abort + if (lcobound(e%c, 1) /= 5) call abort + if (lcobound(e, 2) /= -1) call abort + if (lcobound(e%c, 2) /= -1) call abort + if (ucobound(e, 1) /= 9) call abort + if (ucobound(e%c, 1) /= 9) call abort + ! no simplification for ucobound(e{,%c}, dim=2) + + if (any(lbound(d ) /= [3])) call abort + if (any(lbound(d(3:5)) /= [1])) call abort + if (any(lbound(d%c ) /= [1])) call abort + if (any(ubound(d ) /= [8])) call abort + if (any(ubound(d(3:5)) /= [3])) call abort + if (any(ubound(d%c ) /= [6])) call abort + + if (any(lcobound(e ) /= [5, -1])) call abort + if (any(lcobound(e%c) /= [5, -1])) call abort + ! no simplification for ucobound(e{,%c}) + + call test_empty_arrays(h, j, k) + +contains + subroutine test_empty_arrays(a, c, d) + type(t) :: a(:), c(-3:0), d(3:1) + type(t) :: f(4:2), g(0:6) + + if (lbound(a, 1) /= 1) call abort + if (lbound(c, 1) /= -3) call abort + if (lbound(d, 1) /= 1) call abort + if (lbound(f, 1) /= 1) call abort + if (lbound(g, 1) /= 0) call abort + + if (ubound(c, 1) /= 0) call abort + if (ubound(d, 1) /= 0) call abort + if (ubound(f, 1) /= 0) call abort + if (ubound(g, 1) /= 6) call abort + + if (any(lbound(a) /= [ 1])) call abort + if (any(lbound(c) /= [-3])) call abort + if (any(lbound(d) /= [ 1])) call abort + if (any(lbound(f) /= [ 1])) call abort + if (any(lbound(g) /= [ 0])) call abort + + if (any(ubound(c) /= [0])) call abort + if (any(ubound(d) /= [0])) call abort + if (any(ubound(f) /= [0])) call abort + if (any(ubound(g) /= [6])) call abort + + end subroutine +end +! { dg-final { scan-tree-dump-not "abort" "original" } } +! { dg-final { cleanup-tree-dump "original" } } Index: testsuite/ChangeLog =================================================================== --- testsuite/ChangeLog (révision 222978) +++ testsuite/ChangeLog (révision 222979) @@ -1,3 +1,7 @@ +2015-05-10 Mikael Morin + + * gfortran.dg/bound_simplification_5.f90: New. + 2015-05-09 Jason Merrill * lib/target-supports.exp (cxx_default): New global. Index: fortran/ChangeLog =================================================================== --- fortran/ChangeLog (révision 222978) +++ fortran/ChangeLog (révision 222979) @@ -1,3 +1,11 @@ +2015-05-10 Mikael Morin + + * simplify.c (simplify_bound_dim): Don't check for emptyness + in the case of cobound simplification. Factor lower/upper + bound differenciation before the actual simplification. + (simplify_bound): Remove assumed shape specific simplification. + Don't give up early for the lbound of an assumed shape. + 2015-05-09 Mikael Morin PR fortran/65894 Index: fortran/simplify.c =================================================================== --- fortran/simplify.c (révision 222978) +++ fortran/simplify.c (révision 222979) @@ -3340,29 +3340,43 @@ /* Then, we need to know the extent of the given dimension. */ if (coarray || (ref->u.ar.type == AR_FULL && !ref->next)) { + gfc_expr *declared_bound; + int empty_bound; + bool constant_lbound, constant_ubound; + l = as->lower[d-1]; u = as->upper[d-1]; - if (l->expr_type != EXPR_CONSTANT || u == NULL - || u->expr_type != EXPR_CONSTANT) + gcc_assert (l != NULL); + + constant_lbound = l->expr_type == EXPR_CONSTANT; + constant_ubound = u && u->expr_type == EXPR_CONSTANT; + + empty_bound = upper ? 0 : 1; + declared_bound = upper ? u : l; + + if ((!upper && !constant_lbound) + || (upper && !constant_ubound)) goto returnNull; - if (mpz_cmp (l->value.integer, u->value.integer) > 0) + if (!coarray) { - /* Zero extent. */ - if (upper) - mpz_set_si (result->value.integer, 0); + /* For {L,U}BOUND, the value depends on whether the array + is empty. We can nevertheless simplify if the declared bound + has the same value as that of an empty array, in which case + the result isn't dependent on the array emptyness. */ + if (mpz_cmp_si (declared_bound->value.integer, empty_bound) == 0) + mpz_set_si (result->value.integer, empty_bound); + else if (!constant_lbound || !constant_ubound) + /* Array emptyness can't be determined, we can't simplify. */ + goto returnNull; + else if (mpz_cmp (l->value.integer, u->value.integer) > 0) + mpz_set_si (result->value.integer, empty_bound); else - mpz_set_si (result->value.integer, 1); + mpz_set (result->value.integer, declared_bound->value.integer); } else - { - /* Nonzero extent. */ - if (upper) - mpz_set (result->value.integer, u->value.integer); - else - mpz_set (result->value.integer, l->value.integer); - } + mpz_set (result->value.integer, declared_bound->value.integer); } else { @@ -3442,43 +3456,16 @@ done: - /* If the array shape is assumed shape or explicit, we can simplify lbound - to 1 if the given lower bound is one because this matches what lbound - should return for an empty array. */ + if (as && (as->type == AS_DEFERRED || as->type == AS_ASSUMED_RANK + || (as->type == AS_ASSUMED_SHAPE && upper))) + return NULL; - if (!upper && as && dim && dim->expr_type == EXPR_CONSTANT - && (as->type == AS_ASSUMED_SHAPE || as->type == AS_EXPLICIT) - && ref->u.ar.type != AR_SECTION) - { - /* Watch out for allocatable or pointer dummy arrays, they can have - lower bounds that are not equal to one. */ - if (!(array->symtree && array->symtree->n.sym - && (array->symtree->n.sym->attr.allocatable - || array->symtree->n.sym->attr.pointer))) - { - unsigned long int ndim; - gfc_expr *lower, *res; + gcc_assert (!as + || (as->type != AS_DEFERRED + && array->expr_type == EXPR_VARIABLE + && !array->symtree->n.sym->attr.allocatable + && !array->symtree->n.sym->attr.pointer)); - ndim = mpz_get_si (dim->value.integer) - 1; - lower = as->lower[ndim]; - if (lower->expr_type == EXPR_CONSTANT - && mpz_cmp_si (lower->value.integer, 1) == 0) - { - res = gfc_copy_expr (lower); - if (kind) - { - int nkind = mpz_get_si (kind->value.integer); - res->ts.kind = nkind; - } - return res; - } - } - } - - if (as && (as->type == AS_DEFERRED || as->type == AS_ASSUMED_SHAPE - || as->type == AS_ASSUMED_RANK)) - return NULL; - if (dim == NULL) { /* Multi-dimensional bounds. */