1! { dg-do compile }
2!
3! PR fortran/35033
4!
5! The checks for assignments were too strict.
6!
7MODULE m1
8          INTERFACE ASSIGNMENT(=)
9             SUBROUTINE s(a,b)
10                 REAL,INTENT(OUT) :: a(1,*)
11                 REAL,INTENT(IN) :: b(:)
12             END SUBROUTINE
13          END Interface
14contains
15  subroutine test1()
16          REAL,POINTER :: p(:,:),q(:)
17          CALL s(p,q)
18          p = q
19  end subroutine test1
20end module m1
21
22MODULE m2
23          INTERFACE ASSIGNMENT(=)
24             SUBROUTINE s(a,b)
25                 REAL,INTENT(OUT),VOLATILE :: a(1,*)
26                 REAL,INTENT(IN) :: b(:)
27             END SUBROUTINE
28          END Interface
29contains
30  subroutine test1()
31          REAL,POINTER :: p(:,:),q(:)
32          CALL s(p,q) ! { dg-error "requires an assumed-shape or pointer-array dummy" }
33!TODO: The following is rightly rejected but the error message is misleading.
34! The actual reason is the mismatch between pointer array and VOLATILE
35          p = q ! { dg-error "Incompatible ranks" }
36  end subroutine test1
37end module m2
38
39MODULE m3
40          INTERFACE ASSIGNMENT(=)
41             module procedure s
42          END Interface
43contains
44             SUBROUTINE s(a,b) ! { dg-error "must not redefine an INTRINSIC type" }
45                 REAL,INTENT(OUT),VOLATILE :: a(1,*)
46                 REAL,INTENT(IN) :: b(:,:)
47             END SUBROUTINE
48end module m3
49