1! { dg-do run } 2! PR48946 - complex expressions involving typebound operators of derived types. 3! 4module field_module 5 implicit none 6 type ,abstract :: field 7 contains 8 procedure(field_op_real) ,deferred :: multiply_real 9 procedure(field_plus_field) ,deferred :: plus 10 procedure(assign_field) ,deferred :: assn 11 generic :: operator(*) => multiply_real 12 generic :: operator(+) => plus 13 generic :: ASSIGNMENT(=) => assn 14 end type 15 abstract interface 16 function field_plus_field(lhs,rhs) 17 import :: field 18 class(field) ,intent(in) :: lhs 19 class(field) ,intent(in) :: rhs 20 class(field) ,allocatable :: field_plus_field 21 end function 22 end interface 23 abstract interface 24 function field_op_real(lhs,rhs) 25 import :: field 26 class(field) ,intent(in) :: lhs 27 real ,intent(in) :: rhs 28 class(field) ,allocatable :: field_op_real 29 end function 30 end interface 31 abstract interface 32 subroutine assign_field(lhs,rhs) 33 import :: field 34 class(field) ,intent(OUT) :: lhs 35 class(field) ,intent(IN) :: rhs 36 end subroutine 37 end interface 38end module 39 40module i_field_module 41 use field_module 42 implicit none 43 type, extends (field) :: i_field 44 integer :: i 45 contains 46 procedure :: multiply_real => i_multiply_real 47 procedure :: plus => i_plus_i 48 procedure :: assn => i_assn 49 end type 50contains 51 function i_plus_i(lhs,rhs) 52 class(i_field) ,intent(in) :: lhs 53 class(field) ,intent(in) :: rhs 54 class(field) ,allocatable :: i_plus_i 55 integer :: m = 0 56 select type (lhs) 57 type is (i_field); m = lhs%i 58 end select 59 select type (rhs) 60 type is (i_field); m = rhs%i + m 61 end select 62 allocate (i_plus_i, source = i_field (m)) 63 end function 64 function i_multiply_real(lhs,rhs) 65 class(i_field) ,intent(in) :: lhs 66 real ,intent(in) :: rhs 67 class(field) ,allocatable :: i_multiply_real 68 integer :: m = 0 69 select type (lhs) 70 type is (i_field); m = lhs%i * int (rhs) 71 end select 72 allocate (i_multiply_real, source = i_field (m)) 73 end function 74 subroutine i_assn(lhs,rhs) 75 class(i_field) ,intent(OUT) :: lhs 76 class(field) ,intent(IN) :: rhs 77 select type (lhs) 78 type is (i_field) 79 select type (rhs) 80 type is (i_field) 81 lhs%i = rhs%i 82 end select 83 end select 84 end subroutine 85end module 86 87program main 88 use i_field_module 89 implicit none 90 type(i_field) ,allocatable :: u 91 allocate (u, source = i_field (99)) 92 93 u = u*2. 94 u = (u*2.0*4.0) + u*4.0 95 u = u%multiply_real (2.0)*4.0 96 u = i_multiply_real (u, 2.0) * 4.0 97 98 if (u%i .ne. 152064) call abort 99end program 100