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!
9program 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 ()
16contains
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)
28    if (j(1) .ne. 42) STOP 1
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))
41        STOP 2
42      CASE DEFAULT
43        STOP 3
44    END SELECT
45    I=TRANSFER(.FALSE.,K)
46    SELECT CASE(I)
47      CASE(TRANSFER(.TRUE.,K))
48        STOP 4
49      CASE(TRANSFER(.FALSE.,K))
50      CASE DEFAULT
51      STOP 5
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
61    if (buffer(10:12) .ne. "NaN") STOP 6
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
76        STOP 7
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) /)
86    if (i(1) .ne. ichar ("a")) STOP 8
87  END subroutine pr31427
88end program simplify_transfer
89