1! { dg-do run }
2! Test the extension of intrinsic operators
3module m1
4 interface operator(*)
5  module procedure f1
6  module procedure f2
7  module procedure f3
8 end interface
9
10 interface operator(.or.)
11  module procedure g1
12 end interface
13
14 interface operator(//)
15  module procedure g1
16 end interface
17
18contains
19
20 function f1(a,b) result (c)
21  integer, dimension(2,2), intent(in) :: a
22  integer, dimension(2), intent(in)   :: b
23  integer, dimension(2)   :: c
24  c = matmul(a,b)
25 end function f1
26 function f2(a,b) result (c)
27  real, dimension(2,2), intent(in) :: a
28  real, dimension(2), intent(in)   :: b
29  real, dimension(2)   :: c
30  c = matmul(a,b)
31 end function f2
32 function f3(a,b) result (c)
33  complex, dimension(2,2), intent(in) :: a
34  complex, dimension(2), intent(in)   :: b
35  complex, dimension(2)   :: c
36  c = matmul(a,b)
37 end function f3
38
39 elemental function g1(a,b) result (c)
40   integer, intent(in) :: a, b
41   integer :: c
42   c = a + b
43 end function g1
44
45end module m1
46
47  use m1
48  implicit none
49
50  integer, dimension(2,2) :: ai
51  integer, dimension(2)   :: bi, ci
52  real, dimension(2,2) :: ar
53  real, dimension(2)   :: br, cr
54  complex, dimension(2,2) :: ac
55  complex, dimension(2)   :: bc, cc
56
57  ai = reshape((/-2,-4,7,8/),(/2,2/)) ; bi = 3
58  if (any((ai*bi) /= matmul(ai,bi))) call abort()
59  if (any((ai .or. ai) /= ai+ai)) call abort()
60  if (any((ai // ai) /= ai+ai)) call abort()
61
62  ar = reshape((/-2,-4,7,8/),(/2,2/)) ; br = 3
63  if (any((ar*br) /= matmul(ar,br))) call abort()
64
65  ac = reshape((/-2,-4,7,8/),(/2,2/)) ; bc = 3
66  if (any((ac*bc) /= matmul(ac,bc))) call abort()
67
68end
69