1! { dg-do run } 2! { dg-options "-fbackslash" } 3 4 implicit none 5 integer :: i, j 6 character(kind=4,len=5), dimension(3,3), parameter :: & 7 p = reshape([4_" \xFF ", 4_"\0 ", 4_" foo ", & 8 4_"\u1230\uD67Bde\U31DC8B30", 4_" ", 4_"fa fe", & 9 4_" ", 4_"foo ", 4_"nul\0l"], [3,3]) 10 11 character(kind=4,len=5), dimension(3,3) :: m1 12 character(kind=4,len=5), allocatable, dimension(:,:) :: m2 13 14 if (kind (p) /= 4) call abort 15 if (kind (m1) /= 4) call abort 16 if (kind (m2) /= 4) call abort 17 18 m1 = reshape (p, [3,3]) 19 20 allocate (m2(3,3)) 21 m2(:,:) = reshape (m1, [3,3]) 22 23 if (any (m1 /= p)) call abort 24 if (any (m2 /= p)) call abort 25 26 if (size (p) /= 9) call abort 27 if (size (m1) /= 9) call abort 28 if (size (m2) /= 9) call abort 29 if (size (p,1) /= 3) call abort 30 if (size (m1,1) /= 3) call abort 31 if (size (m2,1) /= 3) call abort 32 if (size (p,2) /= 3) call abort 33 if (size (m1,2) /= 3) call abort 34 if (size (m2,2) /= 3) call abort 35 36 call check_shape (p, (/3,3/), 5) 37 call check_shape (p, shape(p), 5) 38 call check_shape (m1, (/3,3/), 5) 39 call check_shape (m1, shape(m1), 5) 40 call check_shape (m1, (/3,3/), 5) 41 call check_shape (m1, shape(m1), 5) 42 43 deallocate (m2) 44 45 46 allocate (m2(3,4)) 47 m2 = reshape (m1, [3,4], p) 48 if (any (m2(1:3,1:3) /= p)) call abort 49 if (any (m2(1:3,4) /= m1(1:3,1))) call abort 50 call check_shape (m2, (/3,4/), 5) 51 deallocate (m2) 52 53 allocate (m2(3,3)) 54 do i = 1, 3 55 do j = 1, 3 56 m2(i,j) = m1(i,j) 57 end do 58 end do 59 60 m2 = transpose(m2) 61 if (any(transpose(p) /= m2)) call abort 62 if (any(transpose(m1) /= m2)) call abort 63 if (any(transpose(m2) /= p)) call abort 64 if (any(transpose(m2) /= m1)) call abort 65 66 m1 = transpose(p) 67 if (any(transpose(p) /= m2)) call abort 68 if (any(m1 /= m2)) call abort 69 if (any(transpose(m2) /= p)) call abort 70 if (any(transpose(m2) /= transpose(m1))) call abort 71 deallocate (m2) 72 73 allocate (m2(3,3)) 74 m2 = p 75 m1 = m2 76 if (any (spread ( p, 1, 2) /= spread (m1, 1, 2))) call abort 77 if (any (spread ( p, 1, 2) /= spread (m2, 1, 2))) call abort 78 if (any (spread (m1, 1, 2) /= spread (m2, 1, 2))) call abort 79 deallocate (m2) 80 81 allocate (m2(3,3)) 82 m2 = p 83 m1 = m2 84 if (any (pack (p, p /= 4_"") /= [4_" \xFF ", 4_"\0 ", 4_" foo ", & 85 4_"\u1230\uD67Bde\U31DC8B30", 4_"fa fe", & 86 4_"foo ", 4_"nul\0l"])) call abort 87 if (any (len_trim (pack (p, p /= 4_"")) /= [2,1,4,5,5,3,5])) call abort 88 if (any (pack (m1, m1 /= 4_"") /= [4_" \xFF ", 4_"\0 ", 4_" foo ", & 89 4_"\u1230\uD67Bde\U31DC8B30", 4_"fa fe", & 90 4_"foo ", 4_"nul\0l"])) call abort 91 if (any (len_trim (pack (m1, m1 /= 4_"")) /= [2,1,4,5,5,3,5])) call abort 92 if (any (pack (m2, m2 /= 4_"") /= [4_" \xFF ", 4_"\0 ", 4_" foo ", & 93 4_"\u1230\uD67Bde\U31DC8B30", 4_"fa fe", & 94 4_"foo ", 4_"nul\0l"])) call abort 95 if (any (len_trim (pack (m2, m2 /= 4_"")) /= [2,1,4,5,5,3,5])) call abort 96 deallocate (m2) 97 98 allocate (m2(1,7)) 99 m2 = reshape ([4_" \xFF ", 4_"\0 ", 4_" foo ", & 100 4_"\u1230\uD67Bde\U31DC8B30", 4_"fa fe", & 101 4_"foo ", 4_"nul\0l"], [1,7]) 102 m1 = p 103 if (any (unpack(m2(1,:), p /= 4_"", 4_" ") /= p)) call abort 104 if (any (unpack(m2(1,:), m1 /= 4_"", 4_" ") /= m1)) call abort 105 deallocate (m2) 106 107contains 108 109 subroutine check_shape (array, res, l) 110 character(kind=4,len=*), dimension(:,:) :: array 111 integer, dimension(:) :: res 112 integer :: l 113 114 if (kind (array) /= 4) call abort 115 if (len(array) /= l) call abort 116 117 if (size (res) /= size (shape (array))) call abort 118 if (any (shape (array) /= res)) call abort 119 end subroutine check_shape 120 121end 122