From mboxrd@z Thu Jan 1 00:00:00 1970 Return-Path: Received: from mout.gmx.net (mout.gmx.net [212.227.17.21]) by sourceware.org (Postfix) with ESMTPS id CE90E3858D3C; Sun, 16 Oct 2022 18:46:40 +0000 (GMT) DMARC-Filter: OpenDMARC Filter v1.4.1 sourceware.org CE90E3858D3C Authentication-Results: sourceware.org; dmarc=pass (p=none dis=none) header.from=gmx.de Authentication-Results: sourceware.org; spf=pass smtp.mailfrom=gmx.de DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/simple; d=gmx.net; s=badeba3b8450; t=1665945999; bh=pgi+c4Z3O6kB+d+FksD7OtYrdak//BDhcDqVtmV84Qg=; h=X-UI-Sender-Class:From:To:Subject:Date; b=XLXPw/C1ILMDoJWerrrQrheXVXLugY7tZ79dPMN2kDb+9f1uPeNH/EPGZ3y2s6uaz yz918o0sockhR7OKTioYjiugbFRkv6VedyRbSHtl+5Jcpp/9av07Isw5omRARca806 VEBtJok2nvdo8pIVDXYFYjR26DVONNISWy7ub0Bw= X-UI-Sender-Class: 01bb95c1-4bf8-414a-932a-4f6e2808ef9c Received: from [79.251.10.58] ([79.251.10.58]) by web-mail.gmx.net (3c-app-gmx-bap23.server.lan [172.19.172.93]) (via HTTP); Sun, 16 Oct 2022 20:46:38 +0200 MIME-Version: 1.0 Message-ID: From: Harald Anlauf To: fortran , gcc-patches Subject: [PATCH] Fortran: check type of operands of logical operations, comparisons [PR107272] Content-Type: multipart/mixed; boundary=trekuen-3e7f7200-4389-4591-b9b0-6096bfed38f3 Date: Sun, 16 Oct 2022 20:46:38 +0200 Importance: normal Sensitivity: Normal X-Priority: 3 X-Provags-ID: V03:K1:PRxa6lf4Y18zuL+j+Kzm+eIv5Wvw6U/1iULb2X5zSnWmCpcLDfO+vcIoIsm/Ne5tNaAuc NV/RvdnkpIUVduWVRK8MKleZZeNxS9VZfA4l2QzuIz+9uKpm67RgXKNHPMyLCf+CR8bYLRmIYv8D 0ZNxL5+54cx3b8JeUaT1jU7RuVUC8lV+wS9aOeCtr87hNpMzh2GG7MoWRebmOS3cTIz1Pwe+PnXu GaFyMvvGVSxUpRNMEL84J4kUHioZ3F+Hs4EhQOpx6r1IJZTAr+pDYyo7+7rpyuI/FC+eEJ+JpOt3 p4= X-UI-Out-Filterresults: notjunk:1;V03:K0:YldWkp4gDgc=:I84PX2j+E2yjhrCkaoMI2S 6sxsLUHyzNBNDbo3iq7NDmWcAksIk3DCHRmmkYG6l7c7bvedpvDNqWc0JZI6865svfpHfcDb1 mxKUHQCv/TcDOGWDUjGOscqNHwkvME16lEKk6NC6LPPiCciGFnOFX/+Mw+i23puYodAF4D+P5 rHqtSZkW9vFiLHsER/F7jgWLqVH3tQ6UrPym6WTTROzGApJvEk5batrwnL7ZZulqHESAMGRR1 /JgOb3XEIZORk31PzBGqkRuwEkih5y1HCnbQ39K5CBaj0RlQzhOlEn4XGW5np2/xPWMZnT/92 7/eJ+6RAXHsjaOp4xhPMvKs9wF6kEjajxGqq8J10n+RbKm2M0dKjUbmEiX7HfL5cYFFvI08lD QA6GKN1w6fd7SdGn0qBsJfRh+/TUr0iXkszGJWBjspaAcXLM21gwwQn51o4l+/V7+FZMjJGOo VPDDklTevyA6h+RMy9CxWiKWpYzmu13mXLw8Z+M1vwGfgT0zzbYxTb+agdvfezI5AIUPB5njt OpgPEUZVlWMpC5tN/kqxjN+6SubhVjVaZ4WruwL5bfnJ94a62Jxjt17/rtP4yJzRXrVMuAmTl J1NiMIBrXHKbBS0wbJYOXa5QAxVWnQp86D5O5ZS4AcUSmu/XeA6TWuAQTHnDqShCAL9efDcxp sRgedUM9hXvEcVF4ox0LVo7+RR7y5JJCEd2v1S/yB4PBoQboo33N4MfDsqRbMusRU6ON+VUcY AuBJebK2fpMYTqjNv49kN2UvDQ9s6qd7U8ZPuGgIma73hFQtO8vb0HytK2HV7IDo3Ix4nFvVz Vdr8yt5XgPMyS0/uQxrMHviducIfw2jdi1lk9/91xWzKXTuUqdpSlWtf9kPmn3329ISHlhZ3i zEuD+1GE0NdLC68lGvX0M+tusUVTGZaqVWJ3iC394+f7GbYcd/sNiLegbusnQUaIrLrEurW7S xGqVoteDIQcourZpFCPB8XSMdhMB+bIljt4e9FNrQjRawcggCsb+ee+B9jXlJJhPEuMG9E1Iq dDTWSfV6bEzx45xtVMe6Vv/577fIppDrUWqQKk5g5PvU0Q6zZ3DIel1paaqX8U/JN0VSa/Pi9 9pM2kLQ2oklwVIhQGfUf/aQQCb6M3CZ1sYaj3loPgmEE+0WK2TbsuKgB8k1ZJ+R6CKzPQ0t4E WCfxU4QwOuqso9t+amhmjnnlcEC1yM5NRkSqSrcZB62XD3W31FZMHMdqNAWU/Otj7tJipb3Sz S7oppwj1jb0eRIwL4ECc0ttMYTqaNW+64gDyIGyym7V+adtuJonVP+G1yM+Ki8t/mZl0qe2mj oF5MyEWU X-Spam-Status: No, score=-12.4 required=5.0 tests=BAYES_00,DKIM_SIGNED,DKIM_VALID,FREEMAIL_FROM,GIT_PATCH_0,RCVD_IN_DNSWL_LOW,RCVD_IN_MSPIKE_H2,SPF_HELO_NONE,SPF_PASS,TXREP autolearn=ham autolearn_force=no version=3.4.6 X-Spam-Checker-Version: SpamAssassin 3.4.6 (2021-04-09) on server2.sourceware.org List-Id: --trekuen-3e7f7200-4389-4591-b9b0-6096bfed38f3 Content-Type: text/plain; charset=UTF-8 Dear all, this PR is actually very related to PR107217 that addressed ICEs with bad array constructors with typespec when used in arithmetic expressions. The present patch extends the checking to logical operations and to comparisons and catches several ICE-on-invalid as well as a few cases of accepts-invalid. Regtested on x86_64-pc-linux-gnu. OK for mainline? Thanks, Harald --trekuen-3e7f7200-4389-4591-b9b0-6096bfed38f3 Content-Type: text/x-patch Content-Disposition: attachment; filename=pr107272.diff Content-Transfer-Encoding: quoted-printable =46rom 779baf06888f3adef13c12c468c0a5ef0a45f93e Mon Sep 17 00:00:00 2001 From: Harald Anlauf Date: Sun, 16 Oct 2022 20:32:27 +0200 Subject: [PATCH] Fortran: check type of operands of logical operations, comparisons [PR107272] gcc/fortran/ChangeLog: PR fortran/107272 * arith.cc (gfc_arith_not): Operand must be of type BT_LOGICAL. (gfc_arith_and): Likewise. (gfc_arith_or): Likewise. (gfc_arith_eqv): Likewise. (gfc_arith_neqv): Likewise. (gfc_arith_eq): Compare consistency of types of operands. (gfc_arith_ne): Likewise. (gfc_arith_gt): Likewise. (gfc_arith_ge): Likewise. (gfc_arith_lt): Likewise. (gfc_arith_le): Likewise. gcc/testsuite/ChangeLog: PR fortran/107272 * gfortran.dg/pr107272.f90: New test. =2D-- gcc/fortran/arith.cc | 33 ++++++++++++++++++++++++++ gcc/testsuite/gfortran.dg/pr107272.f90 | 21 ++++++++++++++++ 2 files changed, 54 insertions(+) create mode 100644 gcc/testsuite/gfortran.dg/pr107272.f90 diff --git a/gcc/fortran/arith.cc b/gcc/fortran/arith.cc index c8e882badab..fc9224ebc5c 100644 =2D-- a/gcc/fortran/arith.cc +++ b/gcc/fortran/arith.cc @@ -422,6 +422,9 @@ gfc_arith_not (gfc_expr *op1, gfc_expr **resultp) { gfc_expr *result; + if (op1->ts.type !=3D BT_LOGICAL) + return ARITH_INVALID_TYPE; + result =3D gfc_get_constant_expr (BT_LOGICAL, op1->ts.kind, &op1->where= ); result->value.logical =3D !op1->value.logical; *resultp =3D result; @@ -435,6 +438,9 @@ gfc_arith_and (gfc_expr *op1, gfc_expr *op2, gfc_expr = **resultp) { gfc_expr *result; + if (op1->ts.type !=3D BT_LOGICAL || op2->ts.type !=3D BT_LOGICAL) + return ARITH_INVALID_TYPE; + result =3D gfc_get_constant_expr (BT_LOGICAL, gfc_kind_max (op1, op2), &op1->where); result->value.logical =3D op1->value.logical && op2->value.logical; @@ -449,6 +455,9 @@ gfc_arith_or (gfc_expr *op1, gfc_expr *op2, gfc_expr *= *resultp) { gfc_expr *result; + if (op1->ts.type !=3D BT_LOGICAL || op2->ts.type !=3D BT_LOGICAL) + return ARITH_INVALID_TYPE; + result =3D gfc_get_constant_expr (BT_LOGICAL, gfc_kind_max (op1, op2), &op1->where); result->value.logical =3D op1->value.logical || op2->value.logical; @@ -463,6 +472,9 @@ gfc_arith_eqv (gfc_expr *op1, gfc_expr *op2, gfc_expr = **resultp) { gfc_expr *result; + if (op1->ts.type !=3D BT_LOGICAL || op2->ts.type !=3D BT_LOGICAL) + return ARITH_INVALID_TYPE; + result =3D gfc_get_constant_expr (BT_LOGICAL, gfc_kind_max (op1, op2), &op1->where); result->value.logical =3D op1->value.logical =3D=3D op2->value.logical; @@ -477,6 +489,9 @@ gfc_arith_neqv (gfc_expr *op1, gfc_expr *op2, gfc_expr= **resultp) { gfc_expr *result; + if (op1->ts.type !=3D BT_LOGICAL || op2->ts.type !=3D BT_LOGICAL) + return ARITH_INVALID_TYPE; + result =3D gfc_get_constant_expr (BT_LOGICAL, gfc_kind_max (op1, op2), &op1->where); result->value.logical =3D op1->value.logical !=3D op2->value.logical; @@ -1187,6 +1202,9 @@ gfc_arith_eq (gfc_expr *op1, gfc_expr *op2, gfc_expr= **resultp) { gfc_expr *result; + if (op1->ts.type !=3D op2->ts.type) + return ARITH_INVALID_TYPE; + result =3D gfc_get_constant_expr (BT_LOGICAL, gfc_default_logical_kind, &op1->where); result->value.logical =3D (op1->ts.type =3D=3D BT_COMPLEX) @@ -1203,6 +1221,9 @@ gfc_arith_ne (gfc_expr *op1, gfc_expr *op2, gfc_expr= **resultp) { gfc_expr *result; + if (op1->ts.type !=3D op2->ts.type) + return ARITH_INVALID_TYPE; + result =3D gfc_get_constant_expr (BT_LOGICAL, gfc_default_logical_kind, &op1->where); result->value.logical =3D (op1->ts.type =3D=3D BT_COMPLEX) @@ -1219,6 +1240,9 @@ gfc_arith_gt (gfc_expr *op1, gfc_expr *op2, gfc_expr= **resultp) { gfc_expr *result; + if (op1->ts.type !=3D op2->ts.type) + return ARITH_INVALID_TYPE; + result =3D gfc_get_constant_expr (BT_LOGICAL, gfc_default_logical_kind, &op1->where); result->value.logical =3D (gfc_compare_expr (op1, op2, INTRINSIC_GT) > = 0); @@ -1233,6 +1257,9 @@ gfc_arith_ge (gfc_expr *op1, gfc_expr *op2, gfc_expr= **resultp) { gfc_expr *result; + if (op1->ts.type !=3D op2->ts.type) + return ARITH_INVALID_TYPE; + result =3D gfc_get_constant_expr (BT_LOGICAL, gfc_default_logical_kind, &op1->where); result->value.logical =3D (gfc_compare_expr (op1, op2, INTRINSIC_GE) >= =3D 0); @@ -1247,6 +1274,9 @@ gfc_arith_lt (gfc_expr *op1, gfc_expr *op2, gfc_expr= **resultp) { gfc_expr *result; + if (op1->ts.type !=3D op2->ts.type) + return ARITH_INVALID_TYPE; + result =3D gfc_get_constant_expr (BT_LOGICAL, gfc_default_logical_kind, &op1->where); result->value.logical =3D (gfc_compare_expr (op1, op2, INTRINSIC_LT) < = 0); @@ -1261,6 +1291,9 @@ gfc_arith_le (gfc_expr *op1, gfc_expr *op2, gfc_expr= **resultp) { gfc_expr *result; + if (op1->ts.type !=3D op2->ts.type) + return ARITH_INVALID_TYPE; + result =3D gfc_get_constant_expr (BT_LOGICAL, gfc_default_logical_kind, &op1->where); result->value.logical =3D (gfc_compare_expr (op1, op2, INTRINSIC_LE) <= =3D 0); diff --git a/gcc/testsuite/gfortran.dg/pr107272.f90 b/gcc/testsuite/gfortr= an.dg/pr107272.f90 new file mode 100644 index 00000000000..4b5c6a0f844 =2D-- /dev/null +++ b/gcc/testsuite/gfortran.dg/pr107272.f90 @@ -0,0 +1,21 @@ +! { dg-do compile } +! PR fortran/107272 - followup of PR/107217 for non-numeric types + +program p + print *, 2 <=3D [real :: (['1'])] ! { dg-error "Cannot convert" } + print *, 2 < [real :: (['1'])] ! { dg-error "Cannot convert" } + print *, 2 =3D=3D [real :: (['1'])] ! { dg-error "Cannot convert" } + print *, 2 /=3D [real :: (['1'])] ! { dg-error "Cannot convert" } + print *, 2 >=3D [real :: (['1'])] ! { dg-error "Cannot convert" } + print *, 2 > [real :: (['1'])] ! { dg-error "Cannot convert" } + print *, [real :: (['1'])] >=3D 2 ! { dg-error "Cannot convert" } + print *, [real :: (['1'])] > 2 ! { dg-error "Cannot convert" } + print *, [real :: (['1'])] =3D=3D 2 ! { dg-error "Cannot convert" } + print *, [real :: (['1'])] /=3D 2 ! { dg-error "Cannot convert" } + print *, [real :: (['1'])] <=3D 2 ! { dg-error "Cannot convert" } + print *, [real :: (['1'])] < 2 ! { dg-error "Cannot convert" } + print *, [logical :: (['1'])] .and. .true. ! { dg-error "Cannot conver= t" } + print *, [logical :: (['1'])] .or. .true. ! { dg-error "Cannot conver= t" } + print *, [logical :: (['1'])] .eqv. .true. ! { dg-error "Cannot conver= t" } + print *, [logical :: (['1'])] .neqv. .true. ! { dg-error "Cannot conver= t" } +end =2D- 2.35.3 --trekuen-3e7f7200-4389-4591-b9b0-6096bfed38f3--