Index: flang/lib/Semantics/assignment.cpp
===================================================================
--- flang/lib/Semantics/assignment.cpp
+++ flang/lib/Semantics/assignment.cpp
@@ -45,7 +45,7 @@
 
 private:
   bool CheckForPureContext(const SomeExpr &rhs, parser::CharBlock rhsSource,
-      bool isPointerAssignment);
+      bool isPointerAssignment, bool isDefinedAssignment);
   void CheckShape(parser::CharBlock, const SomeExpr *);
   template <typename... A>
   parser::Message *Say(parser::CharBlock at, A &&...args) {
@@ -75,7 +75,8 @@
       }
     }
     auto rhsLoc{std::get<parser::Expr>(stmt.t).source};
-    CheckForPureContext(rhs, rhsLoc, false);
+    CheckForPureContext(rhs, rhsLoc, false /*not a pointer assignment*/,
+        std::holds_alternative<evaluate::ProcedureRef>(assignment->u));
     if (whereDepth_ > 0) {
       CheckShape(lhsLoc, &lhs);
     }
@@ -86,7 +87,9 @@
   CHECK(whereDepth_ == 0);
   if (const evaluate::Assignment * assignment{GetAssignment(stmt)}) {
     const SomeExpr &rhs{assignment->rhs};
-    CheckForPureContext(rhs, std::get<parser::Expr>(stmt.t).source, true);
+    CheckForPureContext(rhs, std::get<parser::Expr>(stmt.t).source,
+        true /*this is a pointer assignment*/,
+        false /*not a defined assignment*/);
     parser::CharBlock at{context_.location().value()};
     auto restorer{foldingContext().messages().SetLocation(at)};
     const Scope &scope{context_.FindScope(at)};
@@ -126,7 +129,8 @@
 }
 
 bool AssignmentContext::CheckForPureContext(const SomeExpr &rhs,
-    parser::CharBlock rhsSource, bool isPointerAssignment) {
+    parser::CharBlock rhsSource, bool isPointerAssignment,
+    bool isDefinedAssignment) {
   const Scope &scope{context_.FindScope(rhsSource)};
   if (!FindPureProcedureContaining(scope)) {
     return true;
@@ -143,7 +147,7 @@
         return false;
       }
     }
-  } else {
+  } else if (!isDefinedAssignment) {
     return CheckCopyabilityInPureScope(messages, rhs, scope);
   }
   return true;
Index: flang/test/Semantics/assign04.f90
===================================================================
--- flang/test/Semantics/assign04.f90
+++ flang/test/Semantics/assign04.f90
@@ -207,20 +207,20 @@
       !ERROR: The mask or variable must not be scalar
       x(j)='?'
       !ERROR: The mask or variable must not be scalar
-      n(j)='?' ! fine
+      n(j)='?'
     !ERROR: The mask or variable must not be scalar
     elsewhere (.false.)
       !ERROR: Defined assignment in WHERE must be elemental, but 'ctor' is not
       !ERROR: The mask or variable must not be scalar
       x(j)='1'
       !ERROR: The mask or variable must not be scalar
-      n(j)='1' ! fine
+      n(j)='1'
     elsewhere
       !ERROR: Defined assignment in WHERE must be elemental, but 'ctor' is not
       !ERROR: The mask or variable must not be scalar
       x(j)='9'
       !ERROR: The mask or variable must not be scalar
-      n(j)='9' ! fine
+      n(j)='9'
     end where
   end forall
   x='0' ! still fine
@@ -239,3 +239,42 @@
     character, intent(in) :: c
   end subroutine
 end subroutine s13
+
+module m14
+  type t1
+    integer, pointer :: p
+   contains
+    procedure definedAsst1
+    generic :: assignment(=) => definedAsst1
+  end type
+  type t2
+    integer, pointer :: p
+  end type
+  interface assignment(=)
+    module procedure definedAsst2
+  end interface
+  type t3
+    integer, pointer :: p
+  end type
+ contains
+  pure subroutine definedAsst1(lhs,rhs)
+    class(t1), intent(in out) :: lhs
+    class(t1), intent(in) :: rhs
+  end subroutine
+  pure subroutine definedAsst2(lhs,rhs)
+    type(t2), intent(out) :: lhs
+    type(t2), intent(in) :: rhs
+  end subroutine
+  pure subroutine test(y1,y2,y3)
+    type(t1) x1
+    type(t1), intent(in) :: y1
+    type(t2) x2
+    type(t2), intent(in) :: y2
+    type(t3) x3
+    type(t3), intent(in) :: y3
+    x1 = y1 ! fine due to not being intrinsic assignment
+    x2 = y2 ! fine due to not being intrinsic assignment
+    !ERROR: A pure subprogram may not copy the value of 'y3' because it is an INTENT(IN) dummy argument and has the POINTER potential subobject component '%p'
+    x3 = y3
+  end subroutine
+end module m14