binutils-gdb/gdb/testsuite/gdb.base/infcall-nested-structs.exp

170 lines
4.4 KiB
Plaintext
Raw Normal View History

# This testcase is part of GDB, the GNU debugger.
# Copyright 2018 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/>.
# Some targets can't call functions, so don't even bother with this
# test.
if [target_info exists gdb,cannot_call_functions] {
unsupported "this target can not call functions"
continue
}
set int_types { tc ts ti tl tll }
set float_types { tf td tld }
set complex_types { tfc tdc tldc }
set compile_flags {debug}
if [support_complex_tests] {
lappend compile_flags "additional_flags=-DTEST_COMPLEX"
}
# Given N (0..25), return the corresponding alphabetic letter in upper
# case.
proc I2A { n } {
return [string range "ABCDEFGHIJKLMNOPQRSTUVWXYZ" $n $n]
}
# Compile a variant of nested-structs.c using TYPES to specify the
# types of the struct fields within the source. Run up to main.
# Also updates the global "testfile" to reflect the most recent build.
proc start_nested_structs_test { types } {
global testfile
global srcfile
global binfile
global subdir
global srcdir
global compile_flags
standard_testfile .c
# Create the additional flags
set flags $compile_flags
for {set n 0} {$n<[llength ${types}]} {incr n} {
set m [I2A ${n}]
set t [lindex ${types} $n]
lappend flags "additional_flags=-Dt${m}=${t}"
append testfile "-" "$t"
}
set binfile [standard_output_file ${testfile}]
if { [gdb_compile "${srcdir}/${subdir}/${srcfile}" "${binfile}" executable "${flags}"] != "" } {
unresolved "failed to compile"
return 0
}
# Start with a fresh gdb.
clean_restart ${binfile}
# Make certain that the output is consistent
gdb_test_no_output "set print sevenbit-strings"
gdb_test_no_output "set print address off"
gdb_test_no_output "set print pretty off"
gdb_test_no_output "set width 0"
gdb_test_no_output "set print elements 300"
# Advance to main
if { ![runto_main] } then {
fail "can't run to main"
return 0
}
# Now continue forward to a suitable location to run the tests.
# Some targets only enable the FPU on first use, so ensure that we
# have used the FPU before we make calls from GDB to code that
# could use the FPU.
gdb_breakpoint [gdb_get_line_number "Break Here"] temporary
gdb_continue_to_breakpoint "breakpt" ".* Break Here\\. .*"
return 1
}
# Assuming GDB is stopped at main within a test binary, run some tests
# passing structures, and reading return value structures.
proc run_tests {} {
global gdb_prompt
foreach {name} {struct01 struct02 struct03 struct04} {
gdb_test "p/d check_arg_${name} (ref_val_${name})" "= 1"
set refval [ get_valueof "" "ref_val_${name}" "" ]
verbose -log "Refval: ${refval}"
set test "check return value ${name}"
if { ${refval} != "" } {
set answer [ get_valueof "" "rtn_str_${name} ()" "XXXX"]
verbose -log "Answer: ${answer}"
gdb_assert [string eq ${answer} ${refval}] ${test}
} else {
unresolved $test
}
}
}
# Set up a test prefix, compile the test binary, run to main, and then
# run some tests.
proc start_gdb_and_run_tests { types } {
set prefix "types"
foreach t $types {
append prefix "-" "${t}"
}
with_test_prefix $prefix {
if { [start_nested_structs_test $types] } {
run_tests
}
}
}
foreach ta $int_types {
start_gdb_and_run_tests $ta
}
if [support_complex_tests] {
foreach ta $complex_types {
start_gdb_and_run_tests $ta
}
}
if ![gdb_skip_float_test] {
foreach ta $float_types {
start_gdb_and_run_tests $ta
}
foreach ta $int_types {
foreach tb $float_types {
start_gdb_and_run_tests [list $ta $tb]
}
}
foreach ta $float_types {
foreach tb $int_types {
start_gdb_and_run_tests [list $ta $tb]
}
foreach tb $float_types {
start_gdb_and_run_tests [list $ta $tb]
}
}
}