|
111
|
1 ! { dg-do run }
|
|
|
2 ! { dg-options "-O2" }
|
|
|
3 ! { dg-skip-if "NaN not supported" { spu-*-* } }
|
|
|
4 ! Tests that the PRs caused by the lack of gfc_simplify_transfer are
|
|
|
5 ! now fixed. These were brought together in the meta-bug PR31237
|
|
|
6 ! (TRANSFER intrinsic).
|
|
|
7 ! Remaining PRs on 20070409 :-18769 30881 31194 31216 31424 31427
|
|
|
8 !
|
|
|
9 program simplify_transfer
|
|
|
10 CHARACTER(LEN=100) :: buffer="1.0 3.0"
|
|
|
11 call pr18769 ()
|
|
|
12 call pr30881 ()
|
|
|
13 call pr31194 ()
|
|
|
14 call pr31216 ()
|
|
|
15 call pr31427 ()
|
|
|
16 contains
|
|
|
17 subroutine pr18769 ()
|
|
|
18 !
|
|
|
19 ! Contributed by Joost VandeVondele <jv244@cam.ac.uk>
|
|
|
20 !
|
|
|
21 implicit none
|
|
|
22 type t
|
|
|
23 integer :: i
|
|
|
24 end type t
|
|
|
25 type (t), parameter :: u = t (42)
|
|
|
26 integer, parameter :: idx_list(1) = (/ 1 /)
|
|
|
27 integer :: j(1) = transfer (u, idx_list)
|
|
131
|
28 if (j(1) .ne. 42) STOP 1
|
|
111
|
29 end subroutine pr18769
|
|
|
30
|
|
|
31 subroutine pr30881 ()
|
|
|
32 !
|
|
|
33 ! Contributed by Joost VandeVondele <jv244@cam.ac.uk>
|
|
|
34 !
|
|
|
35 INTEGER, PARAMETER :: K=1
|
|
|
36 INTEGER :: I
|
|
|
37 I=TRANSFER(.TRUE.,K)
|
|
|
38 SELECT CASE(I)
|
|
|
39 CASE(TRANSFER(.TRUE.,K))
|
|
|
40 CASE(TRANSFER(.FALSE.,K))
|
|
131
|
41 STOP 2
|
|
111
|
42 CASE DEFAULT
|
|
131
|
43 STOP 3
|
|
111
|
44 END SELECT
|
|
|
45 I=TRANSFER(.FALSE.,K)
|
|
|
46 SELECT CASE(I)
|
|
|
47 CASE(TRANSFER(.TRUE.,K))
|
|
131
|
48 STOP 4
|
|
111
|
49 CASE(TRANSFER(.FALSE.,K))
|
|
|
50 CASE DEFAULT
|
|
131
|
51 STOP 5
|
|
111
|
52 END SELECT
|
|
|
53 END subroutine pr30881
|
|
|
54
|
|
|
55 subroutine pr31194 ()
|
|
|
56 !
|
|
|
57 ! Contributed by Tobias Burnus <burnus@gcc.gnu.org>
|
|
|
58 !
|
|
|
59 real(kind(0d0)) :: NaN = transfer(ishft(int(z'FFF80000',8),32),0d0)
|
|
|
60 write (buffer,'(e12.5)') NaN
|
|
131
|
61 if (buffer(10:12) .ne. "NaN") STOP 6
|
|
111
|
62 end subroutine pr31194
|
|
|
63
|
|
|
64 subroutine pr31216 ()
|
|
|
65 !
|
|
|
66 ! Contributed by Joost VandeVondele <jv244@cam.ac.uk>
|
|
|
67 !
|
|
|
68 INTEGER :: I
|
|
|
69 REAL :: C,D
|
|
|
70 buffer = " 1.0 3.0"
|
|
|
71 READ(buffer,*) C,D
|
|
|
72 I=TRANSFER(C/D,I)
|
|
|
73 SELECT CASE(I)
|
|
|
74 CASE (TRANSFER(1.0/3.0,1))
|
|
|
75 CASE DEFAULT
|
|
131
|
76 STOP 7
|
|
111
|
77 END SELECT
|
|
|
78 END subroutine pr31216
|
|
|
79
|
|
|
80 subroutine pr31427 ()
|
|
|
81 !
|
|
|
82 ! Contributed by Michael Richmond <michael.a.richmond@nasa.gov>
|
|
|
83 !
|
|
|
84 INTEGER(KIND=1) :: i(1)
|
|
|
85 i = (/ TRANSFER("a", 0_1) /)
|
|
131
|
86 if (i(1) .ne. ichar ("a")) STOP 8
|
|
111
|
87 END subroutine pr31427
|
|
|
88 end program simplify_transfer
|
