diff options
author | upstream source tree <ports@midipix.org> | 2015-03-15 20:14:05 -0400 |
---|---|---|
committer | upstream source tree <ports@midipix.org> | 2015-03-15 20:14:05 -0400 |
commit | 554fd8c5195424bdbcabf5de30fdc183aba391bd (patch) | |
tree | 976dc5ab7fddf506dadce60ae936f43f58787092 /gcc/testsuite/gfortran.dg/char_pack_2.f90 | |
download | cbb-gcc-4.6.4-554fd8c5195424bdbcabf5de30fdc183aba391bd.tar.bz2 cbb-gcc-4.6.4-554fd8c5195424bdbcabf5de30fdc183aba391bd.tar.xz |
obtained gcc-4.6.4.tar.bz2 from upstream website;upstream
verified gcc-4.6.4.tar.bz2.sig;
imported gcc-4.6.4 source tree from verified upstream tarball.
downloading a git-generated archive based on the 'upstream' tag
should provide you with a source tree that is binary identical
to the one extracted from the above tarball.
if you have obtained the source via the command 'git clone',
however, do note that line-endings of files in your working
directory might differ from line-endings of the respective
files in the upstream repository.
Diffstat (limited to 'gcc/testsuite/gfortran.dg/char_pack_2.f90')
-rw-r--r-- | gcc/testsuite/gfortran.dg/char_pack_2.f90 | 53 |
1 files changed, 53 insertions, 0 deletions
diff --git a/gcc/testsuite/gfortran.dg/char_pack_2.f90 b/gcc/testsuite/gfortran.dg/char_pack_2.f90 new file mode 100644 index 000000000..4bf165b29 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/char_pack_2.f90 @@ -0,0 +1,53 @@ +! Test scalar pack for character arrays. +! { dg-do run } +program main + implicit none + integer, parameter :: n1 = 3, n2 = 4, nv = 16, slen = 9 + character (len = slen), dimension (n1, n2) :: a + character (len = slen), dimension (nv) :: vector + logical :: mask + integer :: i1, i2, i + + do i2 = 1, n2 + do i1 = 1, n1 + a (i1, i2) = 'abc'(i1:i1) // 'defg'(i2:i2) // 'cantrip' + end do + end do + + do i = 1, nv + vector (i) = 'crespo' // '0123456789abcdef'(i:i) + end do + + mask = .true. + call test1 (pack (a, mask)) + call test2 (pack (a, mask, vector)) +contains + subroutine test1 (b) + character (len = slen), dimension (:) :: b + + i = 0 + do i2 = 1, n2 + do i1 = 1, n1 + i = i + 1 + if (b (i) .ne. a (i1, i2)) call abort + end do + end do + if (size (b, 1) .ne. i) call abort + end subroutine test1 + + subroutine test2 (b) + character (len = slen), dimension (:) :: b + + if (size (b, 1) .ne. nv) call abort + i = 0 + do i2 = 1, n2 + do i1 = 1, n1 + i = i + 1 + if (b (i) .ne. a (i1, i2)) call abort + end do + end do + do i = i + 1, nv + if (b (i) .ne. vector (i)) call abort + end do + end subroutine test2 +end program main |