gcc/testsuite/gfortran.dg/char_length_8.f90

   1 ! { dg-do run }
   2 ! Test the fix for PR31197 and PR31258 in which the substrings below
   3 ! would cause ICEs because the character lengths were never resolved.
   4 !
   5 ! Contributed by Joost VandeVondele <jv244@cam.ac.uk>
   6 !            and Thomas Koenig <tkoenig@gcc.gnu.org>
   7 !
   8   CHARACTER(LEN=3), DIMENSION(10) :: Z
   9   CHARACTER(LEN=3), DIMENSION(3,3) :: W
  10   integer :: ctr = 0
  11   call test_reshape
  12   call test_eoshift
  13   call test_cshift
  14   call test_spread
  15   call test_transpose
  16   call test_pack
  17   call test_unpack
  18   call test_pr31197
  19   if (ctr .ne. 8) call abort
  20 contains
  21   subroutine test_reshape
  22     Z(:)="123"
  23     if (any (RESHAPE(Z(:)(2:2),(/5,2/)) .ne. "2")) call abort
  24     ctr = ctr + 1
  25   end subroutine
  26   subroutine test_eoshift
  27     CHARACTER(LEN=1), DIMENSION(10) :: chk
  28     chk(1:8) = "5"
  29     chk(9:10) = " "
  30     Z(:)="456"
  31     if (any (EOSHIFT(Z(:)(2:2),2) .ne. chk)) call abort
  32     ctr = ctr + 1
  33   END subroutine
  34   subroutine test_cshift
  35     Z(:)="901"
  36     if (any (CSHIFT(Z(:)(2:2),2) .ne. "0")) call abort
  37     ctr = ctr + 1
  38   end subroutine
  39   subroutine test_spread
  40     Z(:)="789"
  41     if (any (SPREAD(Z(:)(2:2),dim=1,ncopies=2) .ne. "8")) call abort
  42     ctr = ctr + 1
  43   end subroutine
  44   subroutine test_transpose
  45     W(:, :)="abc"
  46     if (any (TRANSPOSE(W(:,:)(1:2)) .ne. "ab")) call abort
  47     ctr = ctr + 1
  48   end subroutine
  49   subroutine test_pack
  50     W(:, :)="def"
  51     if (any (pack(W(:,:)(2:3),mask=.true.) .ne. "ef")) call abort
  52     ctr = ctr + 1
  53   end subroutine
  54   subroutine test_unpack
  55     logical, dimension(5,2) :: mask
  56     Z(:)="hij"
  57     mask = .true.
  58     if (any (unpack(Z(:)(2:2),mask,' ') .ne. "i")) call abort
  59     ctr = ctr + 1
  60   end subroutine
  61   subroutine test_pr31197
  62     TYPE data
  63       CHARACTER(LEN=3) :: A = "xyz"
  64     END TYPE
  65     TYPE(data), DIMENSION(10), TARGET :: T
  66     if (any (TRANSPOSE(RESHAPE(T(:)%A(2:2),(/5,2/))) .ne. "y")) call abort
  67     ctr = ctr + 1
  68   end subroutine
  69 END