OSDN Git Service

3549fbea98337bd387c74f48c119a3348a5da7c6
[pf3gnuchains/gcc-fork.git] / gcc / testsuite / gfortran.dg / assignment_2.f90
1 ! { dg-do compile }
2 !
3 ! PR fortran/35033
4 !
5 ! The checks for assignments were too strict.
6 !
7 MODULE 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
14 contains
15   subroutine test1()
16           REAL,POINTER :: p(:,:),q(:)
17           CALL s(p,q) 
18           p = q
19   end subroutine test1
20 end module m1
21
22 MODULE 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
29 contains
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
37 end module m2
38
39 MODULE m3
40           INTERFACE ASSIGNMENT(=)
41              module procedure s ! { dg-error "must not redefine an INTRINSIC type" }
42           END Interface
43 contains
44              SUBROUTINE s(a,b)
45                  REAL,INTENT(OUT),VOLATILE :: a(1,*)
46                  REAL,INTENT(IN) :: b(:,:)
47              END SUBROUTINE
48 end module m3
49