URL
https://opencores.org/ocsvn/openrisc_2011-10-31/openrisc_2011-10-31/trunk
Subversion Repositories openrisc_2011-10-31
[/] [openrisc/] [trunk/] [gnu-src/] [gcc-4.2.2/] [gcc/] [testsuite/] [gfortran.dg/] [char_cshift_1.f90] - Rev 165
Go to most recent revision | Compare with Previous | Blame | View Log
! 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
Go to most recent revision | Compare with Previous | Blame | View Log