From patchwork Fri Oct 8 21:33:36 2021 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 7bit X-Patchwork-Submitter: Harald Anlauf X-Patchwork-Id: 46016 Return-Path: X-Original-To: patchwork@sourceware.org Delivered-To: patchwork@sourceware.org Received: from server2.sourceware.org (localhost [IPv6:::1]) by sourceware.org (Postfix) with ESMTP id AEC693857C44 for ; Fri, 8 Oct 2021 21:34:26 +0000 (GMT) DKIM-Filter: OpenDKIM Filter v2.11.0 sourceware.org AEC693857C44 DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=gcc.gnu.org; s=default; t=1633728866; bh=Ka3/zkiZHdgjE2TgzaSIIc+A+/pgdSDf4ICXjQrWabY=; h=To:Subject:Date:List-Id:List-Unsubscribe:List-Archive:List-Post: List-Help:List-Subscribe:From:Reply-To:From; b=lkSKFFOEPjjQ4STt+8q1pAgGlRDKgz9On7OfNCKXpRqANCjLVFHzZeGoNTKX7fABa 28uaZyp4HvTr+PQMU/Fn5T5VgEDk4QFAvzDOpr7fWxzZDhZidoxThJp96yWyPcdYLl ZsdsGpTnLLbcYGAUp9kaQQ2OiheoYUNo95c9LbiY= 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 48E273858400; Fri, 8 Oct 2021 21:33:38 +0000 (GMT) DMARC-Filter: OpenDMARC Filter v1.4.1 sourceware.org 48E273858400 X-UI-Sender-Class: 01bb95c1-4bf8-414a-932a-4f6e2808ef9c Received: from [93.207.82.215] ([93.207.82.215]) by web-mail.gmx.net (3c-app-gmx-bap16.server.lan [172.19.172.86]) (via HTTP); Fri, 8 Oct 2021 23:33:36 +0200 MIME-Version: 1.0 Message-ID: To: fortran , gcc-patches Subject: [PATCH] PR fortran/65454 - accept both old and new-style relational operators Date: Fri, 8 Oct 2021 23:33:36 +0200 Importance: normal Sensitivity: Normal X-Priority: 3 X-Provags-ID: V03:K1:s2bQzbF2NehtM3sylXFVkHvcV7LS5vfevbieil+udyuFsokspHny2cEHwrZd+lsvTcN7G CveQxRheN9j3lNpJ/NN6UZjWQqlLp52WnqMr6VlB3h5shbx5xdlfgVegwai+lERs5J6nsvCNGDj9 FjQDvuRfLgygDtGJMHRtqHwNKbdIk3/j90WzOGGo66crsLdvQK2aJPgVzD5Fgjid2nJNjnWyElCE RxJ87MnAXISSTuewtLSartDm30IZ2pN6Fx0/8g3n+sHcKatWrpP5f7A47esW27CEgL2880RbItrH ew= X-UI-Out-Filterresults: notjunk:1;V03:K0:J/MN9kjkSiI=:jBE8MaH4yp69eXS2yaDjez uyrQe+RpdZc7YEXmq/XMdLSat1HZl6DZQOGdxLaJHUzgi6RuEmKcf47Zi1c3ZtYu/OBxYYm22 VVv7yuh7V7Q9hpEeV4tVY1PQxHXjdvuQQm2qH/7/u55horvPMO9VjcYGTx2jnXAirQojFv70x aJZAfJoClRwIC4ZSLYvUiGaIinfLRyrJlentUZKOQvMlO/6s6t4tv8gRC0EmzjDkauBa39gQ0 GxavCM2Z913VPHoiLFqSG/nCmPuHgrKHgeO7M+1UMP3y77iHRu0T3gRTTiZXbaVMStfAPCbXh Ma+bTA93jO1ha7wyyU0ZLvZ1TleVHhHknRZQZhPCLXgiTKR4DP9SBZPeZwHCteLKM5l7LkIL5 +pu3odUQtU+mkWgks49pztZClJIzCGy8Op+CGsw//CbM+pNJyCOmVUehWvvo0FhDZO8L8lyhn YPdmBGIDdoXzJenodc30txL0Rqhivl5KVkKtufHQCpR66iyIO02QLHYufRbPCZzPH+kQl+aj/ cHqbnuSqeiyD6zi3TsQop6sIDblhYoR1WE8uMc4x8douiZtz832WgfpkwlResWmCqPNHsaOQU 01B/4APz7TBBLG3WZxOrMsOCanftyqy1A0porpsJXAb7z9jcyAS+49nJ3ft6ew9zH0eNkrLj+ sTPrzRntAGp0kv1LJaHILfNKYBzWW2kZrMFd2R9G6+oCMq/nUw1Fzx98coJ9r6UYOO86cAksy ncyFy+qoWboKPz6UgfsJKRBYPJSz03zEXMVtqySiHhUq73Q4OMV3H77mXaX449TznBehMfXhF geNOVKk X-Spam-Status: No, score=-11.9 required=5.0 tests=BAYES_00, DKIM_SIGNED, DKIM_VALID, FREEMAIL_FROM, GIT_PATCH_0, RCVD_IN_MSPIKE_H2, SPF_HELO_NONE, SPF_PASS, TXREP autolearn=ham autolearn_force=no version=3.4.4 X-Spam-Checker-Version: SpamAssassin 3.4.4 (2020-01-24) 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+patchwork=sourceware.org@gcc.gnu.org Sender: "Gcc-patches" Dear Fortranners, F2018:10.1.5.5.1(2) requires the same interpretation of old and new-style relational operators. We internally distinguish between old and new style, but try to map appropriately when used. This mapping was missing when reading a module via USE module, ONLY: OPERATOR(op) where op used a style different from the INTERFACE OPERATOR statement in the declaring module. The attached patch remedies this. Note: we do neither change the module format nor actually remap an operator. We simply improve the check whether the requested operator symbol exists in the old-style or new-style version. Regtested on x86_64-pc-linux-gnu. OK for mainline? Thanks, Harald Fortran: accept both old and new-style relational operators in USE, ONLY F2018:10.1.5.5.1(2) requires the same interpretation of old and new-style relational operators. As gfortran internally distinguishes between these versions, we must match equivalent notations in USE module, ONLY: OPERATOR(op) statements when reading modules. gcc/fortran/ChangeLog: PR fortran/65454 * module.c (read_module): Handle old and new-style relational operators when used in USE module, ONLY: OPERATOR(op). gcc/testsuite/ChangeLog: PR fortran/65454 * gfortran.dg/interface_operator_3.f90: New test. diff --git a/gcc/fortran/module.c b/gcc/fortran/module.c index 1804066bc8c..7b98ba539d6 100644 --- a/gcc/fortran/module.c +++ b/gcc/fortran/module.c @@ -5592,6 +5592,9 @@ read_module (void) for (i = GFC_INTRINSIC_BEGIN; i != GFC_INTRINSIC_END; i++) { + gfc_use_rename *u = NULL, *v = NULL; + int j = i; + if (i == INTRINSIC_USER) continue; @@ -5599,18 +5602,73 @@ read_module (void) { u = find_use_operator ((gfc_intrinsic_op) i); - if (u == NULL) + /* F2018:10.1.5.5.1 requires same interpretation of old and new-style + relational operators. Special handling for USE, ONLY. */ + switch (i) + { + case INTRINSIC_EQ: + j = INTRINSIC_EQ_OS; + break; + case INTRINSIC_EQ_OS: + j = INTRINSIC_EQ; + break; + case INTRINSIC_NE: + j = INTRINSIC_NE_OS; + break; + case INTRINSIC_NE_OS: + j = INTRINSIC_NE; + break; + case INTRINSIC_GT: + j = INTRINSIC_GT_OS; + break; + case INTRINSIC_GT_OS: + j = INTRINSIC_GT; + break; + case INTRINSIC_GE: + j = INTRINSIC_GE_OS; + break; + case INTRINSIC_GE_OS: + j = INTRINSIC_GE; + break; + case INTRINSIC_LT: + j = INTRINSIC_LT_OS; + break; + case INTRINSIC_LT_OS: + j = INTRINSIC_LT; + break; + case INTRINSIC_LE: + j = INTRINSIC_LE_OS; + break; + case INTRINSIC_LE_OS: + j = INTRINSIC_LE; + break; + default: + break; + } + + if (j != i) + v = find_use_operator ((gfc_intrinsic_op) j); + + if (u == NULL && v == NULL) { skip_list (); continue; } - u->found = 1; + if (u) + u->found = 1; + if (v) + v->found = 1; } mio_interface (&gfc_current_ns->op[i]); - if (u && !gfc_current_ns->op[i]) - u->found = 0; + if (!gfc_current_ns->op[i] && !gfc_current_ns->op[j]) + { + if (u) + u->found = 0; + if (v) + v->found = 0; + } } mio_rparen (); diff --git a/gcc/testsuite/gfortran.dg/interface_operator_3.f90 b/gcc/testsuite/gfortran.dg/interface_operator_3.f90 new file mode 100644 index 00000000000..6a580b2f1cf --- /dev/null +++ b/gcc/testsuite/gfortran.dg/interface_operator_3.f90 @@ -0,0 +1,141 @@ +! { dg-do compile } +! PR fortran/65454 - accept both old and new-style relational operators + +module m + implicit none + private :: t1 + type t1 + integer :: i + end type t1 + interface operator (==) + module procedure :: my_cmp + end interface + interface operator (/=) + module procedure :: my_cmp + end interface + interface operator (<=) + module procedure :: my_cmp + end interface + interface operator (<) + module procedure :: my_cmp + end interface + interface operator (>=) + module procedure :: my_cmp + end interface + interface operator (>) + module procedure :: my_cmp + end interface +contains + elemental function my_cmp (a, b) result (c) + type(t1), intent(in) :: a, b + logical :: c + c = a%i == b%i + end function my_cmp +end module m + +module m_os + implicit none + private :: t2 + type t2 + integer :: i + end type t2 + interface operator (.eq.) + module procedure :: my_cmp + end interface + interface operator (.ne.) + module procedure :: my_cmp + end interface + interface operator (.le.) + module procedure :: my_cmp + end interface + interface operator (.lt.) + module procedure :: my_cmp + end interface + interface operator (.ge.) + module procedure :: my_cmp + end interface + interface operator (.gt.) + module procedure :: my_cmp + end interface +contains + elemental function my_cmp (a, b) result (c) + type(t2), intent(in) :: a, b + logical :: c + c = a%i .eq. b%i + end function my_cmp +end module m_os + +! new style only +module m1 + use m, only: operator(==), operator(/=) + use m, only: operator(<=), operator(<) + use m, only: operator(>=), operator(>) +end module m1 + +! old -> new style +module m2 + use m_os, only: operator(==), operator(/=) + use m_os, only: operator(<=), operator(<) + use m_os, only: operator(>=), operator(>) +end module m2 + +! new -> old style +module m3 + use m, only: operator(.eq.), operator(.ne.) + use m, only: operator(.le.), operator(.lt.) + use m, only: operator(.ge.), operator(.gt.) +end module m3 + +! old style only +module m4 + use m_os, only: operator(.eq.), operator(.ne.) + use m_os, only: operator(.le.), operator(.lt.) + use m_os, only: operator(.ge.), operator(.gt.) +end module m4 + +! new -> all styles +module m5 + use m, only: operator(.eq.), operator(.ne.), operator(==), operator(/=) + use m, only: operator(.le.), operator(.lt.), operator(<=), operator(<) + use m, only: operator(.ge.), operator(.gt.), operator(>=), operator(>) +end module m5 + +! old -> all styles +module m6 + use m_os, only: operator(.eq.), operator(.ne.), operator(==), operator(/=) + use m_os, only: operator(.le.), operator(.lt.), operator(<=), operator(<) + use m_os, only: operator(.ge.), operator(.gt.), operator(>=), operator(>) +end module m6 + +! all -> all styles +module m7 + use m, only: operator(.eq.), operator(.ne.), operator(==), operator(/=) + use m, only: operator(.le.), operator(.lt.), operator(<=), operator(<) + use m, only: operator(.ge.), operator(.gt.), operator(>=), operator(>) + use m_os, only: operator(.eq.), operator(.ne.), operator(==), operator(/=) + use m_os, only: operator(.le.), operator(.lt.), operator(<=), operator(<) + use m_os, only: operator(.ge.), operator(.gt.), operator(>=), operator(>) +end module m7 + +module m_eq + implicit none + private :: t3 + type t3 + integer :: i + end type t3 + interface operator (==) + module procedure :: my_cmp + end interface +contains + elemental function my_cmp (a, b) result (c) + type(t3), intent(in) :: a, b + logical :: c + c = a%i == b%i + end function my_cmp +end module m_eq + +module m8 + use m_eq, only: operator(==), operator(.eq.) + use m_eq, only: operator(/=) ! { dg-error "operator ./=. referenced" } + use m_eq, only: operator(.ne.) ! { dg-error "operator .\.ne\.. referenced" } +end module m8