OSDN Git Service

2d2aedaf3d8b0625b9bf85c5ab91e69416dec4db
[pf3gnuchains/gcc-fork.git] / gcc / testsuite / gfortran.dg / entry_13.f90
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 !
8 module 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
60 end module type_mod
61
62 program 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 (z1%x .ne. 19.0_4 + 7.0_4) call abort ()
71   z1 = y1//x1
72   if (z1%x .ne. 19.0_4 - 7.0_4) call abort ()
73
74   z1 = x1==y1
75   if (z1%x .ne. 19.0_4/7.0_4) call abort ()
76   z1 = y1==x1
77   if (z1%x .ne. 19.0_4/7.0_4) call abort ()
78 end program test
79 ! { dg-final { cleanup-modules "type_mod" } }
80