From patchwork Tue Aug 18 20:07:04 2020 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 7bit X-Patchwork-Submitter: Harald Anlauf X-Patchwork-Id: 1347263 Return-Path: X-Original-To: incoming@patchwork.ozlabs.org Delivered-To: patchwork-incoming@bilbo.ozlabs.org Authentication-Results: ozlabs.org; spf=pass (sender SPF authorized) smtp.mailfrom=gcc.gnu.org (client-ip=8.43.85.97; helo=sourceware.org; envelope-from=gcc-patches-bounces@gcc.gnu.org; receiver=) Authentication-Results: ozlabs.org; dmarc=none (p=none dis=none) header.from=gmx.de Authentication-Results: ozlabs.org; dkim=fail reason="signature verification failed" (1024-bit key; secure) header.d=gmx.net header.i=@gmx.net header.a=rsa-sha256 header.s=badeba3b8450 header.b=PvcPyZWv; dkim-atps=neutral Received: from sourceware.org (server2.sourceware.org [8.43.85.97]) (using TLSv1.3 with cipher TLS_AES_256_GCM_SHA384 (256/256 bits) key-exchange X25519 server-signature RSA-PSS (4096 bits) server-digest SHA256) (No client certificate requested) by ozlabs.org (Postfix) with ESMTPS id 4BWMQC18Fgz9sPC for ; Wed, 19 Aug 2020 06:07:13 +1000 (AEST) Received: from server2.sourceware.org (localhost [IPv6:::1]) by sourceware.org (Postfix) with ESMTP id BD1A23850401; Tue, 18 Aug 2020 20:07:09 +0000 (GMT) X-Original-To: gcc-patches@gcc.gnu.org Delivered-To: gcc-patches@gcc.gnu.org Received: from mout.gmx.net (mout.gmx.net [212.227.15.19]) by sourceware.org (Postfix) with ESMTPS id 6F67D3858D37; Tue, 18 Aug 2020 20:07:06 +0000 (GMT) DMARC-Filter: OpenDMARC Filter v1.3.2 sourceware.org 6F67D3858D37 Authentication-Results: sourceware.org; dmarc=none (p=none dis=none) header.from=gmx.de Authentication-Results: sourceware.org; spf=pass smtp.mailfrom=anlauf@gmx.de DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/simple; d=gmx.net; s=badeba3b8450; t=1597781224; bh=ScJo1JfrG0fhqkCIfpNm1BYr8wQF7oE5KUjpElI/Agg=; h=X-UI-Sender-Class:From:To:Cc:Subject:Date:In-Reply-To:References; b=PvcPyZWvGbc1bkoFQF6TahepRCBfQ3ZDaz5EkmjkTvDZmt9pjKtlOHcetqjn+bPcC vmF95WNqvoY6CKdrkRpKD18syEDg2bs6qJ031TcQKTZWjISQm1fqd3seK0RvhXYQLg 0NrXYpnQGCpBzTCFWE0vVsztrXqMLHwAHAxCXcZc= X-UI-Sender-Class: 01bb95c1-4bf8-414a-932a-4f6e2808ef9c Received: from [93.207.86.182] ([93.207.86.182]) by web-mail.gmx.net (3c-app-gmx-bs20.server.lan [172.19.170.72]) (via HTTP); Tue, 18 Aug 2020 22:07:04 +0200 MIME-Version: 1.0 Message-ID: From: Harald Anlauf To: Harald Anlauf Subject: [PATCH, committed] PR fortran/96613,96686 - Fix type/kind issues, temporaries evaluating MIN/MAX Date: Tue, 18 Aug 2020 22:07:04 +0200 Importance: normal Sensitivity: Normal In-Reply-To: References: X-UI-Message-Type: mail X-Priority: 3 X-Provags-ID: V03:K1:GRtcKL7YzfhLbwaCDHJc0Kda29ncgxMx1QwdzqdfDJhDaxPdSFT9l+XV9MLcuPE36eprq c8CbMBFFGDanqlD55xS19foXAPInxbrM7vH0fcV7HoMmUvAQSPt7Tj8TOtgnjUgDgHk1Og6QunGI 8vk4TVeT5h1+ZOcurujarkEH6eoIHzlNPKAOxgckpFSWzUHpZr+qzci/jzZxYkDI72rZbXkEPGAa 31+O+mnNU+QWu1gwThvBZZcSvBTQnGszDH2+N3WdVQ84lRt5lSvD43QOs0SCKRd+MCN9HG7ZHAe0 28= X-UI-Out-Filterresults: notjunk:1;V03:K0:ZE5qS752lxA=:y3VIw9EN9l2vnUrM/quFEA 2RZ+WytsW57HpssOcFNDAjUgsJG23iaMtqLyDDvUhTqG2cV7hcYUaispSjpxXlh9TLVO65O0u cXRUetyFYAn7CDBQGhWdCNHgTAWFCva2/TC47t8kH+NA22TJ54mGuzHm1/37MzYb+8H9LM1we /CNu0GBiYAmWpCHy0UIHLowDgSiBVFaRkZloiB+PPlIdOmWGI/UvsJOYE3aEQ9+Zv+OUhMW9t qVbCMJEFadImdNxQprreq8KrJ7+rTgxX+QgR1V8JP5TMRrP9O3F16mNBJDKAw5nmSLjtVOsUd ThgUUR9IGPf+d2nx2wKC3dj4Yje7cGzJnDNMMUrG4261jqLhzZbdB6yZQyJSRe2IIVJhDXyfi uXI1zyL2BsaFDvqo6FP2VhvKTfBFahO80AfqsbMZqMNH03ODh6Nnp44ZiByhPGCQUoxmv7J2Q KXPYZyi6RJJt1M/fciwvFUUY35idDukaoBoduKvn2mKS7Z7Z8zx0bChsZlQ6gx8EEviVkEDL8 1bcu2+7IwkjvRZNb71YMedqj3DGJPVBkCf7aZwXepi0tWFDkzvsUU/XIZHWAJ1Vro3AGbVhso LvufmxGhbGpiIwU/lIdaCDd/nIWKtF9vRXvKc3okiqkKxckWGWts/kme1One8N/5iS6czwu59 5klxbHv2XklQoxDC7Cdz5Dhbh5AHk0RMaW7amnsRH+TwoRw== X-Spam-Status: No, score=-9.4 required=5.0 tests=BAYES_00, DKIM_SIGNED, DKIM_VALID, FREEMAIL_FROM, GIT_PATCH_0, RCVD_IN_BARRACUDACENTRAL, RCVD_IN_DNSWL_LOW, RCVD_IN_MSPIKE_H2, SPF_HELO_NONE, SPF_PASS, TXREP autolearn=ham autolearn_force=no version=3.4.2 X-Spam-Checker-Version: SpamAssassin 3.4.2 (2018-09-13) on server2.sourceware.org X-BeenThere: gcc-patches@gcc.gnu.org X-Mailman-Version: 2.1.29 Precedence: list List-Id: Gcc-patches mailing list List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Cc: gcc-patches , fortran Errors-To: gcc-patches-bounces@gcc.gnu.org Sender: "Gcc-patches" There was another issue (PR96686) with MIN/MAX for character arguments of different kind. Character arguments to MIN/MAX are a Fortran 2003 feature, so there is no real reason to have a new GNU extension, and no related legacy code. Instead of ICEing, we now unconditionally generate an error This was confirmed in PR96686 by Steve, who also approved the patch for PR96613. Both patches were combined, regtested on x86_64-pc-linux-gnu, and committed. Thanks, Harald Full commit message: PR fortran/96613,96686 - Fix type/kind issues, temporaries evaluating MIN/MAX When evaluating functions of the MIN/MAX variety inline, use a temporary of appropriate type and kind, and convert to the result type at the end. In the case of allowing for the GNU extensions to MIN/MAX, derive the result kind consistently during simplificaton. Furthermore, the Fortran standard requires type and kind of arguments to the MIN/MAX intrinsics to all have the same type and kind. While a GNU extension accepts kind differences for integer and real arguments which seems to have been used in legacy code, there is no reason to allow different character kinds. We now reject the latter unconditionally. gcc/fortran/ChangeLog: * check.c (check_rest): Reject MIN/MAX character arguments of different kind. * simplify.c (min_max_choose): The simplification result shall have the highest kind value of the arguments. * trans-intrinsic.c (gfc_conv_intrinsic_minmax): Choose type and kind of intermediate by looking at all arguments, not the result. gcc/testsuite/ChangeLog: * gfortran.dg/minmax_char_3.f90: New test. * gfortran.dg/min_max_kind.f90: New test. * gfortran.dg/pr96613.f90: New test. diff --git a/gcc/fortran/check.c b/gcc/fortran/check.c index 74e5e448760..65b46cd3f85 100644 --- a/gcc/fortran/check.c +++ b/gcc/fortran/check.c @@ -3693,6 +3693,11 @@ check_rest (bt type, int kind, gfc_actual_arglist *arglist) { if (x->ts.type == type) { + if (x->ts.type == BT_CHARACTER) + { + gfc_error ("Different character kinds at %L", &x->where); + return false; + } if (!gfc_notify_std (GFC_STD_GNU, "Different type " "kinds at %L", &x->where)) return false; diff --git a/gcc/fortran/simplify.c b/gcc/fortran/simplify.c index eb8b2afeb29..074b50c2e68 100644 --- a/gcc/fortran/simplify.c +++ b/gcc/fortran/simplify.c @@ -4924,6 +4924,8 @@ min_max_choose (gfc_expr *arg, gfc_expr *extremum, int sign, bool back_val) switch (arg->ts.type) { case BT_INTEGER: + if (extremum->ts.kind < arg->ts.kind) + extremum->ts.kind = arg->ts.kind; ret = mpz_cmp (arg->value.integer, extremum->value.integer) * sign; if (ret > 0) @@ -4931,6 +4933,8 @@ min_max_choose (gfc_expr *arg, gfc_expr *extremum, int sign, bool back_val) break; case BT_REAL: + if (extremum->ts.kind < arg->ts.kind) + extremum->ts.kind = arg->ts.kind; if (mpfr_nan_p (extremum->value.real)) { ret = 1; diff --git a/gcc/fortran/trans-intrinsic.c b/gcc/fortran/trans-intrinsic.c index fd8809902b7..2483f016d8e 100644 --- a/gcc/fortran/trans-intrinsic.c +++ b/gcc/fortran/trans-intrinsic.c @@ -4073,6 +4073,7 @@ gfc_conv_intrinsic_minmax (gfc_se * se, gfc_expr * expr, enum tree_code op) tree val; tree *args; tree type; + tree argtype; gfc_actual_arglist *argexpr; unsigned int i, nargs; @@ -4082,16 +4083,24 @@ gfc_conv_intrinsic_minmax (gfc_se * se, gfc_expr * expr, enum tree_code op) gfc_conv_intrinsic_function_args (se, expr, args, nargs); type = gfc_typenode_for_spec (&expr->ts); - argexpr = expr->value.function.actual; - if (TREE_TYPE (args[0]) != type) - args[0] = convert (type, args[0]); /* Only evaluate the argument once. */ if (!VAR_P (args[0]) && !TREE_CONSTANT (args[0])) args[0] = gfc_evaluate_now (args[0], &se->pre); - mvar = gfc_create_var (type, "M"); - gfc_add_modify (&se->pre, mvar, args[0]); + /* Determine suitable type of temporary, as a GNU extension allows + different argument kinds. */ + argtype = TREE_TYPE (args[0]); + argexpr = expr->value.function.actual; + for (i = 1, argexpr = argexpr->next; i < nargs; i++, argexpr = argexpr->next) + { + tree tmptype = TREE_TYPE (args[i]); + if (TYPE_PRECISION (tmptype) > TYPE_PRECISION (argtype)) + argtype = tmptype; + } + mvar = gfc_create_var (argtype, "M"); + gfc_add_modify (&se->pre, mvar, convert (argtype, args[0])); + argexpr = expr->value.function.actual; for (i = 1, argexpr = argexpr->next; i < nargs; i++, argexpr = argexpr->next) { tree cond = NULL_TREE; @@ -4119,8 +4128,8 @@ gfc_conv_intrinsic_minmax (gfc_se * se, gfc_expr * expr, enum tree_code op) Also, there is no consensus among other tested compilers. In short, it's a mess. So lets just do whatever is fastest. */ tree_code code = op == GT_EXPR ? MAX_EXPR : MIN_EXPR; - calc = fold_build2_loc (input_location, code, type, - convert (type, val), mvar); + calc = fold_build2_loc (input_location, code, argtype, + convert (argtype, val), mvar); tmp = build2_v (MODIFY_EXPR, mvar, calc); if (cond != NULL_TREE) @@ -4128,7 +4137,10 @@ gfc_conv_intrinsic_minmax (gfc_se * se, gfc_expr * expr, enum tree_code op) build_empty_stmt (input_location)); gfc_add_expr_to_block (&se->pre, tmp); } - se->expr = mvar; + if (TREE_CODE (type) == INTEGER_TYPE) + se->expr = fold_build1_loc (input_location, FIX_TRUNC_EXPR, type, mvar); + else + se->expr = convert (type, mvar); } diff --git a/gcc/testsuite/gfortran.dg/min_max_kind.f90 b/gcc/testsuite/gfortran.dg/min_max_kind.f90 new file mode 100644 index 00000000000..b22691e1ffe --- /dev/null +++ b/gcc/testsuite/gfortran.dg/min_max_kind.f90 @@ -0,0 +1,15 @@ +! { dg-do run } +! { dg-options "-O2 -std=gnu" } +! Verify that the GNU extensions to MIN/MAX handle mixed kinds properly. + +program p + implicit none + integer(1), parameter :: i1 = 1 + integer(2), parameter :: i2 = 2 + real(4), parameter :: r4 = 4 + real(8), parameter :: r8 = 8 + if (kind (min (i1, i2)) /= kind (i2)) stop 1 + if (kind (min (i2, i1)) /= kind (i2)) stop 2 + if (kind (min (r4, r8)) /= kind (r8)) stop 3 + if (kind (min (r8, r4)) /= kind (r8)) stop 4 +end program p diff --git a/gcc/testsuite/gfortran.dg/minmax_char_3.f90 b/gcc/testsuite/gfortran.dg/minmax_char_3.f90 new file mode 100644 index 00000000000..291ba1fd1e9 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/minmax_char_3.f90 @@ -0,0 +1,10 @@ +! { dg-do compile } +! PR96686: MIN/MAX should reject character arguments of different kind + +program p + implicit none + character(kind=1) :: c1 = "1" + character(kind=4) :: c4 = 4_"4" + print *, min (c1, c4) ! { dg-error "Different character kinds" } + print *, min (c4, c1) ! { dg-error "Different character kinds" } +end program p diff --git a/gcc/testsuite/gfortran.dg/pr96613.f90 b/gcc/testsuite/gfortran.dg/pr96613.f90 new file mode 100644 index 00000000000..2043c25fe1c --- /dev/null +++ b/gcc/testsuite/gfortran.dg/pr96613.f90 @@ -0,0 +1,15 @@ +! { dg-do run } +! { dg-options "-O2 -std=gnu" } +! PR fortran/96613 - Fix type/kind of temporaries evaluating MIN/MAX + +program test + implicit none + real :: x = 7.7643945e+09 + real :: y = 6000. + integer :: ix + + ix = min1 (5000.0, x) + if (ix /= 5000) stop 1 + ix = min1 (y, x, 5555.d0) + if (ix /= 5555) stop 2 +end program