Commit | Line | Data |
---|---|---|
88b9d363 | 1 | # Copyright 2019-2022 Free Software Foundation, Inc. |
c8f91604 AB |
2 | |
3 | # This program is free software; you can redistribute it and/or modify | |
4 | # it under the terms of the GNU General Public License as published by | |
5 | # the Free Software Foundation; either version 3 of the License, or | |
6 | # (at your option) any later version. | |
7 | # | |
8 | # This program is distributed in the hope that it will be useful, | |
9 | # but WITHOUT ANY WARRANTY; without even the implied warranty of | |
10 | # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the | |
11 | # GNU General Public License for more details. | |
12 | # | |
13 | # You should have received a copy of the GNU General Public License | |
14 | # along with this program. If not, see <http://www.gnu.org/licenses/>. | |
15 | ||
16 | # This file tests GDB's handling of some of the builtin logical and | |
17 | # arithmetic dot operators in Fortran, for example `.AND.` and `.LE.`. | |
18 | ||
19 | load_lib "fortran.exp" | |
20 | ||
21 | if { [skip_fortran_tests] } { continue } | |
22 | ||
23 | proc test_dot_operations {} { | |
24 | ||
25 | foreach_with_prefix format { "uppercase" "lowercase" } { | |
26 | if {$format == "uppercase"} { | |
27 | set true ".TRUE." | |
28 | set false ".FALSE." | |
29 | set and ".AND." | |
30 | set or ".OR." | |
31 | set not ".NOT." | |
32 | set eqv ".EQV." | |
33 | set neqv ".NEQV." | |
170f4b23 | 34 | set xor ".XOR." |
c8f91604 AB |
35 | set eq ".EQ." |
36 | set ne ".NE." | |
37 | set le ".LE." | |
38 | set ge ".GE." | |
39 | set lt ".LT." | |
40 | set gt ".GT." | |
41 | } else { | |
42 | set true ".true." | |
43 | set false ".false." | |
44 | set and ".and." | |
45 | set or ".or." | |
46 | set not ".not." | |
47 | set eqv ".eqv." | |
48 | set neqv ".neqv." | |
170f4b23 | 49 | set xor ".xor." |
c8f91604 AB |
50 | set eq ".eq." |
51 | set ne ".ne." | |
52 | set le ".le." | |
53 | set ge ".ge." | |
54 | set lt ".lt." | |
55 | set gt ".gt." | |
56 | } | |
57 | ||
58 | # Logical AND | |
59 | gdb_test "p $true $and $true" " = .TRUE." | |
60 | gdb_test "p $true $and $false" " = .FALSE." | |
61 | gdb_test "p $false $and $true" " = .FALSE." | |
62 | gdb_test "p $false $and $false" " = .FALSE." | |
63 | ||
64 | # Logical OR | |
65 | gdb_test "p $true $or $true" " = .TRUE." | |
66 | gdb_test "p $true $or $false" " = .TRUE." | |
67 | gdb_test "p $false $or $true" " = .TRUE." | |
68 | gdb_test "p $false $or $false" " = .FALSE." | |
69 | ||
70 | # Logical NOT | |
71 | gdb_test "p $not $true" " = .FALSE." | |
72 | gdb_test "p $not $false" " = .TRUE." | |
73 | ||
74 | # Logical EQV | |
75 | gdb_test "p $true $eqv $true" " = .TRUE." | |
76 | gdb_test "p $true $eqv $false" " = .FALSE." | |
77 | gdb_test "p $false $eqv $true" " = .FALSE." | |
78 | gdb_test "p $false $eqv $false" " = .TRUE." | |
79 | ||
80 | # Logical NEQV | |
81 | gdb_test "p $true $neqv $true" " = .FALSE." | |
82 | gdb_test "p $true $neqv $false" " = .TRUE." | |
83 | gdb_test "p $false $neqv $true" " = .TRUE." | |
84 | gdb_test "p $false $neqv $false" " = .FALSE." | |
85 | ||
170f4b23 AB |
86 | # And the legacy alias for NEQV, XOR |
87 | gdb_test "p $true $xor $true" " = .FALSE." | |
88 | gdb_test "p $true $xor $false" " = .TRUE." | |
89 | gdb_test "p $false $xor $true" " = .TRUE." | |
90 | gdb_test "p $false $xor $false" " = .FALSE." | |
91 | ||
c8f91604 AB |
92 | # Arithmetic EQ |
93 | gdb_test "p 5 $eq 4" " = .FALSE." | |
94 | gdb_test "p 4 $eq 4" " = .TRUE." | |
95 | ||
96 | # Arithmetic NE | |
97 | gdb_test "p 5 $ne 4" " = .TRUE." | |
98 | gdb_test "p 4 $ne 4" " = .FALSE." | |
99 | ||
100 | # Arithmetic LE | |
101 | gdb_test "p 5 $le 4" " = .FALSE." | |
102 | gdb_test "p 4 $le 4" " = .TRUE." | |
103 | gdb_test "p 3 $le 4" " = .TRUE." | |
104 | ||
105 | # Arithmetic LT | |
106 | gdb_test "p 5 $lt 4" " = .FALSE." | |
107 | gdb_test "p 4 $lt 4" " = .FALSE." | |
108 | gdb_test "p 3 $lt 4" " = .TRUE." | |
109 | ||
110 | # Arithmetic GE | |
111 | gdb_test "p 5 $ge 4" " = .TRUE." | |
112 | gdb_test "p 4 $ge 4" " = .TRUE." | |
113 | gdb_test "p 3 $ge 4" " = .FALSE." | |
114 | ||
115 | # Arithmetic GT | |
116 | gdb_test "p 5 $gt 4" " = .TRUE." | |
117 | gdb_test "p 4 $gt 4" " = .FALSE." | |
118 | gdb_test "p 3 $gt 4" " = .FALSE." | |
119 | } | |
7c654b71 AB |
120 | |
121 | # Now test the symbol based comparison operators. | |
122 | ||
123 | # Arithmetic EQ | |
124 | gdb_test "p 5 == 4" " = .FALSE." | |
125 | gdb_test "p 4 == 4" " = .TRUE." | |
126 | ||
127 | # Arithmetic NE | |
128 | gdb_test "p 5 /= 4" " = .TRUE." | |
129 | gdb_test "p 4 /= 4" " = .FALSE." | |
130 | ||
131 | # Arithmetic LE | |
132 | gdb_test "p 5 <= 4" " = .FALSE." | |
133 | gdb_test "p 4 <= 4" " = .TRUE." | |
134 | gdb_test "p 3 <= 4" " = .TRUE." | |
135 | ||
136 | # Arithmetic LT | |
137 | gdb_test "p 5 < 4" " = .FALSE." | |
138 | gdb_test "p 4 < 4" " = .FALSE." | |
139 | gdb_test "p 3 < 4" " = .TRUE." | |
140 | ||
141 | # Arithmetic GE | |
142 | gdb_test "p 5 >= 4" " = .TRUE." | |
143 | gdb_test "p 4 >= 4" " = .TRUE." | |
144 | gdb_test "p 3 >= 4" " = .FALSE." | |
145 | ||
146 | # Arithmetic GT | |
147 | gdb_test "p 5 > 4" " = .TRUE." | |
148 | gdb_test "p 4 > 4" " = .FALSE." | |
149 | gdb_test "p 3 > 4" " = .FALSE." | |
c8f91604 AB |
150 | } |
151 | ||
152 | # Start of test script. | |
153 | ||
154 | clean_restart | |
155 | ||
156 | if [set_lang_fortran] then { | |
157 | test_dot_operations | |
158 | } else { | |
159 | warning "$test_name tests suppressed." 0 | |
160 | } | |
161 |