1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
|
! { 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) = (/.true., .false./)
logical :: called(2)
logical :: y
! At run-time all arguments shall be evaluated
do i = 1,2
called = .false.
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.
y = merge (tstuff(),fstuff(),.true.)
print *, y
if (any (.not. called)) stop 2
called = .false.
y = merge (tstuff(),fstuff(),.false.)
print *, y
if (any (.not. called)) stop 3
called = .false.
y = merge (tstuff(),.false.,.true.)
print *, y
if (any (called .neqv. [.true.,.false.])) stop 4
called = .false.
y = merge (tstuff(),.false.,.false.)
print *, y
if (any (called .neqv. [.true.,.false.])) stop 5
called = .false.
y = merge (.true.,fstuff(),.true.)
print *, y
if (any (called .neqv. [.false.,.true.])) stop 6
called = .false.
y = merge (.true.,fstuff(),.false.)
print *, y
if (any (called .neqv. [.false.,.true.])) stop 7
contains
logical function tstuff()
print *,'tstuff'
tstuff = .true.
called(1) = .true.
end function tstuff
logical function fstuff()
print *,'fstuff'
fstuff = .false.
called(2) = .true.
end function fstuff
end program testmerge9
|
