gdb/testsuite/gdb.fortran/dot-ops.exp

   1 # Copyright 2019-2023 Free Software Foundation, Inc.
   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 require allow_fortran_tests
  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."
  34             set xor ".XOR."
  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."
  49             set xor ".xor."
  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
  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
  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     }
 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."
 150 }
 151
 152 # Start of test script.
 153
 154 clean_restart
 155
 156 if {[set_lang_fortran]} {
 157     test_dot_operations
 158 } else {
 159     warning "$test_name tests suppressed." 0
 160 }
 161