From patchwork Sat Jan 13 21:12:42 2024 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 7bit X-Patchwork-Submitter: Harald Anlauf X-Patchwork-Id: 84050 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 7F4A63858D3C for ; Sat, 13 Jan 2024 21:13:36 +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.18]) by sourceware.org (Postfix) with ESMTPS id 53B7C3858D20; Sat, 13 Jan 2024 21:12:44 +0000 (GMT) DMARC-Filter: OpenDMARC Filter v1.4.2 sourceware.org 53B7C3858D20 Authentication-Results: sourceware.org; dmarc=pass (p=quarantine dis=none) header.from=gmx.de Authentication-Results: sourceware.org; spf=pass smtp.mailfrom=gmx.de ARC-Filter: OpenARC Filter v1.0.0 sourceware.org 53B7C3858D20 Authentication-Results: server2.sourceware.org; arc=none smtp.remote-ip=212.227.15.18 ARC-Seal: i=1; a=rsa-sha256; d=sourceware.org; s=key; t=1705180366; cv=none; b=i1pzy7fZStQKt+1ynV3XaooQx1OZZR/sqJ53TqnsidTCslVxFdnJ0WxhLaZ2tY/ORh9/W3lPrl6yEjw5tJ9776hGpzFaD/zIu+lIkQRHMA6F91Wq4HKWcBaK92SEZopAgcFQAgSaA6v8B2JYQ6ZZyFp4GKAMk2F+gI8cjHdeGoo= ARC-Message-Signature: i=1; a=rsa-sha256; d=sourceware.org; s=key; t=1705180366; c=relaxed/simple; bh=ohjRQeI494hdRcYZBCu6mhgzipzorUolgeXh8OWTXC0=; h=DKIM-Signature:MIME-Version:Message-ID:From:To:Subject:Date; b=QPrY7pwcks8N8QRBi2O2DuHc85RsCoUX1WhLE02H4475Bn2qHxpLn0WNiDNzE99Vh1XOjnPX+oD3EUDZ/D1Yrr4WDynli8tx8uCNOLHot5J/HGYjg87/m1xd4Ym/rcI47uHkpw0168xLiulgJTbpgR7mHMatrt1HWEcPHt888QM= ARC-Authentication-Results: i=1; server2.sourceware.org DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/simple; d=gmx.de; s=s31663417; t=1705180362; x=1705785162; i=anlauf@gmx.de; bh=ohjRQeI494hdRcYZBCu6mhgzipzorUolgeXh8OWTXC0=; h=X-UI-Sender-Class:From:To:Subject:Date; b=i2XHnUKqAKKmItz91ay3I1miMW6gXbHhdpnHf1E1QVWKCqV89uyC+ijPb73j463N gqhPL2GoJ1ju+ugX45EYrPdqMtTLtrsYAX3tIbF3djbl+AO4iKWB8h4IlS30Vllih aoTvJ4OzZhjiRhpXSmM+XvHAI+FHgjBGYXKly+lM0WjGg7torOT/tz9SxdkQrfJeM IzZt5G4ETV90UjIIY+/eaHiMiFiutUvnRgTSvcnuLz/Kc54Iy+S49e+o68LdR03cb v7RUHBqYxmDwE9WY+4LP09+Mhr6JSuI/+yc6333VQWKWh0kRdo9o5DAKTzsNplB2p cjoXHluDJTu2NzH8VQ== X-UI-Sender-Class: 724b4f7f-cbec-4199-ad4e-598c01a50d3a Received: from [79.251.6.39] ([79.251.6.39]) by web-mail.gmx.net (3c-app-gmx-bs12.server.lan [172.19.170.63]) (via HTTP); Sat, 13 Jan 2024 22:12:42 +0100 MIME-Version: 1.0 Message-ID: From: Harald Anlauf To: fortran , gcc-patches Subject: [PATCH] Fortran: intrinsic ISHFTC and missing optional argument SIZE [PR67277] Date: Sat, 13 Jan 2024 22:12:42 +0100 Importance: normal Sensitivity: Normal X-Priority: 3 X-Provags-ID: V03:K1:6+ZZc6YNgLEDZ9KF8DBXSRwN2nLrjfb997N6giSqwmY9kJJFv3g0VHWetgNxEum6o1EkU C977M1p/fosNJz2B23x49Av/e2PJasdV5FiWLA0YPq6NoVUmsAbO0/JOX+IPz7lnBcVfjq9qjoaT iNRc5yHOJrFajooq6R8OPGz3qvSiCoVR5E/jTVEOXbkBYD7olvX8XMkMHDTo/cZl3baXOHgeplY8 xgGxYxuCdD3QwzPYuKAkO6RQeQB6bsdpJrJtvOVzXkxEj+8fnQKifF6o/cCTMOJBI2JLVz6Fooe4 qQ= UI-OutboundReport: notjunk:1;M01:P0:P9NWrlwRd8M=;br/S2PatFrV4fd/3r1iSaEz7rHQ i25TdE4tnJoYV3/idSu7Nq9HeMG5pYNxx08rHiUArc8TTLSjW5WIqvQDh5eA3cdHZQkBARJmP 6vrlJKxamT37/3zpDg2uYeoR20pxl9NiDIvaV6RHh607tI0p2HgnpRDe5eLoP3DJLOqKAFDv+ kCoecFORhb5rePLnxABWsVbWi+s4e2yOE/IA1KHX2cai412AB9TkOALuBwVUoXswpsbvuLgBa IRcGHNBmh/NyS5RWBN5dLDLbJPF3qXDZ7kSl+9swpAqc2AYXeTS7DfSWASgCv8rhX6AlTmDta k6zxN/2cCxY3EQZC3/+T0sFyVouFUg9C7WnRkuvcrWqPI06Vb92ftb9iXXSwoOzGw+R0YGpC+ 8Likrrmyqo+PNU7P8TQuXUDK4QD8mUCICkbl/jNpCGstYj1n6kMeK3dJEEQpQlxg9D2Zon07M 1fWbyEB6xbSxZ49joUKGWFHTR4tgfBN+k86u44dj+EtPBbTKrbfflWb2OEup1QTQ2UOrycFpX +e6miOUQErXKiFuX5QCh2rPx3oIyEH4FICkop9zD2yM4i7WhUVY7TXt6D18GLUSv8Le9n2kdA 0/46lDrCrHVB41umojhFzlOcTmhv7jxdJLOUptQlxMCq4OWMudVk/wCzUvwRE0OLu40RZZhzl 25QAnmoADY3oR4E5fj9L3cSPmmiysO+nREY34/01epBquDl8eapfCGFHvXKnHFzeIoLNK4MLJ 38TEOL1riZId4opqkLTQ/x4O8SNnJR2XC/21RwDG4/cgkgMd2xnAnHIRZYNZOF7dNaXOFTqaN WVna5bJPtaHpxzTKQKt9kuFw== X-Spam-Status: No, score=-12.5 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.30 Precedence: list List-Id: Gcc-patches mailing list List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: gcc-patches-bounces+patchwork=sourceware.org@gcc.gnu.org Dear all, the testcase given in PR67277 actually consists of two separate issues: (1) passing an optional dummy argument to an elemental (intrinsic) procedure (2) a missing optional argument for SIZE to the ISHFTC intrinsic shall be equivalent to using BIT_SIZE(I). I've created a separate PR113377 for (1), as this looks like a more general issue with the scalarizer. The attached, rather simple and obvious patch thus fixes (2). Besides testing that the patch works as advertised, the testcase also contains variations that need fixing of PR113377 before they can be uncommented. Regtested on x86_64-pc-linux-gnu. OK for mainline? As I consider the patch safe, I'd like to backport to 13-branch later. Thanks, Harald P.S.: if someone out there feels familiar with the scalarizer, a look at PR113377 is appreciated. From 20da56165273c8814b3c53e6d71549ba6a37e0cd Mon Sep 17 00:00:00 2001 From: Harald Anlauf Date: Sat, 13 Jan 2024 22:00:21 +0100 Subject: [PATCH] Fortran: intrinsic ISHFTC and missing optional argument SIZE [PR67277] gcc/fortran/ChangeLog: PR fortran/67277 * trans-intrinsic.cc (gfc_conv_intrinsic_ishftc): Handle optional dummy argument for SIZE passed to ISHFTC. Set default value to BIT_SIZE(I) when missing. gcc/testsuite/ChangeLog: PR fortran/67277 * gfortran.dg/ishftc_optional_size_1.f90: New test. --- gcc/fortran/trans-intrinsic.cc | 14 +++ .../gfortran.dg/ishftc_optional_size_1.f90 | 97 +++++++++++++++++++ 2 files changed, 111 insertions(+) create mode 100644 gcc/testsuite/gfortran.dg/ishftc_optional_size_1.f90 diff --git a/gcc/fortran/trans-intrinsic.cc b/gcc/fortran/trans-intrinsic.cc index 74139262657..0468dfae2b1 100644 --- a/gcc/fortran/trans-intrinsic.cc +++ b/gcc/fortran/trans-intrinsic.cc @@ -6863,9 +6863,23 @@ gfc_conv_intrinsic_ishftc (gfc_se * se, gfc_expr * expr) if (num_args == 3) { + gfc_expr *size = expr->value.function.actual->next->next->expr; + /* Use a library function for the 3 parameter version. */ tree int4type = gfc_get_int_type (4); + /* Treat optional SIZE argument when it is passed as an optional + dummy. If SIZE is absent, the default value is BIT_SIZE(I). */ + if (size->expr_type == EXPR_VARIABLE + && size->symtree->n.sym->attr.dummy + && size->symtree->n.sym->attr.optional) + { + tree type_of_size = TREE_TYPE (args[2]); + args[2] = build3_loc (input_location, COND_EXPR, type_of_size, + gfc_conv_expr_present (size->symtree->n.sym), + args[2], fold_convert (type_of_size, nbits)); + } + /* We convert the first argument to at least 4 bytes, and convert back afterwards. This removes the need for library functions for all argument sizes, and function will be diff --git a/gcc/testsuite/gfortran.dg/ishftc_optional_size_1.f90 b/gcc/testsuite/gfortran.dg/ishftc_optional_size_1.f90 new file mode 100644 index 00000000000..1ccf4b38caa --- /dev/null +++ b/gcc/testsuite/gfortran.dg/ishftc_optional_size_1.f90 @@ -0,0 +1,97 @@ +! { dg-do run } +! +! PR fortran/67277 - ISHFTC and missing optional argument SIZE + +module m + implicit none +contains + ! Optional argument passed by reference + elemental function ishftc4_ref (i, shift, size_) result(r) + integer(4), intent(in) :: i + integer, intent(in) :: shift + integer, intent(in), optional :: size_ + integer :: r + r = ishftc (i, shift=shift, size=size_) + end + + elemental function ishftc1_ref (i, shift, size_) result(r) + integer(1), intent(in) :: i + integer, intent(in) :: shift + integer(1), intent(in), optional :: size_ + integer(1) :: r + r = ishftc (i, shift=shift, size=size_) + end + + ! Array valued argument i + function ishftc4_ref_4 (i, shift, size_) result(r) + integer(4), intent(in) :: i(4) + integer, intent(in) :: shift + integer, intent(in), optional :: size_ + integer :: r(size(i)) + r = ishftc (i, shift=shift, size=size_) + end + + ! Optional argument passed by value + elemental function ishftc4_val (i, shift, size_) result(r) + integer(4), intent(in) :: i + integer, intent(in) :: shift + integer, value, optional :: size_ + integer :: r + r = ishftc (i, shift=shift, size=size_) + end + + elemental function ishftc1_val (i, shift, size_) result(r) + integer(1), intent(in) :: i + integer, intent(in) :: shift + integer(1), value, optional :: size_ + integer(1) :: r + r = ishftc (i, shift=shift, size=size_) + end + + ! Array valued argument i + function ishftc4_val_4 (i, shift, size_) result(r) + integer(4), intent(in) :: i(4) + integer, intent(in) :: shift + integer, value, optional :: size_ + integer :: r(size(i)) + r = ishftc (i, shift=shift, size=size_) + end +end module m + +program p + use m + implicit none + integer :: shift = 1 + integer(4) :: i4 = 127, j4(4), k4(4) + integer(1) :: i1 = 127 + integer(4) :: expect4 + integer(1) :: expect1 + + ! Scalar variants + expect4 = 2*i4 + if (ishftc (i4, shift) /= expect4) stop 1 + if (ishftc4_ref (i4, shift) /= expect4) stop 2 + if (ishftc4_val (i4, shift) /= expect4) stop 3 + + expect1 = -2_1 + if (ishftc (i1, shift) /= expect1) stop 4 + if (ishftc1_ref (i1, shift) /= expect1) stop 5 + if (ishftc1_val (i1, shift) /= expect1) stop 6 + + ! Array arguments + expect4 = 2*i4 + j4 = i4 + k4 = ishftc (j4, shift) + if (any (k4 /= expect4)) stop 7 + + ! The following works on x86_64 but might currently fail on other systems: + ! (see PR113377) +! k4 = ishftc4_val_4 (j4, shift) +! if (any (k4 /= expect4)) stop 8 + + ! The following currently segfaults (might be a scalarizer issue): + ! (see PR113377) +! k4 = ishftc4_ref_4 (j4, shift) +! print *, k4 +! if (any (k4 /= expect4)) stop 9 +end program p -- 2.35.3