1! { dg-do run }
2! Tests the fix for PR31217 and PR33811 , in which dependencies were not
3! correctly handled for the assignments below and, when this was fixed,
4! the last two ICEd on trying to create the temorary.
5!
6! Contributed by Joost VandeVondele <jv244@cam.ac.uk>
7!              Dominique d'Humieres <dominiq@lps.ens.fr>
8!                   and Paul Thomas <pault@gcc.gnu.org>
9!
10  character(len=1) :: a = "1"
11  character(len=1) :: b(4) = (/"1","2","3","4"/), c(4)
12  c = b
13  forall(i=1:1) a(i:i) = a(i:i)         ! This was the original PR31217
14  forall(i=1:1) b(i:i) = b(i:i)         ! The rest were found to be broken
15  forall(i=1:1) b(:)(i:i) = b(:)(i:i)
16  forall(i=1:1) b(1:3)(i:i) = b(2:4)(i:i)
17  if (any (b .ne. (/"2","3","4","4"/))) STOP 1
18  b = c
19  forall(i=1:1) b(2:4)(i:i) = b(1:3)(i:i)
20  if (any (b .ne. (/"1","1","2","3"/))) STOP 2
21  b = c
22  do i = 1, 1
23    b(2:4)(i:i) = b(1:3)(i:i)           ! This was PR33811 and Paul's bit
24  end do
25  if (any (b .ne. (/"1","1","2","3"/))) STOP 3
26  call foo
27contains
28  subroutine foo
29    character(LEN=12) :: a(2) = "123456789012"
30    character(LEN=12) :: b = "123456789012"
31! These are Dominique's
32    forall (i = 3:10) a(:)(i:i+2) = a(:)(i-2:i)
33    IF (a(1) .ne. "121234567890") STOP 4
34    forall (i = 3:10) a(2)(i:i+2) = a(1)(i-2:i)
35    IF (a(2) .ne. "121212345678") STOP 5
36    forall (i = 3:10) b(i:i+2) = b(i-2:i)
37    IF (b .ne. "121234567890") STOP 6
38  end subroutine
39end
40
41