1! { dg-do run } 2! Test that the internal pack and unpack routines work OK 3! for different data types 4 5program main 6 integer(kind=1), dimension(3) :: i1 7 integer(kind=2), dimension(3) :: i2 8 integer(kind=4), dimension(3) :: i4 9 integer(kind=8), dimension(3) :: i8 10 real(kind=4), dimension(3) :: r4 11 real(kind=8), dimension(3) :: r8 12 complex(kind=4), dimension(3) :: c4 13 complex(kind=8), dimension(3) :: c8 14 type i8_t 15 sequence 16 integer(kind=8) :: v 17 end type i8_t 18 type(i8_t), dimension(3) :: d_i8 19 20 i1 = (/ -1, 1, -3 /) 21 call sub_i1(i1(1:3:2)) 22 if (any(i1 /= (/ 3, 1, 2 /))) call abort 23 24 i2 = (/ -1, 1, -3 /) 25 call sub_i2(i2(1:3:2)) 26 if (any(i2 /= (/ 3, 1, 2 /))) call abort 27 28 i4 = (/ -1, 1, -3 /) 29 call sub_i4(i4(1:3:2)) 30 if (any(i4 /= (/ 3, 1, 2 /))) call abort 31 32 i8 = (/ -1, 1, -3 /) 33 call sub_i8(i8(1:3:2)) 34 if (any(i8 /= (/ 3, 1, 2 /))) call abort 35 36 r4 = (/ -1.0, 1.0, -3.0 /) 37 call sub_r4(r4(1:3:2)) 38 if (any(r4 /= (/ 3.0, 1.0, 2.0/))) call abort 39 40 r8 = (/ -1.0_8, 1.0_8, -3.0_8 /) 41 call sub_r8(r8(1:3:2)) 42 if (any(r8 /= (/ 3.0_8, 1.0_8, 2.0_8/))) call abort 43 44 c4 = (/ (-1.0_4, 0._4), (1.0_4, 0._4), (-3.0_4, 0._4) /) 45 call sub_c4(c4(1:3:2)) 46 if (any(real(c4) /= (/ 3.0_4, 1.0_4, 2.0_4/))) call abort 47 if (any(aimag(c4) /= 0._4)) call abort 48 49 c8 = (/ (-1.0_4, 0._4), (1.0_4, 0._4), (-3.0_4, 0._4) /) 50 call sub_c8(c8(1:3:2)) 51 if (any(real(c8) /= (/ 3.0_4, 1.0_4, 2.0_4/))) call abort 52 if (any(aimag(c8) /= 0._4)) call abort 53 54 d_i8%v = (/ -1, 1, -3 /) 55 call sub_d_i8(d_i8(1:3:2)) 56 if (any(d_i8%v /= (/ 3, 1, 2 /))) call abort 57 58end program main 59 60subroutine sub_i1(i) 61 integer(kind=1), dimension(2) :: i 62 if (i(1) /= -1) call abort 63 if (i(2) /= -3) call abort 64 i(1) = 3 65 i(2) = 2 66end subroutine sub_i1 67 68subroutine sub_i2(i) 69 integer(kind=2), dimension(2) :: i 70 if (i(1) /= -1) call abort 71 if (i(2) /= -3) call abort 72 i(1) = 3 73 i(2) = 2 74end subroutine sub_i2 75 76subroutine sub_i4(i) 77 integer(kind=4), dimension(2) :: i 78 if (i(1) /= -1) call abort 79 if (i(2) /= -3) call abort 80 i(1) = 3 81 i(2) = 2 82end subroutine sub_i4 83 84subroutine sub_i8(i) 85 integer(kind=8), dimension(2) :: i 86 if (i(1) /= -1) call abort 87 if (i(2) /= -3) call abort 88 i(1) = 3 89 i(2) = 2 90end subroutine sub_i8 91 92subroutine sub_r4(r) 93 real(kind=4), dimension(2) :: r 94 if (r(1) /= -1.) call abort 95 if (r(2) /= -3.) call abort 96 r(1) = 3. 97 r(2) = 2. 98end subroutine sub_r4 99 100subroutine sub_r8(r) 101 real(kind=8), dimension(2) :: r 102 if (r(1) /= -1._8) call abort 103 if (r(2) /= -3._8) call abort 104 r(1) = 3._8 105 r(2) = 2._8 106end subroutine sub_r8 107 108subroutine sub_c8(r) 109 implicit none 110 complex(kind=8), dimension(2) :: r 111 if (r(1) /= (-1._8,0._8)) call abort 112 if (r(2) /= (-3._8,0._8)) call abort 113 r(1) = 3._8 114 r(2) = 2._8 115end subroutine sub_c8 116 117subroutine sub_c4(r) 118 implicit none 119 complex(kind=4), dimension(2) :: r 120 if (r(1) /= (-1._4,0._4)) call abort 121 if (r(2) /= (-3._4,0._4)) call abort 122 r(1) = 3._4 123 r(2) = 2._4 124end subroutine sub_c4 125 126subroutine sub_d_i8(i) 127 type i8_t 128 sequence 129 integer(kind=8) :: v 130 end type i8_t 131 type(i8_t), dimension(2) :: i 132 if (i(1)%v /= -1) call abort 133 if (i(2)%v /= -3) call abort 134 i(1)%v = 3 135 i(2)%v = 2 136end subroutine sub_d_i8 137