From 1a9a4a126f54e720677aa16a5c258f1251a24133 Mon Sep 17 00:00:00 2001 From: rsandifo Date: Tue, 13 Sep 2005 07:15:01 +0000 Subject: 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_ and adding an extra size argument. (cshift1_): Redefine as a forwarder to cshift1. (cshift1__char): New function. * m4/eoshift1.m4 (zeros): Delete. (eoshift1): New static function, reusing the contents of eoshift1_ and adding extra size and filler arguments. Fix calculation of hstride. Use memset if no bound is provided. (eoshift1_): Redefine as a forwarder to eoshift1. (eoshift1__char): New function. * m4/eoshift3.m4 (zeros): Delete. (eoshift3): New static function, reusing the contents of eoshift3_ and adding extra size and filler arguments. Use memset if no bound is provided. (eoshift3_): Redefine as a forwarder to eoshift3. (eoshift3__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 --- gcc/testsuite/gfortran.dg/char_unpack_2.f90 | 40 +++++++++++++++++++++++++++++ 1 file changed, 40 insertions(+) create mode 100644 gcc/testsuite/gfortran.dg/char_unpack_2.f90 (limited to 'gcc/testsuite/gfortran.dg/char_unpack_2.f90') 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 -- cgit v1.2.1