1! { dg-do run }
2! { dg-options "-fdec" }
3!
4! Runtime tests to verify bitwise ops perform appropriate conversions
5! with -fdec.
6!
7
8subroutine assert(expected, actual, str)
9  implicit none
10  character(*), intent(in) :: str
11  integer, intent(in)      :: expected, actual(9)
12  integer :: i
13  do i=1,9
14    if (expected .ne. actual(i)) then
15      write (*, '(A,I8,I8)') str, expected, actual(i)
16      STOP 1
17    endif
18  enddo
19end subroutine
20
21implicit none
22
23logical(1), volatile :: op1_1l
24integer(1), volatile :: op1_1, op2_1
25
26logical(2), volatile :: op1_2l
27integer(2), volatile :: op1_2, op2_2
28
29logical(4), volatile :: op1_4l
30integer(4), volatile :: op1_4, op2_4
31
32integer, volatile :: expect, outs(9)
33
34
35op1_1l = .true.
36op1_2l = .true.
37op1_4l = .true.
38op1_1 = 117_1
39op1_2 = 117_2
40op1_4 = 117_4
41op2_1 =  49_1
42op2_2 =  49_2
43op2_4 =  49_4
44
45!!! Explicit integer operands
46
47expect = IAND(op1_1, op2_1)
48outs(1) = op1_1 .AND. op2_1
49outs(2) = op1_1 .AND. op2_2
50outs(3) = op1_1 .AND. op2_4
51outs(4) = op1_2 .AND. op2_1
52outs(5) = op1_2 .AND. op2_2
53outs(6) = op1_2 .AND. op2_4
54outs(7) = op1_4 .AND. op2_1
55outs(8) = op1_4 .AND. op2_2
56outs(9) = op1_4 .AND. op2_4
57call assert(expect, outs, "AND")
58
59expect = IOR(op1_1, op2_1)
60outs(1) = op1_1 .OR. op2_1
61outs(2) = op1_1 .OR. op2_2
62outs(3) = op1_1 .OR. op2_4
63outs(4) = op1_2 .OR. op2_1
64outs(5) = op1_2 .OR. op2_2
65outs(6) = op1_2 .OR. op2_4
66outs(7) = op1_4 .OR. op2_1
67outs(8) = op1_4 .OR. op2_2
68outs(9) = op1_4 .OR. op2_4
69
70call assert(expect, outs, "OR")
71
72expect = NOT(IEOR(op1_1, op2_1))
73outs(1) = op1_1 .EQV. op2_1
74outs(2) = op1_1 .EQV. op2_2
75outs(3) = op1_1 .EQV. op2_4
76outs(4) = op1_2 .EQV. op2_1
77outs(5) = op1_2 .EQV. op2_2
78outs(6) = op1_2 .EQV. op2_4
79outs(7) = op1_4 .EQV. op2_1
80outs(8) = op1_4 .EQV. op2_2
81outs(9) = op1_4 .EQV. op2_4
82
83call assert(expect, outs, "EQV")
84
85expect = IEOR(op1_1, op2_1)
86outs(1) = op1_1 .NEQV. op2_1
87outs(2) = op1_1 .NEQV. op2_2
88outs(3) = op1_1 .NEQV. op2_4
89outs(4) = op1_2 .NEQV. op2_1
90outs(5) = op1_2 .NEQV. op2_2
91outs(6) = op1_2 .NEQV. op2_4
92outs(7) = op1_4 .NEQV. op2_1
93outs(8) = op1_4 .NEQV. op2_2
94outs(9) = op1_4 .NEQV. op2_4
95
96call assert(expect, outs, "NEQV")
97
98!!! Logical -> Integer operand conversions
99op1_1 = op1_1l
100op1_2 = op1_2l
101op1_4 = op1_4l
102
103expect = IAND(op1_1, op2_1)
104outs(1) = op1_1l .AND. op2_1 ! implicit conversions
105outs(2) = op1_1l .AND. op2_2
106outs(3) = op1_1l .AND. op2_4
107outs(4) = op1_2l .AND. op2_1
108outs(5) = op1_2l .AND. op2_2
109outs(6) = op1_2l .AND. op2_4
110outs(7) = op1_4l .AND. op2_1
111outs(8) = op1_4l .AND. op2_2
112outs(9) = op1_4l .AND. op2_4
113call assert(expect, outs, "AND")
114
115expect = IOR(op1_1, op2_1)
116outs(1) = op1_1l .OR. op2_1 ! implicit conversions
117outs(2) = op1_1l .OR. op2_2
118outs(3) = op1_1l .OR. op2_4
119outs(4) = op1_2l .OR. op2_1
120outs(5) = op1_2l .OR. op2_2
121outs(6) = op1_2l .OR. op2_4
122outs(7) = op1_4l .OR. op2_1
123outs(8) = op1_4l .OR. op2_2
124outs(9) = op1_4l .OR. op2_4
125
126call assert(expect, outs, "OR")
127
128expect = NOT(IEOR(op1_1, op2_1))
129outs(1) = op1_1l .EQV. op2_1 ! implicit conversions
130outs(2) = op1_1l .EQV. op2_2
131outs(3) = op1_1l .EQV. op2_4
132outs(4) = op1_2l .EQV. op2_1
133outs(5) = op1_2l .EQV. op2_2
134outs(6) = op1_2l .EQV. op2_4
135outs(7) = op1_4l .EQV. op2_1
136outs(8) = op1_4l .EQV. op2_2
137outs(9) = op1_4l .EQV. op2_4
138
139call assert(expect, outs, "EQV")
140
141expect = IEOR(op1_1, op2_1)
142outs(1) = op1_1l .NEQV. op2_1 ! implicit conversions
143outs(2) = op1_1l .NEQV. op2_2
144outs(3) = op1_1l .NEQV. op2_4
145outs(4) = op1_2l .NEQV. op2_1
146outs(5) = op1_2l .NEQV. op2_2
147outs(6) = op1_2l .NEQV. op2_4
148outs(7) = op1_4l .NEQV. op2_1
149outs(8) = op1_4l .NEQV. op2_2
150outs(9) = op1_4l .NEQV. op2_4
151
152call assert(expect, outs, "NEQV")
153
154
155end
156