1! { dg-do run } 2! 3! PR 45271: [OOP] Polymorphic code breaks when changing order of USE statements 4! 5! Contributed by Harald Anlauf <anlauf@gmx.de> 6 7module abstract_vector 8 implicit none 9 type, abstract :: vector_class 10 contains 11 procedure(op_assign_v_v), deferred :: assign 12 end type vector_class 13 abstract interface 14 subroutine op_assign_v_v(this,v) 15 import vector_class 16 class(vector_class), intent(inout) :: this 17 class(vector_class), intent(in) :: v 18 end subroutine 19 end interface 20end module abstract_vector 21 22module concrete_vector 23 use abstract_vector 24 implicit none 25 type, extends(vector_class) :: trivial_vector_type 26 contains 27 procedure :: assign => my_assign 28 end type 29contains 30 subroutine my_assign (this,v) 31 class(trivial_vector_type), intent(inout) :: this 32 class(vector_class), intent(in) :: v 33 write (*,*) 'Oops in concrete_vector::my_assign' 34 call abort () 35 end subroutine 36end module concrete_vector 37 38module concrete_gradient 39 use abstract_vector 40 implicit none 41 type, extends(vector_class) :: trivial_gradient_type 42 contains 43 procedure :: assign => my_assign 44 end type 45contains 46 subroutine my_assign (this,v) 47 class(trivial_gradient_type), intent(inout) :: this 48 class(vector_class), intent(in) :: v 49 write (*,*) 'concrete_gradient::my_assign' 50 end subroutine 51end module concrete_gradient 52 53program main 54 !--- exchange these two lines to make the code work: 55 use concrete_vector ! (1) 56 use concrete_gradient ! (2) 57 !--- 58 implicit none 59 type(trivial_gradient_type) :: g_initial 60 class(vector_class), allocatable :: g 61 print *, "cg: before g%assign" 62 allocate(trivial_gradient_type :: g) 63 call g%assign (g_initial) 64 print *, "cg: after g%assign" 65end program main 66