gcc/testsuite/gfortran.dg/redefined_intrinsic_assignment_2.f90

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