1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
|
! { dg-do compile }
!
! PR fortran/47448
!
! ASSIGNMENT(=) checks. Defined assignment is allowed if and only if
! it does not override an intrinsic assignment.
!
module test1
interface assignment(=)
module procedure valid, valid2
end interface
contains
! Valid: scalar = array
subroutine valid (lhs,rhs)
integer, intent(out) :: lhs
integer, intent(in) :: rhs(:)
lhs = rhs(1)
end subroutine valid
! Valid: array of different ranks
subroutine valid2 (lhs,rhs)
integer, intent(out) :: lhs(:)
integer, intent(in) :: rhs(:,:)
lhs(:) = rhs(:,1)
end subroutine valid2
end module test1
module test2
interface assignment(=)
module procedure invalid
end interface
contains
! Invalid: scalar = scalar
subroutine invalid (lhs,rhs) ! { dg-error "must not redefine an INTRINSIC type assignment" }
integer, intent(out) :: lhs
integer, intent(in) :: rhs
lhs = rhs
end subroutine invalid
end module test2
module test3
interface assignment(=)
module procedure invalid2
end interface
contains
! Invalid: array = scalar
subroutine invalid2 (lhs,rhs) ! { dg-error "must not redefine an INTRINSIC type assignment" }
integer, intent(out) :: lhs(:)
integer, intent(in) :: rhs
lhs(:) = rhs
end subroutine invalid2
end module test3
module test4
interface assignment(=)
module procedure invalid3
end interface
contains
! Invalid: array = array for same rank
subroutine invalid3 (lhs,rhs) ! { dg-error "must not redefine an INTRINSIC type assignment" }
integer, intent(out) :: lhs(:)
integer, intent(in) :: rhs(:)
lhs(:) = rhs(:)
end subroutine invalid3
end module test4
! { dg-final { cleanup-modules "test1" } }
|
