Dear all,
I've committed an obvious fix for the testcase to avoid recursive I/O,
as it did cause a hang on some systems:
https://gcc.gnu.org/g:36a4ee406b95ae24a59b8b3f8ebe29af6fd5261e
Confirmed by Jerry that this resolves his issue.
See also attached.
Thanks,
Harald
Am 29.11.22 um 09:08 schrieb Paul Richard Thomas via Gcc-patches:
Hi Harald,
It looks good to me.
Thanks to you and Steve for the patch.
Paul
On Mon, 28 Nov 2022 at 20:05, Harald Anlauf via Fortran <fortran@gcc.gnu.org>
wrote:
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
From 36a4ee406b95ae24a59b8b3f8ebe29af6fd5261e Mon Sep 17 00:00:00 2001
From: Harald Anlauf <anl...@gmx.de>
Date: Fri, 2 Dec 2022 22:30:16 +0100
Subject: [PATCH] Fortran: intrinsic MERGE shall use all its arguments
[PR107874]
gcc/testsuite/ChangeLog:
PR fortran/107874
* gfortran.dg/merge_1.f90: Avoid recursive I/O.
---
gcc/testsuite/gfortran.dg/merge_1.f90 | 22 +++++++++++++++-------
1 file changed, 15 insertions(+), 7 deletions(-)
diff --git a/gcc/testsuite/gfortran.dg/merge_1.f90 b/gcc/testsuite/gfortran.dg/merge_1.f90
index abbc2276b1c..437b13a8d3f 100644
--- a/gcc/testsuite/gfortran.dg/merge_1.f90
+++ b/gcc/testsuite/gfortran.dg/merge_1.f90
@@ -7,32 +7,40 @@ program testmerge9
integer :: i
logical :: x(2) = (/.true., .false./)
logical :: called(2)
+ logical :: y
! At run-time all arguments shall be evaluated
do i = 1,2
called = .false.
- print *, merge (tstuff(), fstuff(), x(i))
+ y = merge (tstuff(), fstuff(), x(i))
+ print *, y
if (any (.not. called)) stop 1
end do
! Compile-time simplification shall not drop non-constant args
called = .false.
- print *, merge (tstuff(),fstuff(),.true.)
+ y = merge (tstuff(),fstuff(),.true.)
+ print *, y
if (any (.not. called)) stop 2
called = .false.
- print *, merge (tstuff(),fstuff(),.false.)
+ y = merge (tstuff(),fstuff(),.false.)
+ print *, y
if (any (.not. called)) stop 3
called = .false.
- print *, merge (tstuff(),.false.,.true.)
+ y = merge (tstuff(),.false.,.true.)
+ print *, y
if (any (called .neqv. [.true.,.false.])) stop 4
called = .false.
- print *, merge (tstuff(),.false.,.false.)
+ y = merge (tstuff(),.false.,.false.)
+ print *, y
if (any (called .neqv. [.true.,.false.])) stop 5
called = .false.
- print *, merge (.true.,fstuff(),.true.)
+ y = merge (.true.,fstuff(),.true.)
+ print *, y
if (any (called .neqv. [.false.,.true.])) stop 6
called = .false.
- print *, merge (.true.,fstuff(),.false.)
+ y = merge (.true.,fstuff(),.false.)
+ print *, y
if (any (called .neqv. [.false.,.true.])) stop 7
contains
logical function tstuff()
--
2.35.3
