[gdb/testsuite] Test more values in gdb.base/parse_numbers.exp

Currently we only test value 0xffffffffffffffff in test-case
gdb.base/parse_numbers.exp.

Test more interesting values, both in decimal and hex format, as well as
negative decimals for language modula-2.

This results in an increase in total tests from 15572 to 847448 (55 times
more tests).

Balance out the increase in runtime by reducing the number of architectures
tested: only test one architecture per sizeof longlong/long/int/short
combination, while keeping the possibility intact to run with all
architectures (through setting a variable in the test-case)

Results in slight reduction of total tests: 15572 -> 13853.

Document interesting cases in the expected results:
- wrapping from unsigned to signed
- truncation
- PR16377: using unsigned types to represent decimal constants in C

Running the test-case with a gdb build with -fsanitize=undefined, we trigger
two UB errors in the modula-2 parser, filed as PR29163.

Tested on x86_64-linux with --enable-targets=all.
This commit is contained in:
Tom de Vries
2022-06-04 13:17:32 +02:00
parent 0c05610450
commit 1b4633f812

View File

@ -16,13 +16,179 @@
# Format hex value VAL for language LANG. # Format hex value VAL for language LANG.
proc hex_for_lang { lang val } { proc hex_for_lang { lang val } {
set val [regsub ^0x $val ""] set neg_p [regexp ^- $val]
set val [regsub ^-?0x $val ""]
if { $lang == "modula-2" } { if { $lang == "modula-2" } {
set val 0[string toupper $val]H set val 0[string toupper $val]H
} else { } else {
set val 0x$val set val 0x$val
} }
return $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"
}
}
# 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.
# Some truncated value, should be re_overflow.
return [list i64 $any]
}
} 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.
# Some truncated value or re_overflow, should be re_overflow.
return [list "($re_overflow|<$decimal-byte integer>)" \
($re_overflow|$any)]
}
} 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.
# Some truncated value or re_overflow, should be re_overflow.
return [list ($re_overflow|CARDINAL|INTEGER) ($re_overflow|$any)]
}
} 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.
# Some truncated value or re_overflow, should be re_overflow.
return [list "((unsigned )?(int|long)|$re_overflow)" \
($any|$re_overflow)]
}
} else {
# This is wrong for c-like languages. For the decimal case, we
# shouldn't use unsigned.
# See PR 16377.
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]
} elseif { [fits_in_type $n $long_long_bits s] } {
return [list "long long" $n]
} elseif { [fits_in_type $n $long_long_bits u] } {
return [list "unsigned long long" $n]
} else {
# Overflow.
# Some truncated value or re_overflow, should be re_overflow.
return [list "((unsigned )?(int|long)|$re_overflow)" \
($any|$re_overflow)]
}
}
error "unreachable"
} }
# Test parsing numbers. Several language parsers had the same bug # Test parsing numbers. Several language parsers had the same bug
@ -32,6 +198,10 @@ proc hex_for_lang { lang val } {
# that GDB doesn't crash. ARCH is the architecture to test with. # that GDB doesn't crash. ARCH is the architecture to test with.
proc test_parse_numbers {arch} { proc test_parse_numbers {arch} {
global full_arch_testing
global tested_archs
global verbose
set arch_re [string_to_regexp $arch] set arch_re [string_to_regexp $arch]
gdb_test "set architecture $arch" "The target architecture is set to \"$arch_re\"." gdb_test "set architecture $arch" "The target architecture is set to \"$arch_re\"."
@ -41,24 +211,21 @@ proc test_parse_numbers {arch} {
# Figure out type sizes before matching patterns in the upcoming # Figure out type sizes before matching patterns in the upcoming
# tests. # tests.
global sizeof_long_long sizeof_long sizeof_int sizeof_short
set sizeof_long_long [get_sizeof "long long" -1] set sizeof_long_long [get_sizeof "long long" -1]
set sizeof_long [get_sizeof "long" -1] set sizeof_long [get_sizeof "long" -1]
set sizeof_int [get_sizeof "int" -1] set sizeof_int [get_sizeof "int" -1]
set sizeof_short [get_sizeof "short" -1]
if {$sizeof_long_long == 8 && $sizeof_long == 8} { if { ! $full_arch_testing } {
set 8B_type "unsigned long" set arch_id \
set fortran_type "unsigned long" [list $sizeof_long_long $sizeof_long $sizeof_long $sizeof_int \
set fortran_value "0xffffffffffffffff" $sizeof_short]
} elseif {$sizeof_long_long == 8 && $sizeof_long == 4 && $sizeof_int == 4} { if { [lsearch $tested_archs $arch_id] == -1 } {
set 8B_type "unsigned long long" lappend tested_archs $arch_id
set fortran_type "unsigned int" } else {
set fortran_value "0xffffffff" return
} elseif {$sizeof_long == 4 && $sizeof_int == 2} { }
set 8B_type "unsigned long long"
set fortran_type "unsigned long"
set fortran_value "0xffffffff"
} else {
error "missing case for long long = $sizeof_long_long, long = $sizeof_long, int = $sizeof_int"
} }
foreach_with_prefix lang $::all_languages { foreach_with_prefix lang $::all_languages {
@ -72,34 +239,78 @@ proc test_parse_numbers {arch} {
gdb_test_no_output "set language $lang" gdb_test_no_output "set language $lang"
set val "0xffffffffffffffff" global re_overflow
set val [hex_for_lang $lang $val] if { $lang == "modula-2" || $lang == "fortran" } {
if {$lang == "fortran"} { set re_overflow "Overflow on numeric constant\\."
gdb_test "p/x $val" " = $fortran_value" } elseif { $lang == "ada" } {
gdb_test "ptype $val" " = $fortran_type" set re_overflow "Integer literal out of range"
} elseif {$lang == "modula-2"} {
gdb_test "p/x $val" "Overflow on numeric constant\\."
} else { } else {
# D and Rust define their own built-in 64-bit types, and set re_overflow "Numeric constant too large\\."
# are thus always able to parse/print 64-bit values. }
if {$sizeof_long_long == 4 && $lang != "d" && $lang != "rust"} {
set out "0xffffffff" set basevals {
} else { 0xffffffffffffffff
set out $val 0x7fffffffffffffff
} 0xffffffff
gdb_test "p/x $val" " = $out" 0x7fffffff
if {$lang == "ada"} { 0xffff
if {$sizeof_long_long == 4} { 0x7fff
gdb_test "ptype $val" " = <4-byte integer>" 0xff
} else { 0x7f
gdb_test "ptype $val" " = <8-byte integer>" 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"
} }
} elseif {$lang == "d"} {
gdb_test "ptype $val" " = ulong"
} elseif {$lang == "rust"} {
gdb_test "ptype $val" " = i64"
} else {
gdb_test "ptype $val" " = $8B_type"
} }
} }
} }
@ -119,6 +330,13 @@ gdb_assert {[llength $supported_archs] > 1} "at least one architecture"
set all_languages [get_set_option_choices "set language"] set all_languages [get_set_option_choices "set language"]
# 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 { foreach_with_prefix arch $supported_archs {
if {$arch == "auto"} { if {$arch == "auto"} {
# Avoid duplicate testing. # Avoid duplicate testing.