1 files changed, 66 insertions, 0 deletions
diff --git a/gcc-4.9/gcc/testsuite/gfortran.dg/typebound_assignment_7.f90 b/gcc-4.9/gcc/testsuite/gfortran.dg/typebound_assignment_7.f90
new file mode 100644
index 000000000..2c5b837d6
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/gfortran.dg/typebound_assignment_7.f90
@@ -0,0 +1,66 @@
+! { dg-do run }
+!
+! PR 57843: [OOP] Type-bound assignment is resolved to non-polymorphic procedure call
+!
+! Contributed by John <jwmwalrus@gmail.com>
+
+module mod1
+  implicit none
+  type :: itemType
+  contains
+    procedure :: the_assignment => assign_itemType
+    generic :: assignment(=) => the_assignment
+  end type
+contains
+  subroutine assign_itemType(left, right)
+    class(itemType), intent(OUT) :: left
+    class(itemType), intent(IN) :: right
+  end subroutine
+end module
+
+module mod2
+  use mod1
+  implicit none
+  type, extends(itemType) :: myItem
+    character(3) :: name = ''
+  contains
+    procedure :: the_assignment => assign_myItem
+  end type
+contains
+  subroutine assign_myItem(left, right)
+    class(myItem), intent(OUT) :: left
+    class(itemType), intent(IN) :: right
+    select type (right)
+    type is (myItem)
+      left%name = right%name
+    end select
+  end subroutine
+end module
+
+
+program test_assign
+
+  use mod2
+  implicit none
+
+  class(itemType), allocatable :: item1, item2
+
+  allocate (myItem :: item1)
+  select type (item1)
+    type is (myItem)
+      item1%name = 'abc'
+  end select
+
+  allocate (myItem :: item2)
+  item2 = item1
+
+  select type (item2)
+    type is (myItem)
+      if (item2%name /= 'abc') call abort()
+    class default
+      call abort()
+  end select
+
+end
+
+! { dg-final { cleanup-modules "mod1 mod2" } }