gcc/testsuite/gfortran.dg/char_reshape_1.f90

   1 ! Test reshape for character arrays.
   2 ! { dg-do run }
   3 program main
   4   implicit none
   5   integer, parameter :: n = 20, slen = 9
   6   character (len = slen), dimension (n) :: a, pad
   7   integer, dimension (3) :: shape, order
   8   integer :: i
   9
  10   do i = 1, n
  11     a (i) = 'abcdefghijklmnopqrstuvwxyz'(i:i+6)
  12     pad (i) = 'ABCDEFGHIJKLMNOPQRSTUVWXYZ'(i:i+6)
  13   end do
  14
  15   shape = (/ 4, 6, 5 /)
  16   order = (/ 3, 1, 2 /)
  17   call test (reshape (a, shape, pad, order))
  18 contains
  19   subroutine test (b)
  20     character (len = slen), dimension (:, :, :) :: b
  21     integer :: i1, i2, i3, ai, padi
  22
  23     do i = 1, 3
  24       if (size (b, i) .ne. shape (i)) call abort
  25     end do
  26     ai = 0
  27     padi = 0
  28     do i2 = 1, shape (2)
  29       do i1 = 1, shape (1)
  30         do i3 = 1, shape (3)
  31           if (ai .lt. n) then
  32             ai = ai + 1
  33             if (b (i1, i2, i3) .ne. a (ai)) call abort
  34           else
  35             padi = padi + 1
  36             if (padi .gt. n) padi = 1
  37             if (b (i1, i2, i3) .ne. pad (padi)) call abort
  38           end if
  39         end do
  40       end do
  41     end do
  42   end subroutine test
  43 end program main