1314879Simp! Test reshape for character arrays.
2314879Simp! { dg-do run }
3314879Simpprogram main
4314879Simp  implicit none
5314879Simp  integer, parameter :: n = 20, slen = 9
6314879Simp  character (len = slen), dimension (n) :: a, pad
7314879Simp  integer, dimension (3) :: shape, order
8314879Simp  integer :: i
9314879Simp
10314879Simp  do i = 1, n
11314879Simp    a (i) = 'abcdefghijklmnopqrstuvwxyz'(i:i+6)
12314879Simp    pad (i) = 'ABCDEFGHIJKLMNOPQRSTUVWXYZ'(i:i+6)
13314879Simp  end do
14314879Simp
15314879Simp  shape = (/ 4, 6, 5 /)
16314879Simp  order = (/ 3, 1, 2 /)
17314879Simp  call test (reshape (a, shape, pad, order))
18314879Simpcontains
19314879Simp  subroutine test (b)
20314879Simp    character (len = slen), dimension (:, :, :) :: b
21314879Simp    integer :: i1, i2, i3, ai, padi
22314879Simp
23314879Simp    do i = 1, 3
24314879Simp      if (size (b, i) .ne. shape (i)) call abort
25314879Simp    end do
26314879Simp    ai = 0
27314879Simp    padi = 0
28314879Simp    do i2 = 1, shape (2)
29314879Simp      do i1 = 1, shape (1)
30314879Simp        do i3 = 1, shape (3)
31314879Simp          if (ai .lt. n) then
32314879Simp            ai = ai + 1
33314879Simp            if (b (i1, i2, i3) .ne. a (ai)) call abort
34314879Simp          else
35314879Simp            padi = padi + 1
36314879Simp            if (padi .gt. n) padi = 1
37314879Simp            if (b (i1, i2, i3) .ne. pad (padi)) call abort
38314879Simp          end if
39314879Simp        end do
40314879Simp      end do
41314879Simp    end do
42314879Simp  end subroutine test
43314879Simpend program main
44314879Simp