diff options
author | rsandifo <rsandifo@138bc75d-0d04-0410-961f-82ee72b054a4> | 2005-09-13 07:15:01 +0000 |
---|---|---|
committer | rsandifo <rsandifo@138bc75d-0d04-0410-961f-82ee72b054a4> | 2005-09-13 07:15:01 +0000 |
commit | 1a9a4a126f54e720677aa16a5c258f1251a24133 (patch) | |
tree | 56a0679488a10ec480d232cfb645992a26c55566 /gcc/testsuite | |
parent | 2c718da05a746b8932e4dc84fa70ab7cd535bde2 (diff) | |
download | gcc-1a9a4a126f54e720677aa16a5c258f1251a24133.tar.gz |
gcc/fortran/
PR target/19269
* iresolve.c (gfc_resolve_cshift, gfc_resolve_eoshift)
(gfc_resolve_pack, gfc_resolve_reshape, gfc_resolve_spread)
(gfc_resolve_transpose, gfc_resolve_unpack): Add "_char" to the name
for character-based operations.
(gfc_resolve_pack): Remove ATTRIBUTE_UNUSED from array argument.
(gfc_resolve_unpack): Copy the whole typespec from the vector.
* trans-array.c (gfc_conv_expr_descriptor): In the EXPR_FUNCTION
case, get the string length from the scalarization state.
libgfortran/
PR target/19269
* intrinsics/cshift0.c (cshift0): Add an extra size argument.
(cshift0_1, cshift0_2, cshift0_4, cshift0_8): Replace explicit
implementations with...
(DEFINE_CSHIFT): ...this new macro. Define character versions too.
* intrinsics/eoshift0.c (zeros): Delete.
(eoshift0): Add extra size and filler arguments. Use memset if no
bound is provided.
(eoshift0_1, eoshift0_2, eoshift0_4, eoshift0_8): Replace explicit
implementations with...
(DEFINE_EOSHIFT): ...this new macro. Define character versions too.
* intrinsics/eoshift2.c (zeros): Delete.
(eoshift2): Add extra size and filler arguments. Use memset if no
bound is provided.
(eoshift2_1, eoshift2_2, eoshift2_4, eoshift2_8): Replace explicit
implementations with...
(DEFINE_EOSHIFT): ...this new macro. Define character versions too.
* intrinsics/pack.c (pack_internal): New static function, reusing
the contents of pack and adding an extra size argument. Change
"mptr" rather than "m" when calculating the array size.
(pack): Redefine as a forwarder to pack_internal.
(pack_s_internal): New static function, reusing the contents of
pack_s and adding an extra size argument.
(pack_s): Redefine as a forwarder to pack_s_internal.
(pack_char, pack_s_char): New functions.
* intrinsics/reshape.c (reshape_internal): New static function,
reusing the contents of reshape and adding an extra size argument.
(reshape): Redefine as a forwarder to reshape_internal.
(reshape_char): New function.
* intrinsics/spread.c (spread_internal): New static function,
reusing the contents of spread and adding an extra size argument.
(spread): Redefine as a forwarder to spread_internal.
(spread_char): New function.
* intrinsics/transpose.c (transpose_internal): New static function,
reusing the contents of transpose and adding an extra size argument.
(transpose): Redefine as a forwarder to transpose_internal.
(transpose_char): New function.
* intrinsics/unpack.c (unpack_internal): New static function, reusing
the contents of unpack1 and adding extra size and fsize arguments.
(unpack1): Redefine as a forwarder to unpack_internal.
(unpack0): Call unpack_internal instead of unpack1.
(unpack1_char, unpack0_char): New functions.
* m4/cshift1.m4 (cshift1): New static function, reusing the contents
of cshift1_<kind> and adding an extra size argument.
(cshift1_<kind>): Redefine as a forwarder to cshift1.
(cshift1_<kind>_char): New function.
* m4/eoshift1.m4 (zeros): Delete.
(eoshift1): New static function, reusing the contents of
eoshift1_<kind> and adding extra size and filler arguments.
Fix calculation of hstride. Use memset if no bound is provided.
(eoshift1_<kind>): Redefine as a forwarder to eoshift1.
(eoshift1_<kind>_char): New function.
* m4/eoshift3.m4 (zeros): Delete.
(eoshift3): New static function, reusing the contents of
eoshift3_<kind> and adding extra size and filler arguments.
Use memset if no bound is provided.
(eoshift3_<kind>): Redefine as a forwarder to eoshift3.
(eoshift3_<kind>_char): New function.
* generated/cshift1_4.c, generated/cshift1_8.c,
* generated/eoshift1_4.c, generated/eoshift1_8.c,
* generated/eoshift3_4.c, generated/eoshift3_8.c: Regenerate.
git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@104217 138bc75d-0d04-0410-961f-82ee72b054a4
Diffstat (limited to 'gcc/testsuite')
-rw-r--r-- | gcc/testsuite/ChangeLog | 12 | ||||
-rw-r--r-- | gcc/testsuite/gfortran.dg/char_associated_1.f90 | 8 | ||||
-rw-r--r-- | gcc/testsuite/gfortran.dg/char_cshift_1.f90 | 40 | ||||
-rw-r--r-- | gcc/testsuite/gfortran.dg/char_cshift_2.f90 | 45 | ||||
-rw-r--r-- | gcc/testsuite/gfortran.dg/char_eoshift_1.f90 | 50 | ||||
-rw-r--r-- | gcc/testsuite/gfortran.dg/char_eoshift_2.f90 | 57 | ||||
-rw-r--r-- | gcc/testsuite/gfortran.dg/char_eoshift_3.f90 | 54 | ||||
-rw-r--r-- | gcc/testsuite/gfortran.dg/char_eoshift_4.f90 | 61 | ||||
-rw-r--r-- | gcc/testsuite/gfortran.dg/char_pack_1.f90 | 59 | ||||
-rw-r--r-- | gcc/testsuite/gfortran.dg/char_pack_2.f90 | 53 | ||||
-rw-r--r-- | gcc/testsuite/gfortran.dg/char_reshape_1.f90 | 43 | ||||
-rw-r--r-- | gcc/testsuite/gfortran.dg/char_spread_1.f90 | 32 | ||||
-rw-r--r-- | gcc/testsuite/gfortran.dg/char_transpose_1.f90 | 29 | ||||
-rw-r--r-- | gcc/testsuite/gfortran.dg/char_unpack_1.f90 | 44 | ||||
-rw-r--r-- | gcc/testsuite/gfortran.dg/char_unpack_2.f90 | 40 |
15 files changed, 627 insertions, 0 deletions
diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog index 26919da7139..a909f302345 100644 --- a/gcc/testsuite/ChangeLog +++ b/gcc/testsuite/ChangeLog @@ -1,3 +1,15 @@ +2005-09-13 Richard Sandiford <richard@codesourcery.com> + + PR target/19269 + * gfortran.dg/char_associated_1.f90, gfortran.dg/char_cshift_1.f90, + * gfortran.dg/char_cshift_2.f90, gfortran.dg/char_eoshift_1.f90, + * gfortran.dg/char_eoshift_2.f90, gfortran.dg/char_eoshift_3.f90, + * gfortran.dg/char_eoshift_4.f90, gfortran.dg/char_pack_1.f90, + * gfortran.dg/char_pack_2.f90, gfortran.dg/char_reshape_1.f90, + * gfortran.dg/char_spread_1.f90, gfortran.dg/char_transpoe_1.f90, + * gfortran.dg/char_unpack_1.f90, gfortran.dg/char_unpack_2.f90: New + tests. + 2005-09-12 Mark Mitchell <mark@codesourcery.com> PR c++/23841 diff --git a/gcc/testsuite/gfortran.dg/char_associated_1.f90 b/gcc/testsuite/gfortran.dg/char_associated_1.f90 new file mode 100644 index 00000000000..f38f27331da --- /dev/null +++ b/gcc/testsuite/gfortran.dg/char_associated_1.f90 @@ -0,0 +1,8 @@ +! Check that associated works correctly for character arrays. +! { dg-do run } +program main + character (len = 5), dimension (:), pointer :: ptr + character (len = 5), dimension (2), target :: a = (/ 'abcde', 'fghij' /) + ptr => a + if (.not. associated (ptr, a)) call abort +end program main diff --git a/gcc/testsuite/gfortran.dg/char_cshift_1.f90 b/gcc/testsuite/gfortran.dg/char_cshift_1.f90 new file mode 100644 index 00000000000..7ba61e7095b --- /dev/null +++ b/gcc/testsuite/gfortran.dg/char_cshift_1.f90 @@ -0,0 +1,40 @@ +! 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 diff --git a/gcc/testsuite/gfortran.dg/char_cshift_2.f90 b/gcc/testsuite/gfortran.dg/char_cshift_2.f90 new file mode 100644 index 00000000000..89d452f713e --- /dev/null +++ b/gcc/testsuite/gfortran.dg/char_cshift_2.f90 @@ -0,0 +1,45 @@ +! Test cshift1 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), dimension (2, 4) :: shift1 + integer (kind = 2), dimension (2, 4) :: shift2 + integer (kind = 4), dimension (2, 4) :: shift3 + integer (kind = 8), dimension (2, 4) :: shift4 + 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 + + shift1 (1, :) = (/ 4, 11, 19, 20 /) + shift1 (2, :) = (/ 55, 5, 1, 2 /) + shift2 = shift1 + shift3 = shift1 + shift4 = shift1 + + call test (cshift (a, shift1, 2)) + call test (cshift (a, shift2, 2)) + call test (cshift (a, shift3, 2)) + call test (cshift (a, shift4, 2)) +contains + subroutine test (b) + character (len = slen), dimension (n1, n2, n3) :: b + integer :: i2p + + do i3 = 1, n3 + do i2 = 1, n2 + do i1 = 1, n1 + i2p = mod (shift1 (i1, i3) + i2 - 1, n2) + 1 + if (b (i1, i2, i3) .ne. a (i1, i2p, i3)) call abort + end do + end do + end do + end subroutine test +end program main diff --git a/gcc/testsuite/gfortran.dg/char_eoshift_1.f90 b/gcc/testsuite/gfortran.dg/char_eoshift_1.f90 new file mode 100644 index 00000000000..ba51fa13193 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/char_eoshift_1.f90 @@ -0,0 +1,50 @@ +! Test eoshift0 for character arrays. +! { dg-do run } +program main + implicit none + integer, parameter :: n1 = 6, n2 = 5, n3 = 4, slen = 3 + character (len = slen), dimension (n1, n2, n3) :: a + character (len = slen) :: filler + integer (kind = 1) :: shift1 = 4 + integer (kind = 2) :: shift2 = 2 + integer (kind = 4) :: shift3 = 3 + integer (kind = 8) :: shift4 = 1 + integer :: i1, i2, i3 + + do i3 = 1, n3 + do i2 = 1, n2 + do i1 = 1, n1 + a (i1, i2, i3) = 'abcdef'(i1:i1) // 'ghijk'(i2:i2) // 'lmno'(i3:i3) + end do + end do + end do + + call test (eoshift (a, shift1, 'foo', 1), int (shift1), 0, 0, 'foo') + call test (eoshift (a, shift2, 'foo', 2), 0, int (shift2), 0, 'foo') + call test (eoshift (a, shift3, 'foo', 2), 0, int (shift3), 0, 'foo') + call test (eoshift (a, shift4, 'foo', 3), 0, 0, int (shift4), 'foo') + + filler = '' + call test (eoshift (a, shift1, dim = 1), int (shift1), 0, 0, filler) + call test (eoshift (a, shift2, dim = 2), 0, int (shift2), 0, filler) + call test (eoshift (a, shift3, dim = 2), 0, int (shift3), 0, filler) + call test (eoshift (a, shift4, dim = 3), 0, 0, int (shift4), filler) +contains + subroutine test (b, d1, d2, d3, filler) + character (len = slen), dimension (n1, n2, n3) :: b + character (len = slen) :: filler + integer :: d1, d2, d3 + + do i3 = 1, n3 + do i2 = 1, n2 + do i1 = 1, n1 + if (i1 + d1 .gt. n1 .or. i2 + d2 .gt. n2 .or. i3 + d3 .gt. n3) then + if (b (i1, i2, i3) .ne. filler) call abort + else + if (b (i1, i2, i3) .ne. a (i1 + d1, i2 + d2, i3 + d3)) call abort + end if + end do + end do + end do + end subroutine test +end program main diff --git a/gcc/testsuite/gfortran.dg/char_eoshift_2.f90 b/gcc/testsuite/gfortran.dg/char_eoshift_2.f90 new file mode 100644 index 00000000000..bdb654c77ce --- /dev/null +++ b/gcc/testsuite/gfortran.dg/char_eoshift_2.f90 @@ -0,0 +1,57 @@ +! Test eoshift1 for character arrays. +! { dg-do run } +program main + implicit none + integer, parameter :: n1 = 2, n2 = 5, n3 = 4, slen = 3 + character (len = slen), dimension (n1, n2, n3) :: a + character (len = slen) :: filler + integer (kind = 1), dimension (n1, n3) :: shift1 + integer (kind = 2), dimension (n1, n3) :: shift2 + integer (kind = 4), dimension (n1, n3) :: shift3 + integer (kind = 8), dimension (n1, n3) :: shift4 + integer :: i1, i2, i3 + + shift1 (1, :) = (/ 1, 3, 2, 2 /) + shift1 (2, :) = (/ 2, 1, 1, 3 /) + shift2 = shift1 + shift3 = shift1 + shift4 = shift1 + + do i3 = 1, n3 + do i2 = 1, n2 + do i1 = 1, n1 + a (i1, i2, i3) = 'ab'(i1:i1) // 'cdefg'(i2:i2) // 'hijk'(i3:i3) + end do + end do + end do + + call test (eoshift (a, shift1, 'foo', 2), 'foo') + call test (eoshift (a, shift2, 'foo', 2), 'foo') + call test (eoshift (a, shift3, 'foo', 2), 'foo') + call test (eoshift (a, shift4, 'foo', 2), 'foo') + + filler = '' + call test (eoshift (a, shift1, dim = 2), filler) + call test (eoshift (a, shift2, dim = 2), filler) + call test (eoshift (a, shift3, dim = 2), filler) + call test (eoshift (a, shift4, dim = 2), filler) +contains + subroutine test (b, filler) + character (len = slen), dimension (n1, n2, n3) :: b + character (len = slen) :: filler + integer :: i2p + + do i3 = 1, n3 + do i2 = 1, n2 + do i1 = 1, n1 + i2p = i2 + shift1 (i1, i3) + if (i2p .gt. n2) then + if (b (i1, i2, i3) .ne. filler) call abort + else + if (b (i1, i2, i3) .ne. a (i1, i2p, i3)) call abort + end if + end do + end do + end do + end subroutine test +end program main diff --git a/gcc/testsuite/gfortran.dg/char_eoshift_3.f90 b/gcc/testsuite/gfortran.dg/char_eoshift_3.f90 new file mode 100644 index 00000000000..62bc04c8004 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/char_eoshift_3.f90 @@ -0,0 +1,54 @@ +! Test eoshift2 for character arrays. +! { dg-do run } +program main + implicit none + integer, parameter :: n1 = 2, n2 = 5, n3 = 4, slen = 3 + character (len = slen), dimension (n1, n2, n3) :: a + character (len = slen), dimension (n1, n3) :: filler + integer (kind = 1) :: shift1 = 4 + integer (kind = 2) :: shift2 = 2 + integer (kind = 4) :: shift3 = 3 + integer (kind = 8) :: shift4 = 1 + integer :: i1, i2, i3 + + filler (1, :) = (/ 'tic', 'tac', 'toe', 'tip' /) + filler (2, :) = (/ 'zzz', 'yyy', 'xxx', 'www' /) + + do i3 = 1, n3 + do i2 = 1, n2 + do i1 = 1, n1 + a (i1, i2, i3) = 'ab'(i1:i1) // 'cdefg'(i2:i2) // 'hijk'(i3:i3) + end do + end do + end do + + call test (eoshift (a, shift1, filler, 2), int (shift1), .true.) + call test (eoshift (a, shift2, filler, 2), int (shift2), .true.) + call test (eoshift (a, shift3, filler, 2), int (shift3), .true.) + call test (eoshift (a, shift4, filler, 2), int (shift4), .true.) + + call test (eoshift (a, shift1, dim = 2), int (shift1), .false.) + call test (eoshift (a, shift2, dim = 2), int (shift2), .false.) + call test (eoshift (a, shift3, dim = 2), int (shift3), .false.) + call test (eoshift (a, shift4, dim = 2), int (shift4), .false.) +contains + subroutine test (b, d2, has_filler) + character (len = slen), dimension (n1, n2, n3) :: b + logical :: has_filler + integer :: d2 + + do i3 = 1, n3 + do i2 = 1, n2 + do i1 = 1, n1 + if (i2 + d2 .le. n2) then + if (b (i1, i2, i3) .ne. a (i1, i2 + d2, i3)) call abort + else if (has_filler) then + if (b (i1, i2, i3) .ne. filler (i1, i3)) call abort + else + if (b (i1, i2, i3) .ne. '') call abort + end if + end do + end do + end do + end subroutine test +end program main diff --git a/gcc/testsuite/gfortran.dg/char_eoshift_4.f90 b/gcc/testsuite/gfortran.dg/char_eoshift_4.f90 new file mode 100644 index 00000000000..b7c86709034 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/char_eoshift_4.f90 @@ -0,0 +1,61 @@ +! Test eoshift3 for character arrays. +! { dg-do run } +program main + implicit none + integer, parameter :: n1 = 2, n2 = 5, n3 = 4, slen = 3 + character (len = slen), dimension (n1, n2, n3) :: a + character (len = slen), dimension (n1, n3) :: filler + integer (kind = 1), dimension (n1, n3) :: shift1 + integer (kind = 2), dimension (n1, n3) :: shift2 + integer (kind = 4), dimension (n1, n3) :: shift3 + integer (kind = 8), dimension (n1, n3) :: shift4 + integer :: i1, i2, i3 + + filler (1, :) = (/ 'tic', 'tac', 'toe', 'tip' /) + filler (2, :) = (/ 'zzz', 'yyy', 'xxx', 'www' /) + + shift1 (1, :) = (/ 1, 3, 2, 2 /) + shift1 (2, :) = (/ 2, 1, 1, 3 /) + shift2 = shift1 + shift3 = shift1 + shift4 = shift1 + + do i3 = 1, n3 + do i2 = 1, n2 + do i1 = 1, n1 + a (i1, i2, i3) = 'ab'(i1:i1) // 'cdefg'(i2:i2) // 'hijk'(i3:i3) + end do + end do + end do + + call test (eoshift (a, shift1, filler, 2), .true.) + call test (eoshift (a, shift2, filler, 2), .true.) + call test (eoshift (a, shift3, filler, 2), .true.) + call test (eoshift (a, shift4, filler, 2), .true.) + + call test (eoshift (a, shift1, dim = 2), .false.) + call test (eoshift (a, shift2, dim = 2), .false.) + call test (eoshift (a, shift3, dim = 2), .false.) + call test (eoshift (a, shift4, dim = 2), .false.) +contains + subroutine test (b, has_filler) + character (len = slen), dimension (n1, n2, n3) :: b + logical :: has_filler + integer :: i2p + + do i3 = 1, n3 + do i2 = 1, n2 + do i1 = 1, n1 + i2p = i2 + shift1 (i1, i3) + if (i2p .le. n2) then + if (b (i1, i2, i3) .ne. a (i1, i2p, i3)) call abort + else if (has_filler) then + if (b (i1, i2, i3) .ne. filler (i1, i3)) call abort + else + if (b (i1, i2, i3) .ne. '') call abort + end if + end do + end do + end do + end subroutine test +end program main diff --git a/gcc/testsuite/gfortran.dg/char_pack_1.f90 b/gcc/testsuite/gfortran.dg/char_pack_1.f90 new file mode 100644 index 00000000000..839f6c6b1a1 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/char_pack_1.f90 @@ -0,0 +1,59 @@ +! Test (non-scalar) pack for character arrays. +! { dg-do run } +program main + implicit none + integer, parameter :: n1 = 3, n2 = 4, nv = 10, slen = 9 + character (len = slen), dimension (n1, n2) :: a + character (len = slen), dimension (nv) :: vector + logical, dimension (n1, n2) :: 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 + mask (1, :) = (/ .true., .false., .true., .true. /) + mask (2, :) = (/ .true., .false., .false., .false. /) + mask (3, :) = (/ .false., .true., .true., .true. /) + + do i = 1, nv + vector (i) = 'crespo' // '0123456789'(i:i) + end do + + 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 + if (mask (i1, i2)) then + i = i + 1 + if (b (i) .ne. a (i1, i2)) call abort + end if + 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 + if (mask (i1, i2)) then + i = i + 1 + if (b (i) .ne. a (i1, i2)) call abort + end if + 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 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 00000000000..777db53f83c --- /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 = 10, 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' // '0123456789'(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 diff --git a/gcc/testsuite/gfortran.dg/char_reshape_1.f90 b/gcc/testsuite/gfortran.dg/char_reshape_1.f90 new file mode 100644 index 00000000000..b3b624459c9 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/char_reshape_1.f90 @@ -0,0 +1,43 @@ +! Test reshape for character arrays. +! { dg-do run } +program main + implicit none + integer, parameter :: n = 20, slen = 9 + character (len = slen), dimension (n) :: a, pad + integer, dimension (3) :: shape, order + integer :: i + + do i = 1, n + a (i) = 'abcdefghijklmnopqrstuvwxyz'(i:i+6) + pad (i) = 'ABCDEFGHIJKLMNOPQRSTUVWXYZ'(i:i+6) + end do + + shape = (/ 4, 6, 5 /) + order = (/ 3, 1, 2 /) + call test (reshape (a, shape, pad, order)) +contains + subroutine test (b) + character (len = slen), dimension (:, :, :) :: b + integer :: i1, i2, i3, ai, padi + + do i = 1, 3 + if (size (b, i) .ne. shape (i)) call abort + end do + ai = 0 + padi = 0 + do i2 = 1, shape (2) + do i1 = 1, shape (1) + do i3 = 1, shape (3) + if (ai .lt. n) then + ai = ai + 1 + if (b (i1, i2, i3) .ne. a (ai)) call abort + else + padi = padi + 1 + if (padi .gt. n) padi = 1 + if (b (i1, i2, i3) .ne. pad (padi)) call abort + end if + end do + end do + end do + end subroutine test +end program main diff --git a/gcc/testsuite/gfortran.dg/char_spread_1.f90 b/gcc/testsuite/gfortran.dg/char_spread_1.f90 new file mode 100644 index 00000000000..0d51f6046d5 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/char_spread_1.f90 @@ -0,0 +1,32 @@ +! Test spread for character arrays. +! { dg-do run } +program main + implicit none + integer, parameter :: n1 = 3, n2 = 10, n3 = 4, slen = 9 + character (len = slen), dimension (n1, n3) :: a + integer :: i1, i2, i3 + + do i3 = 1, n3 + do i1 = 1, n1 + a (i1, i3) = 'ab'(i1:i1) // 'cde'(i3:i3) // 'cantrip' + end do + end do + + call test (spread (a, 2, n2)) +contains + subroutine test (b) + character (len = slen), dimension (:, :, :) :: b + + if (size (b, 1) .ne. n1) call abort + if (size (b, 2) .ne. n2) call abort + if (size (b, 3) .ne. n3) call abort + + do i3 = 1, n3 + do i2 = 1, n2 + do i1 = 1, n1 + if (b (i1, i2, i3) .ne. a (i1, i3)) call abort + end do + end do + end do + end subroutine test +end program main diff --git a/gcc/testsuite/gfortran.dg/char_transpose_1.f90 b/gcc/testsuite/gfortran.dg/char_transpose_1.f90 new file mode 100644 index 00000000000..90605d6458d --- /dev/null +++ b/gcc/testsuite/gfortran.dg/char_transpose_1.f90 @@ -0,0 +1,29 @@ +! Test transpose for character arrays. +! { dg-do run } +program main + implicit none + integer, parameter :: n1 = 3, n2 = 4, slen = 9 + character (len = slen), dimension (n1, n2) :: a + integer :: i1, i2 + + do i2 = 1, n2 + do i1 = 1, n1 + a (i1, i2) = 'ab'(i1:i1) // 'cde'(i2:i2) // 'cantrip' + end do + end do + + call test (transpose (a)) +contains + subroutine test (b) + character (len = slen), dimension (:, :) :: b + + if (size (b, 1) .ne. n2) call abort + if (size (b, 2) .ne. n1) call abort + + do i2 = 1, n2 + do i1 = 1, n1 + if (b (i2, i1) .ne. a (i1, i2)) call abort + end do + end do + end subroutine test +end program main diff --git a/gcc/testsuite/gfortran.dg/char_unpack_1.f90 b/gcc/testsuite/gfortran.dg/char_unpack_1.f90 new file mode 100644 index 00000000000..65dd888a8d8 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/char_unpack_1.f90 @@ -0,0 +1,44 @@ +! Test unpack0 for character arrays. +! { dg-do run } +program main + implicit none + integer, parameter :: n1 = 3, n2 = 4, nv = 10, slen = 9 + character (len = slen), dimension (n1, n2) :: field + character (len = slen), dimension (nv) :: vector + logical, dimension (n1, n2) :: mask + integer :: i1, i2, i + + do i2 = 1, n2 + do i1 = 1, n1 + field (i1, i2) = 'abc'(i1:i1) // 'defg'(i2:i2) // 'cantrip' + end do + end do + mask (1, :) = (/ .true., .false., .true., .true. /) + mask (2, :) = (/ .true., .false., .false., .false. /) + mask (3, :) = (/ .false., .true., .true., .true. /) + + do i = 1, nv + vector (i) = 'crespo' // '0123456789'(i:i) + end do + + call test (unpack (vector, mask, field)) +contains + subroutine test (a) + character (len = slen), dimension (:, :) :: a + + if (size (a, 1) .ne. n1) call abort + if (size (a, 2) .ne. n2) call abort + + i = 0 + do i2 = 1, n2 + do i1 = 1, n1 + if (mask (i1, i2)) then + i = i + 1 + if (a (i1, i2) .ne. vector (i)) call abort + else + if (a (i1, i2) .ne. field (i1, i2)) call abort + end if + end do + end do + end subroutine test +end program main diff --git a/gcc/testsuite/gfortran.dg/char_unpack_2.f90 b/gcc/testsuite/gfortran.dg/char_unpack_2.f90 new file mode 100644 index 00000000000..3b2c4a32729 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/char_unpack_2.f90 @@ -0,0 +1,40 @@ +! Test unpack1 for character arrays. +! { dg-do run } +program main + implicit none + integer, parameter :: n1 = 3, n2 = 4, nv = 10, slen = 9 + character (len = slen) :: field + character (len = slen), dimension (nv) :: vector + logical, dimension (n1, n2) :: mask + integer :: i1, i2, i + + field = 'broadside' + mask (1, :) = (/ .true., .false., .true., .true. /) + mask (2, :) = (/ .true., .false., .false., .false. /) + mask (3, :) = (/ .false., .true., .true., .true. /) + + do i = 1, nv + vector (i) = 'crespo' // '0123456789'(i:i) + end do + + call test (unpack (vector, mask, field)) +contains + subroutine test (a) + character (len = slen), dimension (:, :) :: a + + if (size (a, 1) .ne. n1) call abort + if (size (a, 2) .ne. n2) call abort + + i = 0 + do i2 = 1, n2 + do i1 = 1, n1 + if (mask (i1, i2)) then + i = i + 1 + if (a (i1, i2) .ne. vector (i)) call abort + else + if (a (i1, i2) .ne. field) call abort + end if + end do + end do + end subroutine test +end program main |