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