/* Allowed are (per F2003, 12.3.2.1.2 Defined assignments):
- First argument an array with different rank than second,
- - Types and kinds do not conform, and
+ - First argument is a scalar and second an array,
+ - Types and kinds do not conform, or
- First argument is of derived type. */
if (sym->formal->sym->ts.type != BT_DERIVED
&& sym->formal->sym->ts.type != BT_CLASS
- && (r1 == 0 || r1 == r2)
+ && (r2 == 0 || r1 == r2)
&& (sym->formal->sym->ts.type == sym->formal->next->sym->ts.type
|| (gfc_numeric_ts (&sym->formal->sym->ts)
&& gfc_numeric_ts (&sym->formal->next->sym->ts))))
--- /dev/null
+! { 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" } }