summaryrefslogtreecommitdiff
path: root/gcc/testsuite/gfortran.dg/redefined_intrinsic_assignment_2.f90
blob: ba70902091e863b47a366e025009ec0386ebad6b (plain)
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" } }