From patchwork Tue Mar 6 21:40:14 2018 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 7bit X-Patchwork-Submitter: Thomas Koenig X-Patchwork-Id: 882282 Return-Path: X-Original-To: incoming@patchwork.ozlabs.org Delivered-To: patchwork-incoming@bilbo.ozlabs.org Authentication-Results: ozlabs.org; spf=pass (mailfrom) smtp.mailfrom=gcc.gnu.org (client-ip=209.132.180.131; helo=sourceware.org; envelope-from=gcc-patches-return-474352-incoming=patchwork.ozlabs.org@gcc.gnu.org; receiver=) Authentication-Results: ozlabs.org; dmarc=fail (p=none dis=none) header.from=netcologne.de Authentication-Results: ozlabs.org; dkim=pass (1024-bit key; unprotected) header.d=gcc.gnu.org header.i=@gcc.gnu.org header.b="l5ZaDCQt"; dkim-atps=neutral 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 3zwqvR2HDtz9sWj for ; Wed, 7 Mar 2018 08:40:33 +1100 (AEDT) DomainKey-Signature: a=rsa-sha1; c=nofws; d=gcc.gnu.org; h=list-id :list-unsubscribe:list-archive:list-post:list-help:sender:to :from:subject:message-id:date:mime-version:content-type; q=dns; s=default; b=J9CNMmartq1KYk9B7LklFpyEI55jsFG4boEgmMCBBvQ2A7UyaX pVw7PpSrAvuIrrYOmVbTfSzluCYP8ybC8yha1OgzfwEFnIGGYTYRCxWhPmSDV38T +thvIQ3aBtjjn2syWTPNHS+BymPQOdTTCwyaJ8QIM53L8Dw+px6ouFIB8= 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:to :from:subject:message-id:date:mime-version:content-type; s= default; bh=Bwr8tyUio6rF8Nbijx+woxn5UBs=; b=l5ZaDCQthFCpfw94pVpQ UWSahWPBPA3XLS3M7Ik6YlyOTullTkjf900drRV5hym3pnz3jnqnmu7BtGoZz8WJ X2MIjQexzMNTudVPAikkZivTJvvMQ9rtbhA6ixO3iQFGZOXxrsAf1Cpnvws2WW+P 6WZYPTSc1q1c4WHuMDsur8c= Received: (qmail 16162 invoked by alias); 6 Mar 2018 21:40:22 -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 16142 invoked by uid 89); 6 Mar 2018 21:40:21 -0000 Authentication-Results: sourceware.org; auth=none X-Virus-Found: No X-Spam-SWARE-Status: No, score=-10.6 required=5.0 tests=AWL, BAYES_00, GIT_PATCH_2, GIT_PATCH_3, KAM_ASCII_DIVIDERS, KAM_NUMSUBJECT, RCVD_IN_DNSWL_LOW, SPF_PASS, T_RP_MATCHES_RCVD autolearn=ham version=3.3.2 spammy=25928, 6I2, 6i2, tkoenig@gcc.gnu.org X-Spam-User: qpsmtpd, 2 recipients X-HELO: cc-smtpout2.netcologne.de Received: from cc-smtpout2.netcologne.de (HELO cc-smtpout2.netcologne.de) (89.1.8.212) by sourceware.org (qpsmtpd/0.93/v0.84-503-g423c35a) with ESMTP; Tue, 06 Mar 2018 21:40:19 +0000 Received: from cc-smtpin1.netcologne.de (cc-smtpin1.netcologne.de [89.1.8.201]) by cc-smtpout2.netcologne.de (Postfix) with ESMTP id D6C4A128C4; Tue, 6 Mar 2018 22:40:16 +0100 (CET) Received: from localhost (localhost [127.0.0.1]) by cc-smtpin1.netcologne.de (Postfix) with ESMTP id CB16F11DC4; Tue, 6 Mar 2018 22:40:16 +0100 (CET) Received: from [78.35.154.218] (helo=cc-smtpin1.netcologne.de) by localhost with ESMTP (eXpurgate 4.1.9) (envelope-from ) id 5a9f0ac0-029d-7f0000012729-7f000001b8e4-1 for ; Tue, 06 Mar 2018 22:40:16 +0100 Received: from [192.168.178.20] (xdsl-78-35-154-218.netcologne.de [78.35.154.218]) (using TLSv1.2 with cipher ECDHE-RSA-AES256-GCM-SHA384 (256/256 bits)) (No client certificate requested) by cc-smtpin1.netcologne.de (Postfix) with ESMTPSA; Tue, 6 Mar 2018 22:40:15 +0100 (CET) To: "fortran@gcc.gnu.org" , gcc-patches From: Thomas Koenig Subject: [patch, fortran] Fix PR 84697 Message-ID: Date: Tue, 6 Mar 2018 22:40:14 +0100 User-Agent: Mozilla/5.0 (X11; Linux x86_64; rv:52.0) Gecko/20100101 Thunderbird/52.6.0 MIME-Version: 1.0 Hello world, the attached patch fixes a bug, partly an 8 regression, for simplifying an expression containing minloc or maxloc. The underlying problem was that integer, dimension(0), parameter :: z=0 ended up as EXPR_CONSTANT even though the rank was one, which was then passed to the simplification routines, which either ICEd or gave wrong results. In doing this, I had to change the logic of the is_size_zero_array function. Trying to call it from within the simplification rountines led to the simplification routines to be called, and so on... until the stack ran out. As soon as this is committed, I'll also look if there is anything left in PR66128, and close that bug if appropriate Regression-tested. OK for trunk? 2017-03-06 Thomas Koenig PR fortran/84697 PR fortran/66128 * expr.c (simplify_parameter_variable): If p is a size zero array and not an ARRAY_EXPR insert an empty array constructor and return. * gfortran.h: Add prototype for gfc_is_size_zero_array. * simplify.c (is_size_zero_array): Make non-static and rename into (gfc_is_size_zero_array): Check for parameter arrays of zero size by comparing shape and absence of constructor. (gfc_simplify_all): Use gfc_is_size_zero_array instead of is_size_zero_array. (gfc_simplify_count): Likewise. (gfc_simplify_iall): Likewise. (gfc_simplify_iany): Likewise. (gfc_simplify_iparity): Likewise. (gfc_simplify_minval): Likewise. (gfc_simplify_maxval): Likewise. (gfc_simplify_product): Likewise. (gfc_simplify_sum): Likewise. 2017-03-06 Thomas Koenig PR fortran/84697 PR fortran/66128 * gfortran.dg/minmaxloc_zerosize_1.f90: New test. Index: expr.c =================================================================== --- expr.c (Revision 258264) +++ expr.c (Arbeitskopie) @@ -1857,6 +1857,22 @@ simplify_parameter_variable (gfc_expr *p, int type gfc_expr *e; bool t; + if (gfc_is_size_zero_array (p)) + { + if (p->expr_type == EXPR_ARRAY) + return true; + + e = gfc_get_expr (); + e->expr_type = EXPR_ARRAY; + e->ts = p->ts; + e->rank = p->rank; + e->value.constructor = NULL; + e->shape = gfc_copy_shape (p->shape, p->rank); + e->where = p->where; + gfc_replace_expr (p, e); + return true; + } + e = gfc_copy_expr (p->symtree->n.sym->value); if (e == NULL) return false; Index: gfortran.h =================================================================== --- gfortran.h (Revision 258264) +++ gfortran.h (Arbeitskopie) @@ -3464,6 +3464,7 @@ int gfc_code_walker (gfc_code **, walk_code_fn_t, void gfc_convert_mpz_to_signed (mpz_t, int); gfc_expr *gfc_simplify_ieee_functions (gfc_expr *); +bool gfc_is_size_zero_array (gfc_expr *); /* trans-array.c */ Index: simplify.c =================================================================== --- simplify.c (Revision 258264) +++ simplify.c (Arbeitskopie) @@ -259,26 +259,28 @@ is_constant_array_expr (gfc_expr *e) } /* Test for a size zero array. */ -static bool -is_size_zero_array (gfc_expr *array) +bool +gfc_is_size_zero_array (gfc_expr *array) { - gfc_expr *e; - bool t; - e = gfc_copy_expr (array); - gfc_simplify_expr (e, 1); + if (array->rank == 0) + return false; - if (e->expr_type == EXPR_CONSTANT && e->rank > 0 && !e->shape) - t = true; - else if (e->expr_type == EXPR_ARRAY && e->rank > 0 - && !e->shape && !e->value.constructor) - t = true; - else - t = false; + if (array->expr_type == EXPR_VARIABLE && array->rank > 0 + && array->symtree->n.sym->attr.flavor == FL_PARAMETER + && array->shape != NULL) + { + for (int i = 0; i < array->rank; i++) + if (mpz_cmp_si (array->shape[i], 0) <= 0) + return true; - gfc_free_expr (e); + return false; + } - return t; + if (array->expr_type == EXPR_ARRAY) + return array->value.constructor == NULL; + + return false; } @@ -974,7 +976,7 @@ gfc_simplify_aint (gfc_expr *e, gfc_expr *k) gfc_expr * gfc_simplify_all (gfc_expr *mask, gfc_expr *dim) { - if (is_size_zero_array (mask)) + if (gfc_is_size_zero_array (mask)) return gfc_get_logical_expr (mask->ts.kind, &mask->where, true); return simplify_transformation (mask, dim, NULL, true, gfc_and); @@ -1066,7 +1068,7 @@ gfc_simplify_and (gfc_expr *x, gfc_expr *y) gfc_expr * gfc_simplify_any (gfc_expr *mask, gfc_expr *dim) { - if (is_size_zero_array (mask)) + if (gfc_is_size_zero_array (mask)) return gfc_get_logical_expr (mask->ts.kind, &mask->where, false); return simplify_transformation (mask, dim, NULL, false, gfc_or); @@ -1965,7 +1967,7 @@ gfc_simplify_count (gfc_expr *mask, gfc_expr *dim, { gfc_expr *result; - if (is_size_zero_array (mask)) + if (gfc_is_size_zero_array (mask)) { int k; k = kind ? mpz_get_si (kind->value.integer) : gfc_default_integer_kind; @@ -3263,7 +3265,7 @@ do_bit_and (gfc_expr *result, gfc_expr *e) gfc_expr * gfc_simplify_iall (gfc_expr *array, gfc_expr *dim, gfc_expr *mask) { - if (is_size_zero_array (array)) + if (gfc_is_size_zero_array (array)) return gfc_get_int_expr (array->ts.kind, NULL, -1); return simplify_transformation (array, dim, mask, -1, do_bit_and); @@ -3285,7 +3287,7 @@ do_bit_ior (gfc_expr *result, gfc_expr *e) gfc_expr * gfc_simplify_iany (gfc_expr *array, gfc_expr *dim, gfc_expr *mask) { - if (is_size_zero_array (array)) + if (gfc_is_size_zero_array (array)) return gfc_get_int_expr (array->ts.kind, NULL, 0); return simplify_transformation (array, dim, mask, 0, do_bit_ior); @@ -3728,7 +3730,7 @@ do_bit_xor (gfc_expr *result, gfc_expr *e) gfc_expr * gfc_simplify_iparity (gfc_expr *array, gfc_expr *dim, gfc_expr *mask) { - if (is_size_zero_array (array)) + if (gfc_is_size_zero_array (array)) return gfc_get_int_expr (array->ts.kind, NULL, 0); return simplify_transformation (array, dim, mask, 0, do_bit_xor); @@ -5038,7 +5040,7 @@ gfc_min (gfc_expr *op1, gfc_expr *op2) gfc_expr * gfc_simplify_minval (gfc_expr *array, gfc_expr* dim, gfc_expr *mask) { - if (is_size_zero_array (array)) + if (gfc_is_size_zero_array (array)) { gfc_expr *result; int i; @@ -5094,7 +5096,7 @@ gfc_max (gfc_expr *op1, gfc_expr *op2) gfc_expr * gfc_simplify_maxval (gfc_expr *array, gfc_expr* dim, gfc_expr *mask) { - if (is_size_zero_array (array)) + if (gfc_is_size_zero_array (array)) { gfc_expr *result; int i; @@ -5776,7 +5778,7 @@ gfc_simplify_norm2 (gfc_expr *e, gfc_expr *dim) { gfc_expr *result; - if (is_size_zero_array (e)) + if (gfc_is_size_zero_array (e)) { gfc_expr *result; result = gfc_get_constant_expr (e->ts.type, e->ts.kind, &e->where); @@ -6040,7 +6042,7 @@ gfc_simplify_precision (gfc_expr *e) gfc_expr * gfc_simplify_product (gfc_expr *array, gfc_expr *dim, gfc_expr *mask) { - if (is_size_zero_array (array)) + if (gfc_is_size_zero_array (array)) { gfc_expr *result; @@ -7384,7 +7386,7 @@ gfc_simplify_sqrt (gfc_expr *e) gfc_expr * gfc_simplify_sum (gfc_expr *array, gfc_expr *dim, gfc_expr *mask) { - if (is_size_zero_array (array)) + if (gfc_is_size_zero_array (array)) { gfc_expr *result;