Mercurial > hg > CbC > CbC_gcc
view gcc/testsuite/gfortran.dg/char_cshift_1.f90 @ 118:fd00160c1b76
ifdef TARGET_64BIT
author | mir3636 |
---|---|
date | Tue, 27 Feb 2018 15:01:35 +0900 |
parents | 04ced10e8804 |
children | 84e7813d76e9 |
line wrap: on
line source
! Test cshift0 for character arrays. ! { dg-do run } program main implicit none integer, parameter :: n1 = 2, n2 = 3, n3 = 4, slen = 3 character (len = slen), dimension (n1, n2, n3) :: a integer (kind = 1) :: shift1 = 3 integer (kind = 2) :: shift2 = 4 integer (kind = 4) :: shift3 = 5 integer (kind = 8) :: shift4 = 6 integer :: i1, i2, i3 do i3 = 1, n3 do i2 = 1, n2 do i1 = 1, n1 a (i1, i2, i3) = 'ab'(i1:i1) // 'cde'(i2:i2) // 'fghi'(i3:i3) end do end do end do call test (cshift (a, shift1, 1), int (shift1), 0, 0) call test (cshift (a, shift2, 2), 0, int (shift2), 0) call test (cshift (a, shift3, 3), 0, 0, int (shift3)) call test (cshift (a, shift4, 3), 0, 0, int (shift4)) contains subroutine test (b, d1, d2, d3) character (len = slen), dimension (n1, n2, n3) :: b integer :: d1, d2, d3 do i3 = 1, n3 do i2 = 1, n2 do i1 = 1, n1 if (b (i1, i2, i3) .ne. a (mod (d1 + i1 - 1, n1) + 1, & mod (d2 + i2 - 1, n2) + 1, & mod (d3 + i3 - 1, n3) + 1)) call abort end do end do end do end subroutine test end program main