Initial checkin of GCC 4.9.0 from trunk (r208799).

Change-Id: I48a3c08bb98542aa215912a75f03c0890e497dba

1 files changed, 65 insertions, 0 deletions

diff --git a/gcc-4.9/gcc/testsuite/gfortran.dg/typebound_call_18.f03 b/gcc-4.9/gcc/testsuite/gfortran.dg/typebound_call_18.f03
new file mode 100644
index 000000000..e417ebf91
--- /dev/null
+++ b/gcc-4.9/gcc/testsuite/gfortran.dg/typebound_call_18.f03
@@ -0,0 +1,65 @@
+! { dg-do run }
+!
+! PR 45271: [OOP] Polymorphic code breaks when changing order of USE statements
+!
+! Contributed by Harald Anlauf <anlauf@gmx.de>
+
+module abstract_vector
+  implicit none
+  type, abstract :: vector_class
+  contains
+    procedure(op_assign_v_v), deferred :: assign
+  end type vector_class
+  abstract interface
+    subroutine op_assign_v_v(this,v)
+      import vector_class
+      class(vector_class), intent(inout) :: this
+      class(vector_class), intent(in)    :: v
+    end subroutine
+  end interface
+end module abstract_vector
+
+module concrete_vector
+  use abstract_vector
+  implicit none
+  type, extends(vector_class) :: trivial_vector_type
+  contains
+    procedure :: assign => my_assign
+  end type
+contains
+  subroutine my_assign (this,v)
+    class(trivial_vector_type), intent(inout) :: this
+    class(vector_class),        intent(in)    :: v
+    write (*,*) 'Oops in concrete_vector::my_assign'
+    call abort ()
+  end subroutine
+end module concrete_vector
+
+module concrete_gradient
+  use abstract_vector
+  implicit none
+  type, extends(vector_class) :: trivial_gradient_type
+  contains
+    procedure :: assign => my_assign
+  end type
+contains
+  subroutine my_assign (this,v)
+    class(trivial_gradient_type), intent(inout) :: this
+    class(vector_class),          intent(in)    :: v
+    write (*,*) 'concrete_gradient::my_assign'
+  end subroutine
+end module concrete_gradient
+
+program main
+  !--- exchange these two lines to make the code work:
+  use concrete_vector    ! (1)
+  use concrete_gradient  ! (2)
+  !---
+  implicit none
+  type(trivial_gradient_type)      :: g_initial
+  class(vector_class),  allocatable :: g
+  print *, "cg: before g%assign"
+  allocate(trivial_gradient_type :: g)
+  call g%assign (g_initial)
+  print *, "cg: after  g%assign"
+end program main