From mboxrd@z Thu Jan 1 00:00:00 1970 Return-Path: Received: from mout.gmx.net (mout.gmx.net [212.227.15.15]) by sourceware.org (Postfix) with ESMTPS id 5002F3858C62; Mon, 28 Nov 2022 20:05:45 +0000 (GMT) DMARC-Filter: OpenDMARC Filter v1.4.1 sourceware.org 5002F3858C62 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=1669665943; bh=LTu/C2zbLmF4tS8pIVMlFAUDxV9wwkaFSunxx/wrzm4=; h=X-UI-Sender-Class:From:To:Subject:Date; b=MJtt08uX/4LLniud8iweA6JMQQUJerfuzSgDI92HiQAaCgUUMYC0NEUAWxAv2yAJ2 y5tCXXmoBD4KoqFmy4Dp/jeMyInjiyQ0obokzFpDUE/8Ndkjzry9TSwHeoBHbARaX+ VOAEX4NrLhkeoxThwwYxkJnEIL+6GOxUT/yEy8goAHfia+aqpv8Dw5HNbcDkzn1HYs d4XQKBqjIyK7Dc6uj9lDH+BY+GCMvDeoxAGmcJtti+sEUX3rHSylrg21gRuevnceQR TeVIJYJPVO39lkuGfFkfHCMn65HvIHQ2K4Ple5voH8LVSO4Rc+/quWyrAJ/1ADJ/AS rhcs17W21xFww== X-UI-Sender-Class: 724b4f7f-cbec-4199-ad4e-598c01a50d3a Received: from [93.207.88.169] ([93.207.88.169]) by web-mail.gmx.net (3c-app-gmx-bs02.server.lan [172.19.170.51]) (via HTTP); Mon, 28 Nov 2022 21:05:43 +0100 MIME-Version: 1.0 Message-ID: From: Harald Anlauf To: fortran , gcc-patches Subject: [PATCH] Fortran: intrinsic MERGE shall use all its arguments [PR107874] Content-Type: multipart/mixed; boundary=trekuen-5cbdc105-2043-4856-a6ef-5a633a7b257e Date: Mon, 28 Nov 2022 21:05:43 +0100 Importance: normal Sensitivity: Normal X-Priority: 3 X-Provags-ID: V03:K1:oxDv6zzbrsaHFo+Ks8oJhxxajK7Ayuz6UL9LxCPNAuRuOdweFBzHgxugAkyAH5bpqo79z Ks4W1RpN6RoZGQK1GOyJx7EbBuU0y/btFjp14PXPZdu08FNP2XrNAUmwq7QpYiFS1pTDzcIbFldK PSCiTBwJmKIulACNcnPol6Y05WEcfr8uB8QOXAgDDBccRrNRzVY+nMQST7PWPf2LpkEiZmbFty90 QQDNbN+DVpIt5AAEJkPRgaP80wAicrEXWU4qPqDisz6X94DQ+4LhsKpjBgEQl+WWDSgq4IeOeuO3 K8= UI-OutboundReport: notjunk:1;M01:P0:jL6SGgZ/8wU=;eT29RIUoEwSPOIH4sUIvr/fiBNw D0nhey8kWec7hU7h8fHTTIwTOb5nKquVhVmg8vonvv5NFdS4/xiZfSs61IaNt2+JBS1BJ6pah 2jtNenm+17QxglqzHMNnnfjjJk2bj4Oe+IUS1aaQgdEdUT32RmCWqSSjwpaeszn6OnQghyiaa m3/gDrPnJSPY7hW7slWGartngdOXVpaSypqW0+lMYrukG0Ih4WTexairSq+bxn+vmITTnqFo1 zO4RzgDw+5w+5/p2ch6XcERxhwZlY6GZ7OeRdho+GMg7G9Bj7FtA/PFkOa/S60fw8ifD+MlU6 VTkjhLtqa9oKU0Tp0VyOSlfU9P2EsShvK+0bH3qsbiJckSA68cCogr1XaEjxKebiSkwieXTUB TiRTaAOSBAnhA3WlaUZmh9U7z//uA9mcj4qyRXpBCj6aZ0pZltKtVQeNEw9vFNmjhSwhsxCBY rV4tkVYUGjYSS8Aq+LqKgON2nkjvN+Bl3hN1O0FbUoBc3BOwtHU0QG8bGw23KoIW7slqADV/8 LKIsqnFsEghYW9+zMhMAZt8spAgi1eygiCyTCQ3U6clHoiAJQzU+mkcF1BAEONnX2PamOe4hI EhngkvwgYM+9XfzbXgdHSujONNC8H1tDg8C317Y3qg9vUcgXTpNgr3u4mSBHqXAwkORyKVeSv 5B9Jkdw++TRvUJxkvpw9tf6938oo2VxW8D2nNf4HUvTUcwULX11UOlhReB281Ecz6JWIgKaCz 1uqducZXD2Y1APvZk25260X9WNJliTSpoVoZm82BBbaet/i3+IIhyfcMY8Zk8fsZ/yWc+QKbH 8eR0Ed1WpB73Rb55kY57c+V4BTYDt4ujMDjcdCZxUaJ8I= X-Spam-Status: No, score=-13.3 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 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-5cbdc105-2043-4856-a6ef-5a633a7b257e Content-Type: text/plain; charset=UTF-8 Dear all, as reported, the Fortran standard requires all actual argument expressions to be evaluated (e.g. F2018:15.5.3). There were two cases for intrinsic MERGE where we failed to do so: - non-constant mask; Steve provided the patch - constant scalar mask; we need to be careful to simplify only if the argument on the "other" path is known to be constant so that it does not have side-effects and can be immediately removed. The latter change needed a correction of a sub-test of testcase merge_init_expr_2.f90, which should not have been simplified the way the original author assumed. I decided to modify the test in such way that simplification is valid and provides the expect pattern. Regtested on x86_64-pc-linux-gnu. OK for mainline? Thanks, Harald --trekuen-5cbdc105-2043-4856-a6ef-5a633a7b257e Content-Type: text/x-patch Content-Disposition: attachment; filename=pr107874.diff Content-Transfer-Encoding: quoted-printable =46rom 0f6058937c04a7af5e6dcfa173648149c24f08df Mon Sep 17 00:00:00 2001 From: Harald Anlauf Date: Mon, 28 Nov 2022 20:43:02 +0100 Subject: [PATCH] Fortran: intrinsic MERGE shall use all its arguments [PR107874] gcc/fortran/ChangeLog: PR fortran/107874 * simplify.cc (gfc_simplify_merge): When simplifying MERGE with a constant scalar MASK, ensure that arguments TSOURCE and FSOURCE are either constant or will be evaluated. * trans-intrinsic.cc (gfc_conv_intrinsic_merge): Evaluate arguments before generating conditional expression. gcc/testsuite/ChangeLog: PR fortran/107874 * gfortran.dg/merge_init_expr_2.f90: Adjust code to the corrected simplification. * gfortran.dg/merge_1.f90: New test. Co-authored-by: Steven G. Kargl =2D-- gcc/fortran/simplify.cc | 17 ++++++- gcc/fortran/trans-intrinsic.cc | 3 ++ gcc/testsuite/gfortran.dg/merge_1.f90 | 49 +++++++++++++++++++ .../gfortran.dg/merge_init_expr_2.f90 | 3 +- 4 files changed, 70 insertions(+), 2 deletions(-) create mode 100644 gcc/testsuite/gfortran.dg/merge_1.f90 diff --git a/gcc/fortran/simplify.cc b/gcc/fortran/simplify.cc index 9c2fea8c5f2..b6184181f26 100644 =2D-- a/gcc/fortran/simplify.cc +++ b/gcc/fortran/simplify.cc @@ -4913,7 +4913,22 @@ gfc_simplify_merge (gfc_expr *tsource, gfc_expr *fs= ource, gfc_expr *mask) if (mask->expr_type =3D=3D EXPR_CONSTANT) { - result =3D gfc_copy_expr (mask->value.logical ? tsource : fsource); + /* The standard requires evaluation of all function arguments. + Simplify only when the other dropped argument (FSOURCE or TSOURCE) + is a constant expression. */ + if (mask->value.logical) + { + if (!gfc_is_constant_expr (fsource)) + return NULL; + result =3D gfc_copy_expr (tsource); + } + else + { + if (!gfc_is_constant_expr (tsource)) + return NULL; + result =3D gfc_copy_expr (fsource); + } + /* Parenthesis is needed to get lower bounds of 1. */ result =3D gfc_get_parentheses (result); gfc_simplify_expr (result, 1); diff --git a/gcc/fortran/trans-intrinsic.cc b/gcc/fortran/trans-intrinsic.= cc index bb938026828..93426981bac 100644 =2D-- a/gcc/fortran/trans-intrinsic.cc +++ b/gcc/fortran/trans-intrinsic.cc @@ -7557,6 +7557,9 @@ gfc_conv_intrinsic_merge (gfc_se * se, gfc_expr * ex= pr) &se->pre); se->string_length =3D len; } + tsource =3D gfc_evaluate_now (tsource, &se->pre); + fsource =3D gfc_evaluate_now (fsource, &se->pre); + mask =3D gfc_evaluate_now (mask, &se->pre); type =3D TREE_TYPE (tsource); se->expr =3D fold_build3_loc (input_location, COND_EXPR, type, mask, ts= ource, fold_convert (type, fsource)); diff --git a/gcc/testsuite/gfortran.dg/merge_1.f90 b/gcc/testsuite/gfortra= n.dg/merge_1.f90 new file mode 100644 index 00000000000..abbc2276b1c =2D-- /dev/null +++ b/gcc/testsuite/gfortran.dg/merge_1.f90 @@ -0,0 +1,49 @@ +! { dg-do run } +! PR fortran/107874 - merge not using all its arguments +! Contributed by John Harper + +program testmerge9 + implicit none + integer :: i + logical :: x(2) =3D (/.true., .false./) + logical :: called(2) + + ! At run-time all arguments shall be evaluated + do i =3D 1,2 + called =3D .false. + print *, merge (tstuff(), fstuff(), x(i)) + if (any (.not. called)) stop 1 + end do + + ! Compile-time simplification shall not drop non-constant args + called =3D .false. + print *, merge (tstuff(),fstuff(),.true.) + if (any (.not. called)) stop 2 + called =3D .false. + print *, merge (tstuff(),fstuff(),.false.) + if (any (.not. called)) stop 3 + called =3D .false. + print *, merge (tstuff(),.false.,.true.) + if (any (called .neqv. [.true.,.false.])) stop 4 + called =3D .false. + print *, merge (tstuff(),.false.,.false.) + if (any (called .neqv. [.true.,.false.])) stop 5 + called =3D .false. + print *, merge (.true.,fstuff(),.true.) + if (any (called .neqv. [.false.,.true.])) stop 6 + called =3D .false. + print *, merge (.true.,fstuff(),.false.) + if (any (called .neqv. [.false.,.true.])) stop 7 +contains + logical function tstuff() + print *,'tstuff' + tstuff =3D .true. + called(1) =3D .true. + end function tstuff + + logical function fstuff() + print *,'fstuff' + fstuff =3D .false. + called(2) =3D .true. + end function fstuff +end program testmerge9 diff --git a/gcc/testsuite/gfortran.dg/merge_init_expr_2.f90 b/gcc/testsui= te/gfortran.dg/merge_init_expr_2.f90 index c761a47cccb..f4a83801137 100644 =2D-- a/gcc/testsuite/gfortran.dg/merge_init_expr_2.f90 +++ b/gcc/testsuite/gfortran.dg/merge_init_expr_2.f90 @@ -48,7 +48,8 @@ end module m2 subroutine test - character(len=3D3) :: one, two, three + character(len=3D3) :: one, three + character(len=3D3), parameter :: two =3D "def" logical, parameter :: true =3D .true. three =3D merge (one, two, true) end subroutine test =2D- 2.35.3 --trekuen-5cbdc105-2043-4856-a6ef-5a633a7b257e--