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
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
|
! { dg-do run }
! { dg-options "-O2" }
! { dg-skip-if "NaN not supported" { spu-*-* } { "*" } { "" } }
! Tests that the PRs caused by the lack of gfc_simplify_transfer are
! now fixed. These were brought together in the meta-bug PR31237
! (TRANSFER intrinsic).
! Remaining PRs on 20070409 :-18769 30881 31194 31216 31424 31427
!
program simplify_transfer
CHARACTER(LEN=100) :: buffer="1.0 3.0"
call pr18769 ()
call pr30881 ()
call pr31194 ()
call pr31216 ()
call pr31427 ()
contains
subroutine pr18769 ()
!
! Contributed by Joost VandeVondele <jv244@cam.ac.uk>
!
implicit none
type t
integer :: i
end type t
type (t), parameter :: u = t (42)
integer, parameter :: idx_list(1) = (/ 1 /)
integer :: j(1) = transfer (u, idx_list)
if (j(1) .ne. 42) call abort ()
end subroutine pr18769
subroutine pr30881 ()
!
! Contributed by Joost VandeVondele <jv244@cam.ac.uk>
!
INTEGER, PARAMETER :: K=1
INTEGER :: I
I=TRANSFER(.TRUE.,K)
SELECT CASE(I)
CASE(TRANSFER(.TRUE.,K))
CASE(TRANSFER(.FALSE.,K))
CALL ABORT()
CASE DEFAULT
CALL ABORT()
END SELECT
I=TRANSFER(.FALSE.,K)
SELECT CASE(I)
CASE(TRANSFER(.TRUE.,K))
CALL ABORT()
CASE(TRANSFER(.FALSE.,K))
CASE DEFAULT
CALL ABORT()
END SELECT
END subroutine pr30881
subroutine pr31194 ()
!
! Contributed by Tobias Burnus <burnus@gcc.gnu.org>
!
real(kind(0d0)) :: NaN = transfer(ishft(int(z'FFF80000',8),32),0d0)
write (buffer,'(e12.5)') NaN
if (buffer(10:12) .ne. "NaN") call abort ()
end subroutine pr31194
subroutine pr31216 ()
!
! Contributed by Joost VandeVondele <jv244@cam.ac.uk>
!
INTEGER :: I
REAL :: C,D
buffer = " 1.0 3.0"
READ(buffer,*) C,D
I=TRANSFER(C/D,I)
SELECT CASE(I)
CASE (TRANSFER(1.0/3.0,1))
CASE DEFAULT
CALL ABORT()
END SELECT
END subroutine pr31216
subroutine pr31427 ()
!
! Contributed by Michael Richmond <michael.a.richmond@nasa.gov>
!
INTEGER(KIND=1) :: i(1)
i = (/ TRANSFER("a", 0_1) /)
if (i(1) .ne. ichar ("a")) call abort ()
END subroutine pr31427
end program simplify_transfer
|
