gcc/testsuite/gfortran.dg/char_spread_1.f90

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