3 ! { dg-options "-O2 -mieee" { target alpha*-*-* } }
4 ! Tests the fix for the meta-bug PR31237 (TRANSFER intrinsic)
5 ! Exercises gfc_simplify_transfer a random walk through types and shapes
6 ! and compares its results with the middle-end version that operates on
10 call integer4_to_real4
11 call real4_to_integer8
12 call integer4_to_integer8
13 call logical4_to_real8
14 call real8_to_integer4
15 call integer8_to_real4
16 call integer8_to_complex4
17 call character16_to_complex8
18 call character16_to_real8
19 call real8_to_character2
21 call character16_to_dt
23 subroutine integer4_to_real4
24 integer(4), parameter :: i1 = 11111_4
26 real(4), parameter :: r1 = transfer (i1, 1.0_4)
29 r2 = transfer (i2, r2);
30 if (r1 .ne. r2) call abort ()
31 end subroutine integer4_to_real4
33 subroutine real4_to_integer8
34 real(4), parameter :: r1(2) = (/3.14159_4, 0.0_4/)
36 integer(8), parameter :: i1 = transfer (r1, 1_8)
39 i2 = transfer (r2, 1_8);
40 if (i1 .ne. i2) call abort ()
41 end subroutine real4_to_integer8
43 subroutine integer4_to_integer8
44 integer(4), parameter :: i1(2) = (/11111_4, 22222_4/)
45 integer(4) :: i2(2) = i1
46 integer(8), parameter :: i3 = transfer (i1, 1_8)
49 i4 = transfer (i2, 1_8);
50 if (i3 .ne. i4) call abort ()
51 end subroutine integer4_to_integer8
53 subroutine logical4_to_real8
54 logical(4), parameter :: l1(2) = (/.false., .true./)
55 logical(4) :: l2(2) = l1
56 real(8), parameter :: r1 = transfer (l1, 1_8)
59 r2 = transfer (l2, 1_8);
60 if (r1 .ne. r2) call abort ()
61 end subroutine logical4_to_real8
63 subroutine real8_to_integer4
64 real(8), parameter :: r1 = 3.14159_8
66 integer(4), parameter :: i1(2) = transfer (r1, 1_4, 2)
69 i2 = transfer (r2, i2, 2);
70 if (any (i1 .ne. i2)) call abort ()
71 end subroutine real8_to_integer4
73 subroutine integer8_to_real4
75 integer(8), parameter :: i1(2) = transfer ((/asin (1.0_8), log (1.0_8)/), 0_8)
76 integer(8) :: i2(2) = i1
77 real(4), parameter :: r1(4) = transfer (i1, (/(1.0_4,k=1,4)/))
80 r2 = transfer (i2, r2);
81 if (any (r1 .ne. r2)) call abort ()
82 end subroutine integer8_to_real4
84 subroutine integer8_to_complex4
86 integer(8), parameter :: i1(2) = transfer ((/asin (1.0_8), log (1.0_8)/), 0_8)
87 integer(8) :: i2(2) = i1
88 complex(4), parameter :: z1(2) = transfer (i1, (/((1.0_4,2.0_4),k=1,2)/))
91 z2 = transfer (i2, z2);
92 if (any (z1 .ne. z2)) call abort ()
93 end subroutine integer8_to_complex4
95 subroutine character16_to_complex8
96 character(16), parameter :: c1(2) = (/"abcdefghijklmnop","qrstuvwxyz123456"/)
97 character(16) :: c2(2) = c1
98 complex(8), parameter :: z1(2) = transfer (c1, (1.0_8,1.0_8), 2)
101 z2 = transfer (c2, z2, 2);
102 if (any (z1 .ne. z2)) call abort ()
103 end subroutine character16_to_complex8
105 subroutine character16_to_real8
106 character(16), parameter :: c1 = "abcdefghijklmnop"
107 character(16) :: c2 = c1
108 real(8), parameter :: r1(2) = transfer (c1, 1.0_8, 2)
111 r2 = transfer (c2, r2, 2);
112 if (any (r1 .ne. r2)) call abort ()
113 end subroutine character16_to_real8
115 subroutine real8_to_character2
116 real(8), parameter :: r1 = 3.14159_8
118 character(2), parameter :: c1(4) = transfer (r1, "ab", 4)
119 character(2) :: c2(4)
121 c2 = transfer (r2, "ab", 4);
122 if (any (c1 .ne. c2)) call abort ()
123 end subroutine real8_to_character2
125 subroutine dt_to_integer1
126 integer, parameter :: i1(4) = (/1_4,2_4,3_4,4_4/)
127 real, parameter :: r1(4) = (/1.0_4,2.0_4,3.0_4,4.0_4/)
132 type (mytype), parameter :: dt1 = mytype (i1, r1)
133 type (mytype) :: dt2 = dt1
134 integer(1), parameter :: i2(32) = transfer (dt1, 1_1, 32)
137 i3 = transfer (dt2, 1_1, 32);
138 if (any (i2 .ne. i3)) call abort ()
139 end subroutine dt_to_integer1
141 subroutine character16_to_dt
142 character(16), parameter :: c1 = "abcdefghijklmnop"
143 character(16) :: c2 = c1
148 type (mytype), parameter :: dt1(2) = transfer (c1, mytype ((/1.0,2.0,3.0,4.0/)), 2)
149 type (mytype) :: dt2(2)
151 dt2 = transfer (c2, dt2);
152 if (any (dt1(1)%x .ne. dt2(1)%x)) call abort ()
153 if (any (dt1(2)%x .ne. dt2(2)%x)) call abort ()
154 end subroutine character16_to_dt