From mboxrd@z Thu Jan 1 00:00:00 1970 Return-Path: Received: from mout.gmx.net (mout.gmx.net [212.227.17.20]) by sourceware.org (Postfix) with ESMTPS id 722DB3858D28; Sun, 16 Jul 2023 20:31:01 +0000 (GMT) DMARC-Filter: OpenDMARC Filter v1.4.2 sourceware.org 722DB3858D28 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.de; s=s31663417; t=1689539459; x=1690144259; i=anlauf@gmx.de; bh=PcYUJPfC3WfRaXCosac/CRcu/MR09i/hMGn9ysjpRxE=; h=X-UI-Sender-Class:From:To:Subject:Date; b=TSlFDolEAOLMdhF8FJGWh4X2JENW47sKpTp/mamNQ6iWNakQ9ng6HBS/NVKkWEaXIc8l/Bp gSSei2MXsSmqj9MocPpMiL+1XXh8pUvIXAhSSCViVCisZr7eTYQkwN5JKF7TMC5rcEWD7ZFk+ IDqBHtWoAnP7IPIsZds8A6iSjMo1hVqBQYDyDa8GGNJV2vq9MHnLaogh8BIsPec/40sEUQlhj YirfVEj78oEQ9HkVpnT3lcQ2Pokd5u28nOiXoTlqpdrdV+e7xAplrIokguvrTIMy3wkDPNXHT eC2zhdktvU6OTHO9phPtQ9vo0skKWclIwdpqoCzC6MsyCRPKKXMg== X-UI-Sender-Class: 724b4f7f-cbec-4199-ad4e-598c01a50d3a Received: from [79.232.155.216] ([79.232.155.216]) by web-mail.gmx.net (3c-app-gmx-bap40.server.lan [172.19.172.110]) (via HTTP); Sun, 16 Jul 2023 22:30:59 +0200 MIME-Version: 1.0 Message-ID: From: Harald Anlauf To: fortran , gcc-patches Subject: [PATCH] Fortran: intrinsics and deferred-length character arguments [PR95947,PR110658] Content-Type: multipart/mixed; boundary=nika-2210a8ad-7982-4a29-9a5d-52d2db24bfbe Date: Sun, 16 Jul 2023 22:30:59 +0200 Importance: normal Sensitivity: Normal X-Priority: 3 X-Provags-ID: V03:K1:yak58LZjax3zE2Ol/vjYmTfeRxQWWkLY9vSAic9c736Mrq8lDRTQQHTfsHG5pt9V+/7Lm 3qSVCI7epgZKdq9BYXDNCJcB4dgPricdRz54SI52IwqRh1BrG+L60FP728eOorC1qp7XkSNjOVdo +nW/L0PXvTO/BzzbhH3m8o+F2vIHdyb2Sr4+jNysW8TsHCGFCMVpzoSM7SwGMDIew3lrde/6ThVG 02NvwzXKbN5+CZoMTP/51dVQRff3/guA1m0TiSlbkz2pzKl5NJqO27zkHKnrsgIpxsCQ/gVMmhvc ME= UI-OutboundReport: notjunk:1;M01:P0:iCBDY/h1QM0=;gYZ2eXK3hGyxpokURVcLbHbuG35 YIB+CkIrwk+5qXydyD7IjEoHiHPEfaa1rpkxRYKLOGqaetNwxVWgDOXXj/BNptb60ivlJVfD9 1lm5CbMiZIL5EeFdi1sy0CXbqUqvj6Uc0T7hFGENi5cXeMtfI1acwhttf9xm337E6SpoXKP+P qtyEGGdj2/yIiwI4FaAmduOiHSsbJOpCvothu7bz7Y9Bca5FJe6t1sJ5wmXqmLdfgN7ZwxFXz 4MpcDsuLMf/eCZYmX2nXTSjZMw/iWaH2q8k0Cr7OZRIE2z61QDlWpMp+N/3YrhJxRQi2F6L+K mJgxlPKP3KrQhpGfp2K4nbL128pAz5XFB6KOu8yakpfIDjSBTOUJ7QgR8pibXVkNZA1VyeEic 4bqPuR2e2t/p2p1LmjiRuHYCJGcy2M3NS1rM5dT9p/twD7jalDR0wOTQZJcKOiBAi9raDcMnl /DNlSCrg7Mz+EJgIeX07CZy324jrGs6mvAyXkguOkJJnnPBmr4WojAX1dAZCou2UoaqWWTNJi LI69bhe0uWNk3Pok0wHoVyFGFikxu8LIIxui+zPxJKccPqMclUWd4C3jZTPJ5cqvqnXY89gpO 0VNutdhmVP5GS7YDQrP4mR1ZtODyCIqUvTnnBeEZBvB9l5wSLTCut+AtXu38rYcmu9pV2NUwg 5fH/pOeJDjzT9vuOFiH822fWYAKvXpJKQfPirhiVAG8MBmrrZBityUqmLye/QyjTmThpSD2OZ we1QFhpm/mwJnMtf1cQrJkyCQXGxZ9mjGPal1P3VHlM1uEB6lHZ0QY1JFAdPtjV9qyWmjLz1a Lqwt1FgZwOGw/n136bI67Z64kWCu83j0OGjJKhUHuSh5E= X-Spam-Status: No, score=-12.6 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 List-Id: --nika-2210a8ad-7982-4a29-9a5d-52d2db24bfbe Content-Type: text/plain; charset=UTF-8 Dear all, some intrinsics may return character results with the same characteristics as their first argument (e.g. PACK, MINVAL, ...). If the first argument is of deferred-length, we need to derive the character length of the result from the first argument, like in the assumed-length case, but we must not handle it as deferred-length, as that has a different argument passing convention. The attached - almost trivial and obvious - patch fixes that. Regtested on x86_64-pc-linux-gnu. OK for mainline? As this is a rather simple fix for a wrong-code bug, I would like to backport this at least to 13-branch, unless there are major concerns. Thanks, Harald --nika-2210a8ad-7982-4a29-9a5d-52d2db24bfbe Content-Type: text/x-patch Content-Disposition: attachment; filename=pr110658.diff Content-Transfer-Encoding: quoted-printable =46rom 88d2694eb1278b0ad0d542565e0542c39fe6b466 Mon Sep 17 00:00:00 2001 From: Harald Anlauf Date: Sun, 16 Jul 2023 22:17:27 +0200 Subject: [PATCH] Fortran: intrinsics and deferred-length character argumen= ts [PR95947,PR110658] gcc/fortran/ChangeLog: PR fortran/95947 PR fortran/110658 * trans-expr.cc (gfc_conv_procedure_call): For intrinsic procedures whose result characteristics depends on the first argument and which can be of type character, the character length will not be deferred. gcc/testsuite/ChangeLog: PR fortran/95947 PR fortran/110658 * gfortran.dg/deferred_character_37.f90: New test. =2D-- gcc/fortran/trans-expr.cc | 7 +- .../gfortran.dg/deferred_character_37.f90 | 88 +++++++++++++++++++ 2 files changed, 94 insertions(+), 1 deletion(-) create mode 100644 gcc/testsuite/gfortran.dg/deferred_character_37.f90 diff --git a/gcc/fortran/trans-expr.cc b/gcc/fortran/trans-expr.cc index dbb04f8c434..d1570b31a82 100644 =2D-- a/gcc/fortran/trans-expr.cc +++ b/gcc/fortran/trans-expr.cc @@ -7654,7 +7654,12 @@ gfc_conv_procedure_call (gfc_se * se, gfc_symbol * = sym, (and other intrinsics?) and dummy functions. In the case of SPREAD= , we take the character length of the first argument for the result. For dummies, we have to look through the formal argument list for - this function and use the character length found there.*/ + this function and use the character length found there. + Likewise, we handle the case of deferred-length character dummy + arguments to intrinsics that determine the characteristics of + the result, which cannot be deferred-length. */ + if (expr->value.function.isym) + ts.deferred =3D false; if (ts.deferred) cl.backend_decl =3D gfc_create_var (gfc_charlen_type_node, "slen"); else if (!sym->attr.dummy) diff --git a/gcc/testsuite/gfortran.dg/deferred_character_37.f90 b/gcc/tes= tsuite/gfortran.dg/deferred_character_37.f90 new file mode 100644 index 00000000000..8a5a8c5daf8 =2D-- /dev/null +++ b/gcc/testsuite/gfortran.dg/deferred_character_37.f90 @@ -0,0 +1,88 @@ +! { dg-do run } +! PR fortran/95947 +! PR fortran/110658 +! +! Test deferred-length character arguments to selected intrinsics +! that may return a character result of same length as first argument: +! CSHIFT, EOSHIFT, MAXVAL, MERGE, MINVAL, PACK, SPREAD, TRANSPOSE, UNPACK + +program p + implicit none + call pr95947 () + call pr110658 () + call s () + +contains + + subroutine pr95947 + character(len=3D:), allocatable :: m(:) + + m =3D [ character(len=3D10) :: 'ape','bat','cat','dog','eel','fly','g= nu'] + m =3D pack (m, mask=3D(m(:)(2:2) =3D=3D 'a')) + +! print *, "m =3D '", m,"' ", "; expected is ['bat','cat'= ]" + if (.not. all (m =3D=3D ['bat','cat'])) stop 1 + +! print *, "size(m) =3D ", size(m), "; expected is 2" + if (size (m) /=3D 2) stop 2 + +! print *, "len(m) =3D ", len(m), "; expected is 10" + if (len (m) /=3D 10) stop 3 + +! print *, "len_trim(m) =3D ", len_trim(m), "; expected is 3 3" + if (.not. all (len_trim(m) =3D=3D [3,3])) stop 4 + end + + subroutine pr110658 + character(len=3D:), allocatable :: array(:), array2(:,:) + character(len=3D:), allocatable :: res, res1(:), res2(:) + + array =3D ["bb", "aa", "cc"] + + res =3D minval (array) + if (res /=3D "aa") stop 11 + + res =3D maxval (array, mask=3D[.true.,.true.,.false.]) + if (res /=3D "bb") stop 12 + + res1 =3D cshift (array, 1) + if (any (res1 /=3D ["aa","cc","bb"])) stop 13 + + res2 =3D eoshift (res1, -1) + if (any (res2 /=3D [" ", "aa", "cc"])) stop 14 + + res2 =3D pack (array, mask=3D[.true.,.false.,.true.]) + if (any (res2 /=3D ["bb","cc"])) stop 15 + + res2 =3D unpack (res2, mask=3D[.true.,.false.,.true.], field=3D"aa") + if (any (res2 /=3D array)) stop 16 + + res2 =3D merge (res2, array, [.true.,.false.,.true.]) + if (any (res2 /=3D array)) stop 17 + + array2 =3D spread (array, dim=3D2, ncopies=3D2) + array2 =3D transpose (array2) + if (any (shape (array2) /=3D [2,3])) stop 18 + if (any (array2(2,:) /=3D array)) stop 19 + end + + subroutine s + character(:), allocatable :: array1(:), array2(:) + array1 =3D ["aa","cc","bb"] + array2 =3D copy (array1) + if (any (array1 /=3D array2)) stop 20 + end + + function copy (arg) result (res) + character(:), allocatable :: res(:) + character(*), intent(in) :: arg(:) + integer :: i, k, n + k =3D len (arg) + n =3D size (arg) + allocate (character(k) :: res(n)) + do i =3D 1, n + res(i) =3D arg(i) + end do + end + +end =2D- 2.35.3 --nika-2210a8ad-7982-4a29-9a5d-52d2db24bfbe--