binutils-gdb/gdb/testsuite/gdb.base/bitshift.exp
Bruno Larsen cdd4206647 gdb/testsuite: fix "continue outside of loop" TCL errors
Many test cases had a few lines in the beginning that look like:

if { condition } {
  continue
}

Where conditions varied, but were mostly in the form of ![runto_main] or
[skip_*_tests], making it quite clear that this code block was supposed
to finish the test if it entered the code block. This generates TCL
errors, as most of these tests are not inside loops.  All cases on which
this was an obvious mistake are changed in this patch.
2022-05-16 10:07:43 -03:00

369 lines
11 KiB
Plaintext

# Copyright 2022 Free Software Foundation, Inc.
# This program is free software; you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by
# the Free Software Foundation; either version 3 of the License, or
# (at your option) any later version.
#
# This program is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
# GNU General Public License for more details.
#
# You should have received a copy of the GNU General Public License
# along with this program. If not, see <http://www.gnu.org/licenses/>.
# Test left and right bit shifting, in all languages that have such
# operator.
clean_restart
# Test a print command that prints out RESULT_RE. If WARNING_OR_ERROR
# is non-empty, it is expected that for languages other than Go, GDB
# prints this warning before the print result. For Go, this is an
# expected error. If WARNING_OR_ERROR is empty, it is expected that
# GDB prints no text other than the print result.
proc test_shift {lang cmd result_re {warning_or_error ""}} {
set cmd_re [string_to_regexp $cmd]
if {$lang == "go"} {
if {$warning_or_error != ""} {
set error_re "[string_to_regexp $warning_or_error]"
gdb_test_multiple $cmd "" {
-re -wrap "^$cmd_re\r\n$error_re" {
pass $gdb_test_name
}
}
} else {
gdb_test_multiple $cmd "" {
-re -wrap "^$cmd_re\r\n\\$$::decimal$result_re" {
pass $gdb_test_name
}
}
}
} else {
if {$warning_or_error != ""} {
set warning_re "warning: [string_to_regexp $warning_or_error]\r\n"
} else {
set warning_re ""
}
gdb_test_multiple $cmd "" {
-re -wrap "^$cmd_re\r\n$warning_re\\$$::decimal$result_re" {
pass $gdb_test_name
}
}
}
}
# Some warnings/errors GDB outputs.
set rs_negative_shift_count "right shift count is negative"
set rs_too_large_shift_count "right shift count >= width of type"
set ls_negative_shift_count "left shift count is negative"
set ls_too_large_shift_count "left shift count >= width of type"
# Test a left shift that results in a too-large shift count warning in
# all languages except Go.
proc test_lshift_tl {lang cmd result_re} {
if {$lang != "go"} {
test_shift $lang $cmd $result_re $::ls_too_large_shift_count
} else {
test_shift $lang $cmd $result_re
}
}
# Test a right shift that results in a too-large shift count warning
# in all languages except Go.
proc test_rshift_tl {lang cmd result_re} {
if {$lang != "go"} {
test_shift $lang $cmd $result_re $::rs_too_large_shift_count
} else {
test_shift $lang $cmd $result_re
}
}
# Return VAL, an integer value converted/cast to the right type for
# LANG. SIGNED indicates whether the type should be signed or
# unsigned. BITS indicates the bit width of the type. E.g., signed=0
# and bits=32 results in:
# Go => "uint($VAL)"
# D => "cast(uint) $VAL"
# Rust => "$VAL as i32"
# C/C++/others => "(unsigned int) $VAL"
proc make_val_cast {lang signed bits val} {
if {$lang == "go"} {
if {$signed} {
set sign_prefix ""
} else {
set sign_prefix "u"
}
return "${sign_prefix}int${bits}($val)"
} elseif {$lang == "d"} {
if {$signed} {
set sign_prefix ""
} else {
set sign_prefix "u"
}
if {$bits == 8} {
set type "byte"
} elseif {$bits == 16} {
set type "short"
} elseif {$bits == 32} {
set type "int"
} elseif {$bits == 64} {
set type "long"
} else {
error "$lang: unsupported bits"
}
return "cast(${sign_prefix}$type) $val"
} elseif {$lang == "rust"} {
if {$signed} {
set sign_prefix "i"
} else {
set sign_prefix "u"
}
return "$val as ${sign_prefix}$bits"
} else {
# C-like cast.
if {$signed} {
set sign_prefix ""
} else {
set sign_prefix "un"
}
if {$bits == 8} {
set type "char"
} elseif {$bits == 16} {
set type "short"
} elseif {$bits == 32} {
set type "int"
} elseif {$bits == 64} {
if {$lang == "opencl"} {
set type "long"
} else {
set type "long long"
}
} else {
error "$lang: unsupported bits"
}
return "(${sign_prefix}signed $type) $val"
}
}
# Generate make_int8 ... make_uint64 convenience procs, wrappers
# around make_val_cast.
foreach signed {0 1} {
if {$signed} {
set sign_prefix ""
} else {
set sign_prefix "u"
}
foreach bits {8 16 32 64} {
proc make_${sign_prefix}int${bits} {lang val} \
"make_val_cast \$lang $signed $bits \$val"
}
}
# Test bitshifting, particularly with negative shift counts and
# too-large-for-type shift counts. Exercises all C-like-ish
# languages.
proc test_shifts {} {
global ls_negative_shift_count rs_negative_shift_count
# Extract the set of all supported languages. We try all except
# languages we know wouldn't work. We do this instead of
# hardcoding the set of languages that we know work, so that if
# GDB gains a new language, it is automatically exercised.
set supported_langs [get_set_option_choices "set language"]
foreach_with_prefix lang $supported_langs {
set skip_langs {
"unknown" "ada" "modula-2" "pascal" "fortran"
}
if {[lsearch -exact $skip_langs $lang] >= 0} {
return
}
gdb_test_no_output "set language $lang"
# Make sure a signed left shift that overflows, i.e., whose
# result isn't representable in the signed type of the lhs,
# which is actually undefined, doesn't crash GDB when is it
# built with UBSan.
with_test_prefix "lsh overflow" {
test_shift $lang "print /x 0x0fffffffffffffff << 8" \
" = 0xffffffffffffff00"
test_shift $lang "print /x 0x0fffffff << 8" \
" = 0xffffff00"
# Make sure the result is still signed when the lhs was
# signed.
test_shift $lang "print 0x0fffffffffffffff << 8" " = -256"
test_shift $lang "print 0x0fffffff << 8" " = -256"
}
# 8-bit and 16-bit are promoted to int.
with_test_prefix "8-bit, promoted" {
foreach lhs \
[list \
[make_int8 $lang 0x0f] \
[make_uint8 $lang 0x0f]] \
{
test_shift $lang "print /x $lhs << 8" " = 0xf00"
test_shift $lang "print $lhs << 8" " = 3840"
}
}
with_test_prefix "16-bit, promoted" {
foreach lhs \
[list \
[make_int16 $lang 0x0fff] \
[make_uint16 $lang 0x0fff]] \
{
test_shift $lang "print /x $lhs << 8" " = 0xfff00"
test_shift $lang "print $lhs << 8" " = 1048320"
}
}
# Similarly, test shifting with both negative and too-large
# rhs. Both cases are undefined, but GDB lets them go through
# anyhow, similarly to how compilers don't error out. Try
# both signed and unsigned lhs.
# 8-bit lhs, signed and unsigned. These get promoted to
# 32-bit int.
with_test_prefix "8-bit, invalid" {
foreach lhs \
[list \
[make_int8 $lang 0x7f] \
[make_uint8 $lang 0xff]] \
{
test_shift $lang "print $lhs << -1" " = 0" \
$ls_negative_shift_count
test_shift $lang "print $lhs >> -1" " = 0" \
$rs_negative_shift_count
test_shift $lang "print/x $lhs << 8" " = 0x(7|f)f00"
test_shift $lang "print/x $lhs >> 8" " = 0x0"
test_lshift_tl $lang "print $lhs << 32" " = 0"
test_rshift_tl $lang "print $lhs >> 32" " = 0"
test_lshift_tl $lang "print $lhs << 33" " = 0"
test_rshift_tl $lang "print $lhs >> 33" " = 0"
}
}
# 16-bit lhs, signed and unsigned. These get promoted to 32-bit int.
with_test_prefix "16-bit, invalid" {
foreach {lhs res} \
[list \
[make_int16 $lang 0x7fff] 0x7fff \
[make_uint16 $lang 0xffff] 0xffff] \
{
test_shift $lang "print $lhs << -1" " = 0" \
$ls_negative_shift_count
test_shift $lang "print $lhs >> -1" " = 0" \
$rs_negative_shift_count
# Confirm shifting by 0 doesn't warn.
test_shift $lang "print/x $lhs << 0" " = $res"
test_shift $lang "print/x $lhs >> 0" " = $res"
# These don't overflow due to promotion.
test_shift $lang "print/x $lhs << 16" " = 0x(7|f)fff0000"
test_shift $lang "print/x $lhs >> 16" " = 0x0"
test_lshift_tl $lang "print $lhs << 32" " = 0"
test_rshift_tl $lang "print $lhs >> 32" " = 0"
test_lshift_tl $lang "print $lhs << 33" " = 0"
test_rshift_tl $lang "print $lhs >> 33" " = 0"
}
}
# 32-bit lhs, signed and unsigned.
with_test_prefix "32-bit, invalid" {
foreach {lhs res} \
[list \
[make_int32 $lang 0x7fffffff] 0x7fffffff \
[make_uint32 $lang 0xffffffff] 0xffffffff] \
{
test_shift $lang "print $lhs << -1" " = 0" \
$ls_negative_shift_count
test_shift $lang "print $lhs >> -1" " = 0" \
$rs_negative_shift_count
# Confirm shifting by 0 doesn't warn.
test_shift $lang "print/x $lhs << 0" " = $res"
test_shift $lang "print/x $lhs >> 0" " = $res"
test_lshift_tl $lang "print $lhs << 32" " = 0"
test_rshift_tl $lang "print $lhs >> 32" " = 0"
test_lshift_tl $lang "print $lhs << 33" " = 0"
test_rshift_tl $lang "print $lhs >> 33" " = 0"
}
}
# 64-bit lhs, signed and unsigned.
with_test_prefix "64-bit, invalid" {
foreach {lhs res} \
[list \
[make_int64 $lang 0x7fffffffffffffff] \
0x7fffffffffffffff \
\
[make_uint64 $lang 0xffffffffffffffff] \
0xffffffffffffffff] \
{
test_shift $lang "print $lhs << -1" " = 0" \
$ls_negative_shift_count
test_shift $lang "print $lhs >> -1" " = 0" \
$rs_negative_shift_count
# Confirm shifting by 0 doesn't warn.
test_shift $lang "print/x $lhs << 0" " = $res"
test_shift $lang "print/x $lhs >> 0" " = $res"
test_lshift_tl $lang "print $lhs << 64" " = 0"
test_rshift_tl $lang "print $lhs >> 64" " = 0"
test_lshift_tl $lang "print $lhs << 65" " = 0"
test_rshift_tl $lang "print $lhs >> 65" " = 0"
}
}
# Right shift a negative number by a negative amount.
with_test_prefix "neg lhs/rhs" {
test_shift $lang "print -1 >> -1" " = -1" $rs_negative_shift_count
test_shift $lang "print -4 >> -2" " = -1" $rs_negative_shift_count
}
# Check right shifting a negative value. For C++, this is
# implementation-defined, up until C++20. In most
# implementations, this performs an arithmetic right shift, so
# that the result remains negative. Currently, GDB does
# whatever the host's compiler does. If that turns out wrong
# for some host/target, then GDB should be taught to ask the
# target gdbarch what to do.
with_test_prefix "rsh neg lhs" {
test_shift $lang "print -1 >> 0" " = -1"
test_shift $lang "print -1 >> 1" " = -1"
test_shift $lang "print -8 >> 1" " = -4"
test_shift $lang "print [make_int64 $lang -8] >> 1" " = -4"
}
# Make sure an unsigned 64-bit value with high bit set isn't
# confused for a negative shift count in the warning messages.
with_test_prefix "max-uint64" {
test_lshift_tl $lang \
"print 1 << [make_uint64 $lang 0xffffffffffffffff]" " = 0"
test_rshift_tl $lang \
"print 1 >> [make_uint64 $lang 0xffffffffffffffff]" " = 0"
test_lshift_tl $lang \
"print -1 << [make_uint64 $lang 0xffffffffffffffff]" " = 0"
test_rshift_tl $lang \
"print -1 >> [make_uint64 $lang 0xffffffffffffffff]" " = -1"
}
}
}
test_shifts