===================================================================
@@ -1,3 +1,9 @@
+2016-11-20 Andre Vehreschild <vehre@gcc.gnu.org>
+
+ PR fortran/78395
+ * resolve.c (resolve_typebound_function): Prevent stripping of refs,
+ when the base-expression is a class' typed one.
+
2016-11-18 Richard Sandiford <richard.sandiford@arm.com>
Alan Hayward <alan.hayward@arm.com>
David Sherwood <david.sherwood@arm.com>
===================================================================
@@ -6140,7 +6140,7 @@
gfc_free_ref_list (class_ref->next);
class_ref->next = NULL;
}
- else if (e->ref && !class_ref)
+ else if (e->ref && !class_ref && expr->ts.type != BT_CLASS)
{
gfc_free_ref_list (e->ref);
e->ref = NULL;
===================================================================
@@ -1,3 +1,8 @@
+2016-11-20 Andre Vehreschild <vehre@gcc.gnu.org>
+
+ PR fortran/78395
+ * gfortran.dg/typebound_operator_21.f03: New test.
+
2016-11-20 Marc Glisse <marc.glisse@inria.fr>
* gcc.dg/tree-ssa/divide-5.c: New file.
===================================================================
@@ -0,0 +1,78 @@
+! { dg-do run }
+!
+! Test that pr78395 is fixed.
+! Contributed by Chris MacMackin and Janus Weil
+
+module types_mod
+ implicit none
+
+ type, public :: t1
+ integer :: a
+ contains
+ procedure :: get_t2
+ end type
+
+ type, public :: t2
+ integer :: b
+ contains
+ procedure, pass(rhs) :: mul2
+ procedure :: assign
+ generic :: operator(*) => mul2
+ generic :: assignment(=) => assign
+ end type
+
+contains
+
+ function get_t2(this)
+ class(t1), intent(in) :: this
+ class(t2), allocatable :: get_t2
+ type(t2), allocatable :: local
+ allocate(local)
+ local%b = this%a
+ call move_alloc(local, get_t2)
+ end function
+
+ function mul2(lhs, rhs)
+ class(t2), intent(in) :: rhs
+ integer, intent(in) :: lhs
+ class(t2), allocatable :: mul2
+ type(t2), allocatable :: local
+ allocate(local)
+ local%b = rhs%b*lhs
+ call move_alloc(local, mul2)
+ end function
+
+ subroutine assign(this, rhs)
+ class(t2), intent(out) :: this
+ class(t2), intent(in) :: rhs
+ select type(rhs)
+ type is(t2)
+ this%b = rhs%b
+ class default
+ error stop
+ end select
+ end subroutine
+
+end module
+
+
+program minimal
+ use types_mod
+ implicit none
+
+ class(t1), allocatable :: v4
+ class(t2), allocatable :: v6
+
+ allocate(v4, source=t1(4))
+ allocate(v6)
+ v6 = 3 * v4%get_t2()
+
+ select type (v6)
+ type is (t2)
+ if (v6%b /= 12) error stop
+ class default
+ error stop
+ end select
+ deallocate(v4, v6)
+end
+