1! { dg-do run } 2! { dg-options "-O2" } 3! { dg-add-options ieee } 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 7! variables. 8! 9 implicit none 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 20 call dt_to_integer1 21 call character16_to_dt 22contains 23 subroutine integer4_to_real4 24 integer(4), parameter :: i1 = 11111_4 25 integer(4) :: i2 = i1 26 real(4), parameter :: r1 = transfer (i1, 1.0_4) 27 real(4) :: r2 28 29 r2 = transfer (i2, r2); 30 if (r1 .ne. r2) call abort () 31 end subroutine integer4_to_real4 32 33 subroutine real4_to_integer8 34 real(4), parameter :: r1(2) = (/3.14159_4, 0.0_4/) 35 real(4) :: r2(2) = r1 36 integer(8), parameter :: i1 = transfer (r1, 1_8) 37 integer(8) :: i2 38 39 i2 = transfer (r2, 1_8); 40 if (i1 .ne. i2) call abort () 41 end subroutine real4_to_integer8 42 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) 47 integer(8) :: i4 48 49 i4 = transfer (i2, 1_8); 50 if (i3 .ne. i4) call abort () 51 end subroutine integer4_to_integer8 52 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) 57 real(8) :: r2 58 59 r2 = transfer (l2, 1_8); 60 if (r1 .ne. r2) call abort () 61 end subroutine logical4_to_real8 62 63 subroutine real8_to_integer4 64 real(8), parameter :: r1 = 3.14159_8 65 real(8) :: r2 = r1 66 integer(4), parameter :: i1(2) = transfer (r1, 1_4, 2) 67 integer(4) :: i2(2) 68 69 i2 = transfer (r2, i2, 2); 70 if (any (i1 .ne. i2)) call abort () 71 end subroutine real8_to_integer4 72 73 subroutine integer8_to_real4 74 integer :: k 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)/)) 78 real(4) :: r2(4) 79 80 r2 = transfer (i2, r2); 81 if (any (r1 .ne. r2)) call abort () 82 end subroutine integer8_to_real4 83 84 subroutine integer8_to_complex4 85 integer :: k 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)/)) 89 complex(4) :: z2(2) 90 91 z2 = transfer (i2, z2); 92 if (any (z1 .ne. z2)) call abort () 93 end subroutine integer8_to_complex4 94 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) 99 complex(8) :: z2(2) 100 101 z2 = transfer (c2, z2, 2); 102 if (any (z1 .ne. z2)) call abort () 103 end subroutine character16_to_complex8 104 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) 109 real(8) :: r2(2) 110 111 r2 = transfer (c2, r2, 2); 112 if (any (r1 .ne. r2)) call abort () 113 end subroutine character16_to_real8 114 115 subroutine real8_to_character2 116 real(8), parameter :: r1 = 3.14159_8 117 real(8) :: r2 = r1 118 character(2), parameter :: c1(4) = transfer (r1, "ab", 4) 119 character(2) :: c2(4) 120 121 c2 = transfer (r2, "ab", 4); 122 if (any (c1 .ne. c2)) call abort () 123 end subroutine real8_to_character2 124 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/) 128 type :: mytype 129 integer(4) :: i(4) 130 real(4) :: x(4) 131 end type mytype 132 type (mytype), parameter :: dt1 = mytype (i1, r1) 133 type (mytype) :: dt2 = dt1 134 integer(1), parameter :: i2(32) = transfer (dt1, 1_1, 32) 135 integer(1) :: i3(32) 136 137 i3 = transfer (dt2, 1_1, 32); 138 if (any (i2 .ne. i3)) call abort () 139 end subroutine dt_to_integer1 140 141 subroutine character16_to_dt 142 character(16), parameter :: c1 = "abcdefghijklmnop" 143 character(16) :: c2 = c1 144 type :: mytype 145 real(4) :: x(2) 146 end type mytype 147 148 type (mytype), parameter :: dt1(2) = transfer (c1, mytype ((/1.0,2.0,3.0,4.0/)), 2) 149 type (mytype) :: dt2(2) 150 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 155 156end 157