1! { dg-do compile }
2!
3! Testcases from PR32002.
4!
5PROGRAM test_pr32002
6
7  CALL test_1()                       ! scalar/vector
8  CALL test_2()                       ! vector/vector
9  CALL test_3()                       ! matrix/vector
10  CALL test_4()                       ! matrix/matrix
11
12CONTAINS
13  ELEMENTAL FUNCTION f(x)
14    INTEGER, INTENT(in) :: x
15    INTEGER :: f
16    f = x
17  END FUNCTION
18
19  SUBROUTINE test_1()
20    INTEGER :: a = 0, b(2) = 0
21    a = f(b)                          ! { dg-error "Incompatible ranks" }
22    b = f(a)                          ! ok, set all array elements to f(a)
23  END SUBROUTINE
24
25  SUBROUTINE test_2()
26    INTEGER :: a(2) = 0, b(3) = 0
27    a = f(b)                          ! { dg-error "Different shape" }
28    a = f(b(1:2))                     ! ok, slice, stride 1
29    a = f(b(1:3:2))                   ! ok, slice, stride 2
30  END SUBROUTINE
31
32  SUBROUTINE test_3()
33    INTEGER :: a(4) = 0, b(2,2) = 0
34    a = f(b)                          ! { dg-error "Incompatible ranks" }
35    a = f(RESHAPE(b, (/ 4 /)))        ! ok, same shape
36  END SUBROUTINE
37
38  SUBROUTINE test_4()
39    INTEGER :: a(2,2) = 0, b(3,3) = 0
40    a = f(b)                          ! { dg-error "Different shape" }
41    a = f(b(1:3, 1:2))                ! { dg-error "Different shape" }
42    a = f(b(1:3:2, 1:3:2))            ! ok, same shape
43  END SUBROUTINE
44END PROGRAM
45