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 20contains 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 69END 70