forked from Imagelibrary/binutils-gdb
213516ef31
This commit is the result of running the gdb/copyright.py script, which automated the update of the copyright year range for all source files managed by the GDB project to be updated to include year 2023.
373 lines
10 KiB
Plaintext
373 lines
10 KiB
Plaintext
# Copyright 2022-2023 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/>.
|
|
|
|
# Format hex value VAL for language LANG.
|
|
|
|
proc hex_for_lang { lang val } {
|
|
set neg_p [regexp ^- $val]
|
|
set val [regsub ^-?0x $val ""]
|
|
if { $lang == "modula-2" } {
|
|
set val 0[string toupper $val]H
|
|
} else {
|
|
set val 0x$val
|
|
}
|
|
if { $neg_p } {
|
|
return -$val
|
|
} else {
|
|
return $val
|
|
}
|
|
}
|
|
|
|
# Determine whether N fits in type with TYPE_BITS and TYPE_SIGNEDNESS.
|
|
|
|
proc fits_in_type { n type_bits type_signedness } {
|
|
if { $type_signedness == "s" } {
|
|
set type_signed_p 1
|
|
} elseif { $type_signedness == "u" } {
|
|
set type_signed_p 0
|
|
} else {
|
|
error "unreachable"
|
|
}
|
|
|
|
if { $n < 0 && !$type_signed_p } {
|
|
# Can't fit a negative number in an unsigned type.
|
|
return 0
|
|
}
|
|
|
|
if { $n < 0} {
|
|
set n_sign -1
|
|
set n [expr -$n]
|
|
} else {
|
|
set n_sign 1
|
|
}
|
|
|
|
set smax [expr 1 << ($type_bits - 1)];
|
|
if { $n_sign == -1 } {
|
|
# Negative number, signed type.
|
|
return [expr ($n <= $smax)]
|
|
} elseif { $n_sign == 1 && $type_signed_p } {
|
|
# Positive number, signed type.
|
|
return [expr ($n < $smax)]
|
|
} elseif { $n_sign == 1 && !$type_signed_p } {
|
|
# Positive number, unsigned type.
|
|
return [expr ($n >> $type_bits) == 0]
|
|
} else {
|
|
error "unreachable"
|
|
}
|
|
}
|
|
|
|
# Return 1 if LANG is a c-like language, in the sense that it uses the same
|
|
# parser.
|
|
|
|
proc c_like { lang } {
|
|
set res 0
|
|
switch $lang {
|
|
c
|
|
- c++
|
|
- asm
|
|
- objective-c
|
|
- opencl
|
|
- minimal {set res 1}
|
|
}
|
|
return $res
|
|
}
|
|
|
|
# Parse number N for LANG, and return a list of expected type and value.
|
|
|
|
proc parse_number { lang n } {
|
|
global re_overflow
|
|
|
|
set hex_p [regexp ^-?0x $n]
|
|
|
|
global hex decimal
|
|
if { $hex_p } {
|
|
set any $hex
|
|
} else {
|
|
set any $decimal
|
|
}
|
|
|
|
global sizeof_long_long sizeof_long sizeof_int
|
|
set long_long_bits [expr $sizeof_long_long * 8]
|
|
set long_bits [expr $sizeof_long * 8]
|
|
set int_bits [expr $sizeof_int * 8]
|
|
|
|
if { $lang == "rust" } {
|
|
if { [fits_in_type $n 32 s] } {
|
|
return [list "i32" $n]
|
|
} elseif { [fits_in_type $n 64 s] } {
|
|
return [list "i64" $n]
|
|
} elseif { [fits_in_type $n 64 u] } {
|
|
# Note: Interprets MAX_U64 as -1.
|
|
return [list "i64" $n]
|
|
} else {
|
|
# Overflow.
|
|
return [list $re_overflow $re_overflow]
|
|
}
|
|
} elseif { $lang == "d" } {
|
|
if { [fits_in_type $n 32 s] } {
|
|
return [list int $n]
|
|
} elseif { [fits_in_type $n 32 u] } {
|
|
if { $hex_p } {
|
|
return [list uint $n]
|
|
} else {
|
|
return [list long $n]
|
|
}
|
|
} elseif { [fits_in_type $n 64 s] } {
|
|
return [list long $n]
|
|
} elseif { [fits_in_type $n 64 u] } {
|
|
return [list ulong $n]
|
|
} else {
|
|
# Overflow.
|
|
return [list $re_overflow $re_overflow]
|
|
}
|
|
} elseif { $lang == "ada" } {
|
|
if { [fits_in_type $n $int_bits s] } {
|
|
return [list "<$sizeof_int-byte integer>" $n]
|
|
} elseif { [fits_in_type $n $long_bits s] } {
|
|
return [list "<$sizeof_long-byte integer>" $n]
|
|
} elseif { [fits_in_type $n $long_bits u] } {
|
|
return [list "<$sizeof_long-byte integer>" $n]
|
|
} elseif { [fits_in_type $n $long_long_bits s] } {
|
|
return [list "<$sizeof_long_long-byte integer>" $n]
|
|
} elseif { [fits_in_type $n $long_long_bits u] } {
|
|
# Note: Interprets ULLONG_MAX as -1.
|
|
return [list "<$sizeof_long_long-byte integer>" $n]
|
|
} else {
|
|
# Overflow.
|
|
return [list $re_overflow $re_overflow]
|
|
}
|
|
} elseif { $lang == "modula-2" } {
|
|
if { [string equal $n -0] } {
|
|
# Note: 0 is CARDINAL, but -0 is an INTEGER.
|
|
return [list "INTEGER" 0]
|
|
}
|
|
if { $n < 0 && [fits_in_type $n $int_bits s] } {
|
|
return [list "INTEGER" $n]
|
|
} elseif { [fits_in_type $n $int_bits u] } {
|
|
return [list "CARDINAL" $n]
|
|
} else {
|
|
# Overflow.
|
|
return [list $re_overflow $re_overflow]
|
|
}
|
|
} elseif { $lang == "fortran" } {
|
|
if { [fits_in_type $n $int_bits s] } {
|
|
return [list int $n]
|
|
} elseif { [fits_in_type $n $int_bits u] } {
|
|
return [list "unsigned int" $n]
|
|
} elseif { [fits_in_type $n $long_bits s] } {
|
|
return [list long $n]
|
|
} elseif { [fits_in_type $n $long_bits u] } {
|
|
return [list "unsigned long" $n]
|
|
} else {
|
|
# Overflow.
|
|
return [list $re_overflow $re_overflow]
|
|
}
|
|
} else {
|
|
if { [c_like $lang] } {
|
|
if { $hex_p } {
|
|
# C Hex.
|
|
set have_unsigned 1
|
|
} else {
|
|
# C Decimal. Unsigned not allowed according.
|
|
if { [fits_in_type $n $long_long_bits s] } {
|
|
# Fits in largest signed type.
|
|
set have_unsigned 0
|
|
} else {
|
|
# Doesn't fit in largest signed type, so ill-formed, but
|
|
# allow unsigned as a convenience, as compilers do (though
|
|
# with a warning).
|
|
set have_unsigned 1
|
|
}
|
|
}
|
|
} else {
|
|
# Non-C.
|
|
set have_unsigned 1
|
|
}
|
|
|
|
if { [fits_in_type $n $int_bits s] } {
|
|
return [list int $n]
|
|
} elseif { $have_unsigned && [fits_in_type $n $int_bits u] } {
|
|
return [list "unsigned int" $n]
|
|
} elseif { [fits_in_type $n $long_bits s] } {
|
|
return [list long $n]
|
|
} elseif { $have_unsigned && [fits_in_type $n $long_bits u] } {
|
|
return [list "unsigned long" $n]
|
|
} elseif { [fits_in_type $n $long_long_bits s] } {
|
|
return [list "long long" $n]
|
|
} elseif { $have_unsigned && [fits_in_type $n $long_long_bits u] } {
|
|
return [list "unsigned long long" $n]
|
|
} else {
|
|
# Overflow.
|
|
return [list $re_overflow $re_overflow]
|
|
}
|
|
}
|
|
|
|
error "unreachable"
|
|
}
|
|
|
|
# Test parsing numbers. Several language parsers had the same bug
|
|
# around parsing large 64-bit numbers, hitting undefined behavior, and
|
|
# thus crashing a GDB built with UBSan. This testcase goes over all
|
|
# languages exercising printing the max 64-bit number, making sure
|
|
# that GDB doesn't crash. ARCH is the architecture to test with.
|
|
|
|
proc test_parse_numbers {arch} {
|
|
global full_arch_testing
|
|
global tested_archs
|
|
global verbose
|
|
|
|
set arch_re [string_to_regexp $arch]
|
|
gdb_test "set architecture $arch" "The target architecture is set to \"$arch_re\"."
|
|
|
|
gdb_test_no_output "set language c"
|
|
|
|
# Types have different sizes depending on the architecture.
|
|
# Figure out type sizes before matching patterns in the upcoming
|
|
# tests.
|
|
|
|
global sizeof_long_long sizeof_long sizeof_int sizeof_short
|
|
set sizeof_long_long [get_sizeof "long long" -1]
|
|
set sizeof_long [get_sizeof "long" -1]
|
|
set sizeof_int [get_sizeof "int" -1]
|
|
set sizeof_short [get_sizeof "short" -1]
|
|
|
|
if { ! $full_arch_testing } {
|
|
set arch_id \
|
|
[list $sizeof_long_long $sizeof_long $sizeof_long $sizeof_int \
|
|
$sizeof_short]
|
|
if { [lsearch $tested_archs $arch_id] == -1 } {
|
|
lappend tested_archs $arch_id
|
|
} else {
|
|
return
|
|
}
|
|
}
|
|
|
|
foreach_with_prefix lang $::all_languages {
|
|
if { $lang == "unknown" } {
|
|
# Tested outside $supported_archs loop.
|
|
continue
|
|
} elseif { $lang == "auto" || $lang == "local" } {
|
|
# Avoid duplicate testing.
|
|
continue
|
|
}
|
|
|
|
gdb_test_no_output "set language $lang"
|
|
|
|
global re_overflow
|
|
if { $lang == "modula-2" || $lang == "fortran" } {
|
|
set re_overflow "Overflow on numeric constant\\."
|
|
} elseif { $lang == "ada" } {
|
|
set re_overflow "Integer literal out of range"
|
|
} elseif { $lang == "rust" } {
|
|
set re_overflow "Integer literal is too large"
|
|
} else {
|
|
set re_overflow "Numeric constant too large\\."
|
|
}
|
|
|
|
set basevals {
|
|
0xffffffffffffffff
|
|
0x7fffffffffffffff
|
|
0xffffffff
|
|
0x7fffffff
|
|
0xffff
|
|
0x7fff
|
|
0xff
|
|
0x7f
|
|
0x0
|
|
}
|
|
|
|
if { $lang == "modula-2" } {
|
|
# Modula-2 is the only language that changes the type of an
|
|
# integral literal based on whether it's prefixed with "-",
|
|
# so test both scenarios.
|
|
set prefixes { "" "-" }
|
|
} else {
|
|
# For all the other languages, we'd just be testing the
|
|
# parsing twice, so just test the basic scenario of no prefix.
|
|
set prefixes { "" }
|
|
}
|
|
|
|
foreach_with_prefix prefix $prefixes {
|
|
foreach baseval $basevals {
|
|
foreach offset { -2 -1 0 1 2 } {
|
|
set dec_val [expr $baseval + $offset]
|
|
set hex_val [format "0x%llx" $dec_val]
|
|
if { $dec_val < 0 } {
|
|
continue
|
|
}
|
|
|
|
set dec_val $prefix$dec_val
|
|
lassign [parse_number $lang $dec_val] type out
|
|
if { $verbose >= 1 } { verbose -log "EXPECTED: $out" 2 }
|
|
if { $prefix == "" } {
|
|
gdb_test "p/u $dec_val" "$out"
|
|
} else {
|
|
gdb_test "p/d $dec_val" "$out"
|
|
}
|
|
if { $verbose >= 1 } { verbose -log "EXPECTED: $type" 2 }
|
|
gdb_test "ptype $dec_val" "$type"
|
|
|
|
if { $prefix == "-" } {
|
|
# Printing with /x below means negative numbers are
|
|
# converted to unsigned representation. We could
|
|
# support this by updating the expected patterns.
|
|
# Possibly, we could print with /u and /d instead of
|
|
# /x here as well (which would also require updating
|
|
# expected patterns).
|
|
# For now, this doesn't seem worth the trouble,
|
|
# so skip.
|
|
continue
|
|
}
|
|
|
|
set hex_val $prefix$hex_val
|
|
lassign [parse_number $lang $hex_val] type out
|
|
set hex_val [hex_for_lang $lang $hex_val]
|
|
if { $verbose >= 1 } { verbose -log "EXPECTED: $out" 2 }
|
|
gdb_test "p/x $hex_val" "$out"
|
|
if { $verbose >= 1 } { verbose -log "EXPECTED: $type" 2 }
|
|
gdb_test "ptype $hex_val" "$type"
|
|
}
|
|
}
|
|
}
|
|
}
|
|
}
|
|
|
|
clean_restart
|
|
|
|
set supported_archs [get_set_option_choices "set architecture"]
|
|
# There should be at least one more than "auto".
|
|
gdb_assert {[llength $supported_archs] > 1} "at least one architecture"
|
|
|
|
set all_languages [get_set_option_choices "set language"]
|
|
|
|
gdb_test_no_output "set language unknown"
|
|
gdb_test "p/x 0" \
|
|
"expression parsing not implemented for language \"Unknown\""
|
|
|
|
# If 1, test each arch. If 0, test one arch for each sizeof
|
|
# short/int/long/longlong configuration.
|
|
# For a build with --enable-targets=all, full_arch_testing == 0 takes 15s,
|
|
# while full_arch_testing == 1 takes 9m20s.
|
|
set full_arch_testing 0
|
|
|
|
set tested_archs {}
|
|
foreach_with_prefix arch $supported_archs {
|
|
if {$arch == "auto"} {
|
|
# Avoid duplicate testing.
|
|
continue
|
|
}
|
|
test_parse_numbers $arch
|
|
}
|