# 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 . # 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] } } }