1! { dg-do run } 2! Tests the fix for pr31214, in which the typespec for the entry would be lost, 3! thereby causing the function to be disallowed, since the function and entry 4! types did not match. 5! 6! Contributed by Joost VandeVondele <jv244@cam.ac.uk> 7! 8module type_mod 9 implicit none 10 11 type x 12 real x 13 end type x 14 type y 15 real x 16 end type y 17 type z 18 real x 19 end type z 20 21 interface assignment(=) 22 module procedure equals 23 end interface assignment(=) 24 25 interface operator(//) 26 module procedure a_op_b, b_op_a 27 end interface operator(//) 28 29 interface operator(==) 30 module procedure a_po_b, b_po_a 31 end interface operator(==) 32 33 contains 34 subroutine equals(x,y) 35 type(z), intent(in) :: y 36 type(z), intent(out) :: x 37 38 x%x = y%x 39 end subroutine equals 40 41 function a_op_b(a,b) 42 type(x), intent(in) :: a 43 type(y), intent(in) :: b 44 type(z) a_op_b 45 type(z) b_op_a 46 a_op_b%x = a%x + b%x 47 return 48 entry b_op_a(b,a) 49 b_op_a%x = a%x - b%x 50 end function a_op_b 51 52 function a_po_b(a,b) 53 type(x), intent(in) :: a 54 type(y), intent(in) :: b 55 type(z) a_po_b 56 type(z) b_po_a 57 entry b_po_a(b,a) 58 a_po_b%x = a%x/b%x 59 end function a_po_b 60end module type_mod 61 62program test 63 use type_mod 64 implicit none 65 type(x) :: x1 = x(19.0_4) 66 type(y) :: y1 = y(7.0_4) 67 type(z) z1 68 69 z1 = x1//y1 70 if (abs(z1%x - (19.0_4 + 7.0_4)) > epsilon(x1%x)) call abort () 71 z1 = y1//x1 72 if (abs(z1%x - (19.0_4 - 7.0_4)) > epsilon(x1%x)) call abort () 73 74 z1 = x1==y1 75 if (abs(z1%x - 19.0_4/7.0_4) > epsilon(x1%x)) call abort () 76 z1 = y1==x1 77 if (abs(z1%x - 19.0_4/7.0_4) > epsilon(x1%x)) call abort () 78end program test 79