From patchwork Mon May 1 16:29:59 2023 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 7bit X-Patchwork-Submitter: Harald Anlauf X-Patchwork-Id: 89081 Return-Path: Delivered-To: ouuuleilei@gmail.com Received: by 2002:a59:b0ea:0:b0:3b6:4342:cba0 with SMTP id b10csp41873vqo; Mon, 1 May 2023 09:30:55 -0700 (PDT) X-Google-Smtp-Source: ACHHUZ750XP67KxSJzUzZmpdO0uJsRuN/f2vExpUd/RFs8Z5FsZbTcCNfIFcNeqUSI4WeNljrqfb X-Received: by 2002:aa7:ccd1:0:b0:508:3b23:d84c with SMTP id y17-20020aa7ccd1000000b005083b23d84cmr6747873edt.1.1682958655403; Mon, 01 May 2023 09:30:55 -0700 (PDT) ARC-Seal: i=1; a=rsa-sha256; t=1682958655; cv=none; d=google.com; s=arc-20160816; b=AFymA5ae1RKu1pxOuIr9yNaYqWuMaHK1Ts9Icl9CQwa/hDCqjHipdIyNb2Vd9R7CZ7 CCz65kPfMMInfhHrQq5g8uVBfquo2tKzkbTh9uG51AqE4jaMtBuyngl2LlPIFHJSI8JR b0EHA3V2e2zUTP3XxNgZh9eZ+PwjWxhMb+2Y2TS4j1LrHrYWT39rtGY8JBeH8uzJrmow 8316yj7+N0CI9W2TjLbSJfwSsgUzhjQkPa8nWfo4C2CVDZSAXVRKOvXOKHeVFF5e0SE+ 9HLof48VsT4hBDfuocBEyOmf1gB9mNfS4vISYvr55OLDSYnXPSXiqyIlw/OtlZ/Qmfa5 4h7A== ARC-Message-Signature: i=1; a=rsa-sha256; c=relaxed/relaxed; d=google.com; s=arc-20160816; h=sender:errors-to:reply-to:from:list-subscribe:list-help:list-post :list-archive:list-unsubscribe:list-id:precedence:ui-outboundreport :sensitivity:importance:date:subject:to:message-id:mime-version :dmarc-filter:delivered-to:dkim-signature:dkim-filter; bh=s+/LypB8Z/2v/82NClD42KB/X91dn2mLgbkdOzsBWrc=; b=xuZkFBjmyGEHUJ90n/boBeEDSeBQmOtzGNa4QV5S6v3M8lwFv7fcO1rElrneLTG16i VQN4lHjSy95iyGSkhtFxYiZVl4By12UcNJTZa7Cag+w1EOvDIIdvB2O7f4zb7bWXUEUF 138eEuNPsGCbYNkZmb8w/uKoBACNb/tNeJFeD++RVLnuyGe2PfPL/7lzC5CBVS1MMTok QMnYtH75oGgFM52Zo5yWjnHDj9Gtgg6w5v+bmiBtoFwFTVX1PvPE0UzZ/rZXOkGxak/5 kIti35G5B0f5C4kIzodcbP1NQfPX6Vpu2lZK05tOVnXHN5dSYESaJMNuytW0n+rx3FaB LOxQ== ARC-Authentication-Results: i=1; mx.google.com; dkim=pass header.i=@gcc.gnu.org header.s=default header.b=pOHpjP6o; spf=pass (google.com: domain of gcc-patches-bounces+ouuuleilei=gmail.com@gcc.gnu.org designates 8.43.85.97 as permitted sender) smtp.mailfrom="gcc-patches-bounces+ouuuleilei=gmail.com@gcc.gnu.org"; dmarc=pass (p=NONE sp=NONE dis=NONE) header.from=gnu.org Received: from sourceware.org (server2.sourceware.org. [8.43.85.97]) by mx.google.com with ESMTPS id k9-20020aa7c049000000b0050bc02518e8si3267369edo.147.2023.05.01.09.30.55 for (version=TLS1_3 cipher=TLS_AES_256_GCM_SHA384 bits=256/256); Mon, 01 May 2023 09:30:55 -0700 (PDT) Received-SPF: pass (google.com: domain of gcc-patches-bounces+ouuuleilei=gmail.com@gcc.gnu.org designates 8.43.85.97 as permitted sender) client-ip=8.43.85.97; Authentication-Results: mx.google.com; dkim=pass header.i=@gcc.gnu.org header.s=default header.b=pOHpjP6o; spf=pass (google.com: domain of gcc-patches-bounces+ouuuleilei=gmail.com@gcc.gnu.org designates 8.43.85.97 as permitted sender) smtp.mailfrom="gcc-patches-bounces+ouuuleilei=gmail.com@gcc.gnu.org"; dmarc=pass (p=NONE sp=NONE dis=NONE) header.from=gnu.org Received: from server2.sourceware.org (localhost [IPv6:::1]) by sourceware.org (Postfix) with ESMTP id 90B2D3858005 for ; Mon, 1 May 2023 16:30:52 +0000 (GMT) DKIM-Filter: OpenDKIM Filter v2.11.0 sourceware.org 90B2D3858005 DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=gcc.gnu.org; s=default; t=1682958652; bh=s+/LypB8Z/2v/82NClD42KB/X91dn2mLgbkdOzsBWrc=; h=To:Subject:Date:List-Id:List-Unsubscribe:List-Archive:List-Post: List-Help:List-Subscribe:From:Reply-To:From; b=pOHpjP6obWppEPiUeGhfd7SVqFYZy6nQ6EiXhfKZ/GCEU20oUU+C4FLRaI53MozfD 8vT7JzANfgPavbgapPjWCEDnYrZO86A3TgRrRTn43tS4rgmwD3L+da4/Ub6SXRCfYP Yvwp5cV2JpCxqIe5qJwsiBGFAu1M69HYfcb/8KIQ= 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.17.22]) by sourceware.org (Postfix) with ESMTPS id 30FB63858D28; Mon, 1 May 2023 16:30:01 +0000 (GMT) DMARC-Filter: OpenDMARC Filter v1.4.2 sourceware.org 30FB63858D28 X-UI-Sender-Class: 724b4f7f-cbec-4199-ad4e-598c01a50d3a Received: from [79.251.12.51] ([79.251.12.51]) by web-mail.gmx.net (3c-app-gmx-bap68.server.lan [172.19.172.68]) (via HTTP); Mon, 1 May 2023 18:29:59 +0200 MIME-Version: 1.0 Message-ID: To: fortran , gcc-patches Subject: [PATCH] Fortran: overloading of intrinsic binary operators [PR109641] Date: Mon, 1 May 2023 18:29:59 +0200 Importance: normal Sensitivity: Normal X-Priority: 3 X-Provags-ID: V03:K1:3oPsN5iIgHfy1H/kzfinLyyhUlSHQsCJ1MBm9L+yoZtU3XU/bnyy5HvWT1SxoNFSLCuef 8g2zlrkQg8saCGwzGgIcGe08JFuG+v2GmicLsj9LnB55oi4QObtFsxqN/jjlsCxyhBjAxPBL7ZZ3 pi14zYv56Gn1h7tqzm8Ea75ggiPXA2I0V8/CKLSWOQJuzdp5UbHys2HsYumg3Rzzgv1NcDYWAg9l 99yhtI6x8QCHEUIC6qmoqzI12aza6pe9HmjdZTT4ZlUIy7o1vNTq3Ngn4DYb5QnA6ZIaJp/t7+GB tM= UI-OutboundReport: notjunk:1;M01:P0:liIyM5aXMXo=;eXEB2TiE2GXWWjVZn4Cgls2erXO X36/yGiixUGU6FRQCqt0eVK66Bbc2XxATE2gb0OKdGFVmwnPspFjesWliO66rKrZ66nvgGNkN eso2MLnqlq+gpp7+PcOS3QwR3ZFsbbrvxXBqsJSDmbasBsEetpgQs1Njx9dB9mEc2HxbClVCA aywNsXGMdhVEG/2zTeIVtqdHutX8cxRSClYC4S/Vfzj/ZjjPzCdthGissPItwMVHmV2bsobuR kjMGwxA3vssl/Cpw2MRNBLexHt5dAe/slZb0T803TxIdVpu63Slz7ooD38tJcQGfkOQWhEead 1wzf+wVoYVhLtYhAkncWRnmcRLfv2YgyM9G9aVkHfHt6PCnXZleWvfwh0SHXyF7uasn9Q+pnn D3xZ6J6ud66H03k/LUWHJuWET8FkpRCcelyFO/XAjecabtnZEfgD2mcCiOsBq14ye9Z/yiy+c ZmzWblK6bMEqDbMsfZDVU27Yj7utfuqxikg/yeg4ujDzSFxsrYox+kFhtFznTLCS1vZfmjIps 63hwyDap42ZdldxBZk6ZWu2MGkPZjEkRmSHmprKR/CPJt5ZVu8b/trn/2mzcPwEr5bLdEfXko 7zOxwepDfzLi+3NKlyIGXDylkMD8O6uC21H/SUlspDwupLBCJ0XYUjLR0iAJj/fG9Cd94Ei5N jJHwyuaGPJSbbwgX9WGj2a15WKvVYQC0Y+rZLKE0nafd5chM4ftEX49jujPaWZRaMdYgwSckZ wmbh3wFL/VPFwNB880DYT0nqpN2Vf+CRJJtm3L+0xTYrq29pjzmKhEDq3Iw2NRkbueiknzG6r JXpCn4CcSq3PfbXrRc9PuNxI5aqkPnfKfV4Eo9nnWZKhU= X-Spam-Status: No, score=-12.9 required=5.0 tests=BAYES_00, DKIM_SIGNED, DKIM_VALID, DKIM_VALID_AU, DKIM_VALID_EF, FREEMAIL_FROM, GIT_PATCH_0, RCVD_IN_DNSWL_LOW, RCVD_IN_MSPIKE_H2, SPF_HELO_NONE, SPF_PASS, TXREP, T_SCC_BODY_TEXT_LINE autolearn=ham autolearn_force=no version=3.4.6 X-Spam-Checker-Version: SpamAssassin 3.4.6 (2021-04-09) 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: , X-Patchwork-Original-From: Harald Anlauf via Gcc-patches From: Harald Anlauf Reply-To: Harald Anlauf Errors-To: gcc-patches-bounces+ouuuleilei=gmail.com@gcc.gnu.org Sender: "Gcc-patches" X-getmail-retrieved-from-mailbox: =?utf-8?q?INBOX?= X-GMAIL-THRID: =?utf-8?q?1764710054691516356?= X-GMAIL-MSGID: =?utf-8?q?1764710054691516356?= Dear all, the attached patch is mostly self-explaining: we mishandled the overloading of intrinsic binary operators in the case the actual operands were of intrinsic numeric type and the ranks of the operands were not conformable, i.e. both were of non-zero and different ranks. In that case the operators could be converted to the same type before the correct user-defined operator was resolved, leading to either rejects-valid or accepts-invalid or wrong resolution (= wrong code). Regtested on x86_64-pc-linux-gnu. OK for mainline? The patch is actually very limited in impact, but the bug is sort of annoying. Would it be OK to backport to 13.2 after some waiting? Thanks, Harald From 50c8d3d4adeed1e6666cf44216075d1fb53a3ef0 Mon Sep 17 00:00:00 2001 From: Harald Anlauf Date: Mon, 1 May 2023 18:01:25 +0200 Subject: [PATCH] Fortran: overloading of intrinsic binary operators [PR109641] Fortran allows overloading of intrinsic operators also for operands of numeric intrinsic types. The intrinsic operator versions are used according to the rules of F2018 table 10.2 and imply type conversion as long as the operand ranks are conformable. Otherwise no type conversion shall be performed to allow the resolution of a matching user-defined operator. gcc/fortran/ChangeLog: PR fortran/109641 * arith.cc (eval_intrinsic): Check conformability of ranks of operands for intrinsic binary operators before performing type conversions. * gfortran.h (gfc_op_rank_conformable): Add prototype. * resolve.cc (resolve_operator): Check conformability of ranks of operands for intrinsic binary operators before performing type conversions. (gfc_op_rank_conformable): New helper function to compare ranks of operands of binary operator. gcc/testsuite/ChangeLog: PR fortran/109641 * gfortran.dg/overload_5.f90: New test. --- gcc/fortran/arith.cc | 6 ++ gcc/fortran/gfortran.h | 1 + gcc/fortran/resolve.cc | 39 ++++++++ gcc/testsuite/gfortran.dg/overload_5.f90 | 118 +++++++++++++++++++++++ 4 files changed, 164 insertions(+) create mode 100644 gcc/testsuite/gfortran.dg/overload_5.f90 diff --git a/gcc/fortran/arith.cc b/gcc/fortran/arith.cc index d1d814b3ae1..86d56406047 100644 --- a/gcc/fortran/arith.cc +++ b/gcc/fortran/arith.cc @@ -1663,6 +1663,12 @@ eval_intrinsic (gfc_intrinsic_op op, if (!gfc_numeric_ts (&op1->ts) || !gfc_numeric_ts (&op2->ts)) goto runtime; + /* Do not perform conversions if operands are not conformable as + required for the binary intrinsic operators (F2018:10.1.5). + Defer to a possibly overloading user-defined operator. */ + if (!gfc_op_rank_conformable (op1, op2)) + goto runtime; + /* Insert any necessary type conversions to make the operands compatible. */ diff --git a/gcc/fortran/gfortran.h b/gcc/fortran/gfortran.h index a15ff90e228..ac21e1813d9 100644 --- a/gcc/fortran/gfortran.h +++ b/gcc/fortran/gfortran.h @@ -3730,6 +3730,7 @@ void gfc_free_association_list (gfc_association_list *); /* resolve.cc */ void gfc_expression_rank (gfc_expr *); +bool gfc_op_rank_conformable (gfc_expr *, gfc_expr *); bool gfc_resolve_ref (gfc_expr *); bool gfc_resolve_expr (gfc_expr *); void gfc_resolve (gfc_namespace *); diff --git a/gcc/fortran/resolve.cc b/gcc/fortran/resolve.cc index c3d508fb45d..341909d7de7 100644 --- a/gcc/fortran/resolve.cc +++ b/gcc/fortran/resolve.cc @@ -4200,6 +4200,17 @@ resolve_operator (gfc_expr *e) case INTRINSIC_POWER: if (gfc_numeric_ts (&op1->ts) && gfc_numeric_ts (&op2->ts)) { + /* Do not perform conversions if operands are not conformable as + required for the binary intrinsic operators (F2018:10.1.5). + Defer to a possibly overloading user-defined operator. */ + if (!gfc_op_rank_conformable (op1, op2)) + { + dual_locus_error = true; + snprintf (msg, sizeof (msg), + _("Inconsistent ranks for operator at %%L and %%L")); + goto bad_op; + } + gfc_type_convert_binary (e, 1); break; } @@ -4372,6 +4383,17 @@ resolve_operator (gfc_expr *e) if (gfc_numeric_ts (&op1->ts) && gfc_numeric_ts (&op2->ts)) { + /* Do not perform conversions if operands are not conformable as + required for the binary intrinsic operators (F2018:10.1.5). + Defer to a possibly overloading user-defined operator. */ + if (!gfc_op_rank_conformable (op1, op2)) + { + dual_locus_error = true; + snprintf (msg, sizeof (msg), + _("Inconsistent ranks for operator at %%L and %%L")); + goto bad_op; + } + gfc_type_convert_binary (e, 1); e->ts.type = BT_LOGICAL; @@ -5644,6 +5666,23 @@ done: } +/* Given two expressions, check that their rank is conformable, i.e. either + both have the same rank or at least one is a scalar. */ + +bool +gfc_op_rank_conformable (gfc_expr *op1, gfc_expr *op2) +{ +// if (op1->expr_type == EXPR_VARIABLE && op1->ref) + if (op1->expr_type == EXPR_VARIABLE) + gfc_expression_rank (op1); +// if (op2->expr_type == EXPR_VARIABLE && op2->ref) + if (op2->expr_type == EXPR_VARIABLE) + gfc_expression_rank (op2); + + return (op1->rank == 0 || op2->rank == 0 || op1->rank == op2->rank); +} + + static void add_caf_get_intrinsic (gfc_expr *e) { diff --git a/gcc/testsuite/gfortran.dg/overload_5.f90 b/gcc/testsuite/gfortran.dg/overload_5.f90 new file mode 100644 index 00000000000..f8c93af3518 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/overload_5.f90 @@ -0,0 +1,118 @@ +! { dg-do run } +! PR fortran/109641 +! +! Check overloading of intrinsic binary operators for numeric operands +! Reported by Adelson Oliveira + +MODULE TESTEOP + IMPLICIT NONE + INTERFACE OPERATOR(.MULT.) + MODULE PROCEDURE MULTr4 + MODULE PROCEDURE MULTc4 + END INTERFACE + INTERFACE OPERATOR(*) + MODULE PROCEDURE MULTr4 + MODULE PROCEDURE MULTc4 + END INTERFACE + INTERFACE OPERATOR(==) + MODULE PROCEDURE MULTr4 + MODULE PROCEDURE MULTc4 + MODULE PROCEDURE MULTr8 + END INTERFACE + INTERFACE OPERATOR(<) + MODULE PROCEDURE MULTc4 + MODULE PROCEDURE MULTi4 + END INTERFACE + INTERFACE OPERATOR(**) + MODULE PROCEDURE MULTc4 + MODULE PROCEDURE MULTi4 + END INTERFACE + interface copy + MODULE PROCEDURE copy + end interface copy +CONTAINS + elemental function copy (z) + complex, intent(in) :: z + complex :: copy + copy = z + end function copy + FUNCTION MULTr4(v,m) + REAL, INTENT(IN) :: v(:) + REAL, INTENT(IN) :: m(:,:) + REAL :: MULTr4(SIZE(m,DIM=1),SIZE(m,DIM=2)) + INTEGER :: i + FORALL(i=1:SIZE(v)) MULTr4(:,i)=m(:,i)*v(i) + END FUNCTION MULTr4 + FUNCTION MULTr8(v,m) + REAL, INTENT(IN) :: v(:) + double precision, INTENT(IN) :: m(:,:) + double precision :: MULTr8(SIZE(m,DIM=1),SIZE(m,DIM=2)) + INTEGER :: i + FORALL(i=1:SIZE(v)) MULTr8(:,i)=m(:,i)*v(i) + END FUNCTION MULTr8 + FUNCTION MULTc4(v,m) + REAL, INTENT(IN) :: v(:) + COMPLEX, INTENT(IN) :: m(:,:) + COMPLEX :: MULTc4(SIZE(m,DIM=1),SIZE(m,DIM=2)) + INTEGER :: i + FORALL(i=1:SIZE(v)) MULTc4(:,i)=m(:,i)*v(i) + END FUNCTION MULTc4 + FUNCTION MULTi4(v,m) + REAL, INTENT(IN) :: v(:) + integer, INTENT(IN) :: m(:,:) + REAL :: MULTi4(SIZE(m,DIM=1),SIZE(m,DIM=2)) + INTEGER :: i + FORALL(i=1:SIZE(v)) MULTi4(:,i)=m(:,i)*v(i) + END FUNCTION MULTi4 +END MODULE TESTEOP +PROGRAM TESTE + USE TESTEOP + implicit none + type t + complex :: c(3,3) + end type t + real, parameter :: vv(3) = 42. + complex, parameter :: zz(3,3) = (1.0,0.0) + integer, parameter :: kk(3,3) = 2 + double precision :: dd(3,3) = 3.d0 + COMPLEX, ALLOCATABLE :: m(:,:),r(:,:), s(:,:) + REAL, ALLOCATABLE :: v(:) + type(t) :: z(1) = t(zz) + ALLOCATE(v(3),m(3,3),r(3,3),s(3,3)) + v = vv + m = zz + ! Original bug report + r=v.MULT.m ! Reference + s=v*m + if (any (r /= s)) stop 1 + if (.not. all (r == s)) stop 2 + ! Check other binary intrinsics + s=v==m + if (any (r /= s)) stop 3 + s=v==copy(m) + if (any (r /= s)) stop 4 + s=v==zz + if (any (r /= s)) stop 5 + s=v==copy(zz) + if (any (r /= s)) stop 6 + s=vv==m + if (any (r /= s)) stop 7 + s=vv==copy(m) + if (any (r /= s)) stop 8 + s=vv==zz + if (any (r /= s)) stop 9 + s=vv==copy(zz) + if (any (r /= s)) stop 10 + ! check if .eq. same operator as == etc. + s=v.eq.m + if (any (r /= s)) stop 11 + s=v.lt.z(1)%c + if (any (r /= s)) stop 12 + s=v<((z(1)%c)) + if (any (r /= s)) stop 13 + if (.not. all ( 1. < (vv**kk))) stop 14 + if (.not. all ( 1. < (vv< kk))) stop 15 + if (.not. all ((42.,0.) == (v < m ))) stop 16 + if (.not. all ((42.,0.) == (v** m ))) stop 17 + if (.not. all ( 126.d0 == (vv==dd))) stop 18 +END PROGRAM TESTE -- 2.35.3