gdb/testsuite/gdb.base/bitshift.exp

   1 # Copyright 2022-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 # Test left and right bit shifting, in all languages that have such
  17 # operator.
  18
  19 clean_restart
  20
  21 # Test a print command that prints out RESULT_RE.  If WARNING_OR_ERROR
  22 # is non-empty, it is expected that for languages other than Go, GDB
  23 # prints this warning before the print result.  For Go, this is an
  24 # expected error.  If WARNING_OR_ERROR is empty, it is expected that
  25 # GDB prints no text other than the print result.
  26 proc test_shift {lang cmd result_re {warning_or_error ""}} {
  27     set cmd_re [string_to_regexp $cmd]
  28
  29     if {$lang == "go"} {
  30         if {$warning_or_error != ""} {
  31             set error_re "[string_to_regexp $warning_or_error]"
  32             gdb_test_multiple $cmd "" {
  33                 -re -wrap "^$cmd_re\r\n$error_re" {
  34                     pass $gdb_test_name
  35                 }
  36             }
  37         } else {
  38             gdb_test_multiple $cmd "" {
  39                 -re -wrap "^$cmd_re\r\n\\$$::decimal$result_re" {
  40                     pass $gdb_test_name
  41                 }
  42             }
  43         }
  44     } else {
  45         if {$warning_or_error != ""} {
  46             set warning_re "warning: [string_to_regexp $warning_or_error]\r\n"
  47         } else {
  48             set warning_re ""
  49         }
  50
  51         gdb_test_multiple $cmd "" {
  52             -re -wrap "^$cmd_re\r\n$warning_re\\$$::decimal$result_re" {
  53                 pass $gdb_test_name
  54             }
  55         }
  56     }
  57 }
  58
  59 # Some warnings/errors GDB outputs.
  60 set rs_negative_shift_count "right shift count is negative"
  61 set rs_too_large_shift_count "right shift count >= width of type"
  62 set ls_negative_shift_count "left shift count is negative"
  63 set ls_too_large_shift_count "left shift count >= width of type"
  64
  65 # Test a left shift that results in a too-large shift count warning in
  66 # all languages except Go.
  67 proc test_lshift_tl {lang cmd result_re} {
  68     if {$lang != "go"} {
  69         test_shift $lang $cmd $result_re $::ls_too_large_shift_count
  70     } else {
  71         test_shift $lang $cmd $result_re
  72     }
  73 }
  74
  75 # Test a right shift that results in a too-large shift count warning
  76 # in all languages except Go.
  77 proc test_rshift_tl {lang cmd result_re} {
  78     if {$lang != "go"} {
  79         test_shift $lang $cmd $result_re $::rs_too_large_shift_count
  80     } else {
  81         test_shift $lang $cmd $result_re
  82     }
  83 }
  84
  85 # Return VAL, an integer value converted/cast to the right type for
  86 # LANG.  SIGNED indicates whether the type should be signed or
  87 # unsigned.  BITS indicates the bit width of the type.  E.g., signed=0
  88 # and bits=32 results in:
  89 #   Go            =>  "uint($VAL)"
  90 #   D             =>  "cast(uint) $VAL"
  91 #   Rust          =>  "$VAL as i32"
  92 #   C/C++/others  =>  "(unsigned int) $VAL"
  93 proc make_val_cast {lang signed bits val} {
  94     if {$lang == "go"} {
  95         if {$signed} {
  96             set sign_prefix ""
  97         } else {
  98             set sign_prefix "u"
  99         }
 100         return "${sign_prefix}int${bits}($val)"
 101     } elseif {$lang == "d"} {
 102         if {$signed} {
 103             set sign_prefix ""
 104         } else {
 105             set sign_prefix "u"
 106         }
 107         if {$bits == 8} {
 108             set type "byte"
 109         } elseif {$bits == 16} {
 110             set type "short"
 111         } elseif {$bits == 32} {
 112             set type "int"
 113         } elseif {$bits == 64} {
 114             set type "long"
 115         } else {
 116             error "$lang: unsupported bits"
 117         }
 118         return "cast(${sign_prefix}$type) $val"
 119     } elseif {$lang == "rust"} {
 120         if {$signed} {
 121             set sign_prefix "i"
 122         } else {
 123             set sign_prefix "u"
 124         }
 125         return "$val as ${sign_prefix}$bits"
 126     } else {
 127         # C-like cast.
 128         if {$signed} {
 129             set sign_prefix ""
 130         } else {
 131             set sign_prefix "un"
 132         }
 133         if {$bits == 8} {
 134             set type "char"
 135         } elseif {$bits == 16} {
 136             set type "short"
 137         } elseif {$bits == 32} {
 138             set type "int"
 139         } elseif {$bits == 64} {
 140             if {$lang == "opencl"} {
 141                 set type "long"
 142             } else {
 143                 set type "long long"
 144             }
 145         } else {
 146             error "$lang: unsupported bits"
 147         }
 148         return "(${sign_prefix}signed $type) $val"
 149     }
 150 }
 151
 152 # Generate make_int8 ... make_uint64 convenience procs, wrappers
 153 # around make_val_cast.
 154 foreach signed {0 1} {
 155     if {$signed} {
 156         set sign_prefix ""
 157     } else {
 158         set sign_prefix "u"
 159     }
 160     foreach bits {8 16 32 64} {
 161         proc make_${sign_prefix}int${bits} {lang val} \
 162             "make_val_cast \$lang $signed $bits \$val"
 163     }
 164 }
 165
 166 # Test bitshifting, particularly with negative shift counts and
 167 # too-large-for-type shift counts.  Exercises all C-like-ish
 168 # languages.
 169 proc test_shifts {} {
 170     global ls_negative_shift_count rs_negative_shift_count
 171
 172     # Extract the set of all supported languages.  We try all except
 173     # languages we know wouldn't work.  We do this instead of
 174     # hardcoding the set of languages that we know work, so that if
 175     # GDB gains a new language, it is automatically exercised.
 176     set supported_langs [get_set_option_choices "set language"]
 177
 178     foreach_with_prefix lang $supported_langs {
 179         set skip_langs {
 180             "unknown" "ada" "modula-2" "pascal" "fortran"
 181         }
 182         if {[lsearch -exact $skip_langs $lang] >= 0} {
 183             return
 184         }
 185
 186         gdb_test_no_output "set language $lang"
 187
 188         # Make sure a signed left shift that overflows, i.e., whose
 189         # result isn't representable in the signed type of the lhs,
 190         # which is actually undefined, doesn't crash GDB when is it
 191         # built with UBSan.
 192
 193         with_test_prefix "lsh overflow" {
 194             test_shift $lang "print /x 0x0fffffffffffffff << 8" \
 195                 " = 0xffffffffffffff00"
 196             test_shift $lang "print /x 0x0fffffff << 8" \
 197                 " = 0xffffff00"
 198
 199             # Make sure the result is still signed when the lhs was
 200             # signed.
 201             test_shift $lang "print 0x0fffffffffffffff << 8" " = -256"
 202             test_shift $lang "print 0x0fffffff << 8" " = -256"
 203         }
 204
 205         # 8-bit and 16-bit are promoted to int.
 206         with_test_prefix "8-bit, promoted" {
 207             foreach lhs \
 208                 [list \
 209                      [make_int8 $lang 0x0f] \
 210                      [make_uint8 $lang 0x0f]] \
 211             {
 212                 test_shift $lang "print /x $lhs << 8" " = 0xf00"
 213                 test_shift $lang "print $lhs << 8" " = 3840"
 214             }
 215         }
 216         with_test_prefix "16-bit, promoted" {
 217             foreach lhs \
 218                 [list \
 219                      [make_int16 $lang 0x0fff] \
 220                      [make_uint16 $lang 0x0fff]] \
 221             {
 222                 test_shift $lang "print /x $lhs << 8" " = 0xfff00"
 223                 test_shift $lang "print $lhs << 8" " = 1048320"
 224             }
 225         }
 226
 227         # Similarly, test shifting with both negative and too-large
 228         # rhs.  Both cases are undefined, but GDB lets them go through
 229         # anyhow, similarly to how compilers don't error out.  Try
 230         # both signed and unsigned lhs.
 231
 232         # 8-bit lhs, signed and unsigned.  These get promoted to
 233         # 32-bit int.
 234         with_test_prefix "8-bit, invalid" {
 235             foreach lhs \
 236                 [list \
 237                      [make_int8 $lang 0x7f] \
 238                      [make_uint8 $lang 0xff]] \
 239             {
 240                 test_shift $lang "print $lhs << -1" " = 0" \
 241                     $ls_negative_shift_count
 242                 test_shift $lang "print $lhs >> -1" " = 0" \
 243                     $rs_negative_shift_count
 244
 245                 test_shift $lang "print/x $lhs << 8" " = 0x(7|f)f00"
 246                 test_shift $lang "print/x $lhs >> 8" " = 0x0"
 247
 248                 test_lshift_tl $lang "print $lhs << 32" " = 0"
 249                 test_rshift_tl $lang "print $lhs >> 32" " = 0"
 250                 test_lshift_tl $lang "print $lhs << 33" " = 0"
 251                 test_rshift_tl $lang "print $lhs >> 33" " = 0"
 252             }
 253         }
 254
 255         # 16-bit lhs, signed and unsigned.  These get promoted to 32-bit int.
 256         with_test_prefix "16-bit, invalid" {
 257             foreach {lhs res} \
 258                 [list \
 259                      [make_int16 $lang 0x7fff] 0x7fff \
 260                      [make_uint16 $lang 0xffff] 0xffff] \
 261             {
 262                 test_shift $lang "print $lhs << -1" " = 0" \
 263                     $ls_negative_shift_count
 264                 test_shift $lang "print $lhs >> -1" " = 0" \
 265                     $rs_negative_shift_count
 266
 267                 # Confirm shifting by 0 doesn't warn.
 268                 test_shift $lang "print/x $lhs << 0" " = $res"
 269                 test_shift $lang "print/x $lhs >> 0" " = $res"
 270
 271                 # These don't overflow due to promotion.
 272                 test_shift $lang "print/x $lhs << 16" " = 0x(7|f)fff0000"
 273                 test_shift $lang "print/x $lhs >> 16" " = 0x0"
 274
 275                 test_lshift_tl $lang "print $lhs << 32" " = 0"
 276                 test_rshift_tl $lang "print $lhs >> 32" " = 0"
 277                 test_lshift_tl $lang "print $lhs << 33" " = 0"
 278                 test_rshift_tl $lang "print $lhs >> 33" " = 0"
 279             }
 280         }
 281
 282         # 32-bit lhs, signed and unsigned.
 283         with_test_prefix "32-bit, invalid" {
 284             foreach {lhs res} \
 285                 [list \
 286                      [make_int32 $lang 0x7fffffff] 0x7fffffff \
 287                      [make_uint32 $lang 0xffffffff] 0xffffffff] \
 288             {
 289                 test_shift $lang "print $lhs << -1" " = 0" \
 290                     $ls_negative_shift_count
 291                 test_shift $lang "print $lhs >> -1" " = 0" \
 292                     $rs_negative_shift_count
 293
 294                 # Confirm shifting by 0 doesn't warn.
 295                 test_shift $lang "print/x $lhs << 0" " = $res"
 296                 test_shift $lang "print/x $lhs >> 0" " = $res"
 297
 298                 test_lshift_tl $lang "print $lhs << 32" " = 0"
 299                 test_rshift_tl $lang "print $lhs >> 32" " = 0"
 300
 301                 test_lshift_tl $lang "print $lhs << 33" " = 0"
 302                 test_rshift_tl $lang "print $lhs >> 33" " = 0"
 303             }
 304         }
 305
 306         # 64-bit lhs, signed and unsigned.
 307         with_test_prefix "64-bit, invalid" {
 308             foreach {lhs res} \
 309                 [list \
 310                      [make_int64 $lang 0x7fffffffffffffff] \
 311                      0x7fffffffffffffff \
 312                      \
 313                      [make_uint64 $lang 0xffffffffffffffff] \
 314                      0xffffffffffffffff] \
 315             {
 316                 test_shift $lang "print $lhs << -1" " = 0" \
 317                     $ls_negative_shift_count
 318                 test_shift $lang "print $lhs >> -1" " = 0" \
 319                     $rs_negative_shift_count
 320
 321                 # Confirm shifting by 0 doesn't warn.
 322                 test_shift $lang "print/x $lhs << 0" " = $res"
 323                 test_shift $lang "print/x $lhs >> 0" " = $res"
 324
 325                 test_lshift_tl $lang "print $lhs << 64" " = 0"
 326                 test_rshift_tl $lang "print $lhs >> 64" " = 0"
 327
 328                 test_lshift_tl $lang "print $lhs << 65" " = 0"
 329                 test_rshift_tl $lang "print $lhs >> 65" " = 0"
 330             }
 331         }
 332
 333         # Right shift a negative number by a negative amount.
 334         with_test_prefix "neg lhs/rhs" {
 335             test_shift $lang "print -1 >> -1" " = -1" $rs_negative_shift_count
 336             test_shift $lang "print -4 >> -2" " = -1" $rs_negative_shift_count
 337         }
 338
 339         # Check right shifting a negative value.  For C++, this is
 340         # implementation-defined, up until C++20.  In most
 341         # implementations, this performs an arithmetic right shift, so
 342         # that the result remains negative.  Currently, GDB does
 343         # whatever the host's compiler does.  If that turns out wrong
 344         # for some host/target, then GDB should be taught to ask the
 345         # target gdbarch what to do.
 346         with_test_prefix "rsh neg lhs" {
 347             test_shift $lang "print -1 >> 0" " = -1"
 348             test_shift $lang "print -1 >> 1" " = -1"
 349             test_shift $lang "print -8 >> 1" " = -4"
 350             test_shift $lang "print [make_int64 $lang -8] >> 1" " = -4"
 351         }
 352
 353         # Make sure an unsigned 64-bit value with high bit set isn't
 354         # confused for a negative shift count in the warning messages.
 355         with_test_prefix "max-uint64" {
 356             test_lshift_tl $lang \
 357                 "print 1 << [make_uint64 $lang 0xffffffffffffffff]" " = 0"
 358             test_rshift_tl $lang \
 359                 "print 1 >> [make_uint64 $lang 0xffffffffffffffff]" " = 0"
 360             test_lshift_tl $lang \
 361                 "print -1 << [make_uint64 $lang 0xffffffffffffffff]" " = 0"
 362             test_rshift_tl $lang \
 363                 "print -1 >> [make_uint64 $lang 0xffffffffffffffff]" " = -1"
 364         }
 365     }
 366 }
 367
 368 test_shifts