1! { dg-do run }
2! { dg-options "-fdec" }
3!
4! Runtime tests to verify logical-to-bitwise operations perform as expected
5! with -fdec.
6!
7
8subroutine assert(expected, actual, str)
9  implicit none
10  character(*), intent(in) :: str
11  integer, intent(in)      :: expected, actual
12  if (actual .ne. expected) then
13    write (*, '(A,I4,I4)') str, expected, actual
14    STOP 1
15  endif
16end subroutine
17
18implicit none
19
20integer expected, expected_expr
21integer output_vars, output_const, output_expr
22integer op1, op2, mult
23
24mult = 3
25op1 = 3
26op2 = 5
27
28!!!! AND -> IAND
29
30expected      = IAND(op1, op2)
31expected_expr = mult*expected
32
33output_const  = 3 .AND. 5
34output_vars   = op1 .AND. op2
35output_expr   = mult * (op1 .AND. op2)
36
37call assert(expected, output_vars,      "( ) and")
38call assert(expected, output_const,     "(c) and")
39call assert(expected_expr, output_expr, "(x) and")
40
41!!!! EQV -> NOT IEOR
42
43expected   = NOT(IEOR(op1, op2))
44expected_expr = mult*expected
45
46output_const    = 3 .EQV. 5
47output_vars     = op1 .EQV. op2
48output_expr     = mult * (op1 .EQV. op2)
49
50call assert(expected, output_vars,       "( ) EQV")
51call assert(expected, output_const,      "(c) EQV")
52call assert(expected_expr, output_expr,  "(x) EQV")
53
54!!!! NEQV -> IEOR
55
56expected   = IEOR(op1, op2)
57expected_expr = mult*expected
58
59output_const    = 3 .NEQV. 5
60output_vars     = op1 .NEQV. op2
61output_expr     = mult * (op1 .NEQV. op2)
62
63call assert(expected, output_vars,       "( ) NEQV")
64call assert(expected, output_const,      "(c) NEQV")
65call assert(expected_expr, output_expr,  "(x) NEQV")
66
67!!!! NOT -> NOT
68
69expected   = NOT(op2)
70expected_expr = mult*expected
71
72output_const    = .NOT. 5
73output_vars     = .NOT. op2
74output_expr     = mult * (.NOT. op2)
75
76call assert(expected, output_vars,       "( ) NOT")
77call assert(expected, output_const,      "(c) NOT")
78call assert(expected_expr, output_expr,  "(x) NOT")
79
80!!!! OR -> IOR
81
82expected   = IOR(op1, op2)
83expected_expr = mult*expected
84
85output_const    = 3 .OR. 5
86output_vars     = op1 .OR. op2
87output_expr     = mult * (op1 .OR. op2)
88
89call assert(expected, output_vars,       "( ) OR")
90call assert(expected, output_const,      "(c) OR")
91call assert(expected_expr, output_expr,  "(x) OR")
92
93!!!! XOR -> IEOR, not to be confused with .XOR.
94
95expected  = IEOR(op1, op2)
96expected_expr = mult*expected
97
98output_const    = 3 .XOR. 5
99output_vars     = op1 .XOR. op2
100output_expr     = mult * (op1 .XOR. op2)
101
102call assert(expected, output_vars,       "( ) XOR")
103call assert(expected, output_const,      "(c) XOR")
104call assert(expected_expr, output_expr,  "(x) XOR")
105
106end
107