3 ! Tests that the PRs caused by the lack of gfc_simplify_transfer are
4 ! now fixed. These were brought together in the meta-bug PR31237
5 ! (TRANSFER intrinsic).
6 ! Remaining PRs on 20070409 :-18769 30881 31194 31216 31424 31427
8 program simplify_transfer
9 CHARACTER(LEN
=100) :: buffer
="1.0 3.0"
18 ! Contributed by Joost VandeVondele <jv244@cam.ac.uk>
24 type (t
), parameter :: u
= t (42)
25 integer, parameter :: idx_list(1) = (/ 1 /)
26 integer :: j(1) = transfer (u
, idx_list
)
27 if (j(1) .ne
. 42) call abort ()
28 end subroutine pr18769
32 ! Contributed by Joost VandeVondele <jv244@cam.ac.uk>
34 INTEGER, PARAMETER :: K
=1
38 CASE(TRANSFER(.TRUE
.,K
))
39 CASE(TRANSFER(.FALSE
.,K
))
46 CASE(TRANSFER(.TRUE
.,K
))
48 CASE(TRANSFER(.FALSE
.,K
))
52 END subroutine pr30881
56 ! Contributed by Tobias Burnus <burnus@gcc.gnu.org>
58 real(kind(0d0)) :: NaN
= transfer(ishft(int(z
'FFF80000',8),32),0d0)
59 write (buffer
,'(e12.5)') NaN
60 if (buffer(10:12) .ne
. "NaN") call abort ()
61 end subroutine pr31194
65 ! Contributed by Joost VandeVondele <jv244@cam.ac.uk>
73 CASE (TRANSFER(1.0/3.0,1))
77 END subroutine pr31216
81 ! Contributed by Michael Richmond <michael.a.richmond@nasa.gov>
83 INTEGER(KIND
=1) :: i(1)
84 i
= (/ TRANSFER("a", 0_1) /)
85 if (i(1) .ne
. ichar ("a")) call abort ()
86 END subroutine pr31427
87 end program simplify_transfer