gcc/testsuite/gfortran.dg/char_transpose_1.f90

   1 ! Test transpose for character arrays.
   2 ! { dg-do run }
   3 program main
   4   implicit none
   5   integer, parameter :: n1 = 3, n2 = 4, slen = 9
   6   character (len = slen), dimension (n1, n2) :: a
   7   integer :: i1, i2
   8
   9   do i2 = 1, n2
  10     do i1 = 1, n1
  11       a (i1, i2) = 'abc'(i1:i1) // 'defg'(i2:i2) // 'cantrip'
  12     end do
  13   end do
  14
  15   call test (transpose (a))
  16 contains
  17   subroutine test (b)
  18     character (len = slen), dimension (:, :) :: b
  19
  20     if (size (b, 1) .ne. n2) call abort
  21     if (size (b, 2) .ne. n1) call abort
  22
  23     do i2 = 1, n2
  24       do i1 = 1, n1
  25         if (b (i2, i1) .ne. a (i1, i2)) call abort
  26       end do
  27     end do
  28   end subroutine test
  29 end program main