1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
|
! { dg-do run }
! PR fortran/109641
!
! Check overloading of intrinsic binary operators for numeric operands
! Reported by Adelson Oliveira
MODULE TESTEOP
IMPLICIT NONE
INTERFACE OPERATOR(.MULT.)
MODULE PROCEDURE MULTr4
MODULE PROCEDURE MULTc4
END INTERFACE
INTERFACE OPERATOR(*)
MODULE PROCEDURE MULTr4
MODULE PROCEDURE MULTc4
END INTERFACE
INTERFACE OPERATOR(==)
MODULE PROCEDURE MULTr4
MODULE PROCEDURE MULTc4
MODULE PROCEDURE MULTr8
END INTERFACE
INTERFACE OPERATOR(<)
MODULE PROCEDURE MULTc4
MODULE PROCEDURE MULTi4
END INTERFACE
INTERFACE OPERATOR(**)
MODULE PROCEDURE MULTc4
MODULE PROCEDURE MULTi4
END INTERFACE
interface copy
MODULE PROCEDURE copy
end interface copy
CONTAINS
elemental function copy (z)
complex, intent(in) :: z
complex :: copy
copy = z
end function copy
FUNCTION MULTr4(v,m)
REAL, INTENT(IN) :: v(:)
REAL, INTENT(IN) :: m(:,:)
REAL :: MULTr4(SIZE(m,DIM=1),SIZE(m,DIM=2))
INTEGER :: i
FORALL(i=1:SIZE(v)) MULTr4(:,i)=m(:,i)*v(i)
END FUNCTION MULTr4
FUNCTION MULTr8(v,m)
REAL, INTENT(IN) :: v(:)
double precision, INTENT(IN) :: m(:,:)
double precision :: MULTr8(SIZE(m,DIM=1),SIZE(m,DIM=2))
INTEGER :: i
FORALL(i=1:SIZE(v)) MULTr8(:,i)=m(:,i)*v(i)
END FUNCTION MULTr8
FUNCTION MULTc4(v,m)
REAL, INTENT(IN) :: v(:)
COMPLEX, INTENT(IN) :: m(:,:)
COMPLEX :: MULTc4(SIZE(m,DIM=1),SIZE(m,DIM=2))
INTEGER :: i
FORALL(i=1:SIZE(v)) MULTc4(:,i)=m(:,i)*v(i)
END FUNCTION MULTc4
FUNCTION MULTi4(v,m)
REAL, INTENT(IN) :: v(:)
integer, INTENT(IN) :: m(:,:)
REAL :: MULTi4(SIZE(m,DIM=1),SIZE(m,DIM=2))
INTEGER :: i
FORALL(i=1:SIZE(v)) MULTi4(:,i)=m(:,i)*v(i)
END FUNCTION MULTi4
END MODULE TESTEOP
PROGRAM TESTE
USE TESTEOP
implicit none
type t
complex :: c(3,3)
end type t
real, parameter :: vv(3) = 42.
complex, parameter :: zz(3,3) = (1.0,0.0)
integer, parameter :: kk(3,3) = 2
double precision :: dd(3,3) = 3.d0
COMPLEX, ALLOCATABLE :: m(:,:),r(:,:), s(:,:)
REAL, ALLOCATABLE :: v(:)
type(t) :: z(1) = t(zz)
ALLOCATE(v(3),m(3,3),r(3,3),s(3,3))
v = vv
m = zz
! Original bug report
r=v.MULT.m ! Reference
s=v*m
if (any (r /= s)) stop 1
if (.not. all (r == s)) stop 2
! Check other binary intrinsics
s=v==m
if (any (r /= s)) stop 3
s=v==copy(m)
if (any (r /= s)) stop 4
s=v==zz
if (any (r /= s)) stop 5
s=v==copy(zz)
if (any (r /= s)) stop 6
s=vv==m
if (any (r /= s)) stop 7
s=vv==copy(m)
if (any (r /= s)) stop 8
s=vv==zz
if (any (r /= s)) stop 9
s=vv==copy(zz)
if (any (r /= s)) stop 10
! check if .eq. same operator as == etc.
s=v.eq.m
if (any (r /= s)) stop 11
s=v.lt.z(1)%c
if (any (r /= s)) stop 12
s=v<((z(1)%c))
if (any (r /= s)) stop 13
if (.not. all ( 1. < (vv**kk))) stop 14
if (.not. all ( 1. < (vv< kk))) stop 15
if (.not. all ((42.,0.) == (v < m ))) stop 16
if (.not. all ((42.,0.) == (v** m ))) stop 17
if (.not. all ( 126.d0 == (vv==dd))) stop 18
END PROGRAM TESTE
|
