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

   1 # This testcase is part of GDB, the GNU debugger.
   2
   3 # Copyright 2018-2019 Free Software Foundation, Inc.
   4
   5 # This program is free software; you can redistribute it and/or modify
   6 # it under the terms of the GNU General Public License as published by
   7 # the Free Software Foundation; either version 3 of the License, or
   8 # (at your option) any later version.
   9 #
  10 # This program is distributed in the hope that it will be useful,
  11 # but WITHOUT ANY WARRANTY; without even the implied warranty of
  12 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  13 # GNU General Public License for more details.
  14 #
  15 # You should have received a copy of the GNU General Public License
  16 # along with this program.  If not, see <http://www.gnu.org/licenses/>.
  17
  18
  19 # Some targets can't call functions, so don't even bother with this
  20 # test.
  21
  22 if [target_info exists gdb,cannot_call_functions] {
  23     unsupported "this target can not call functions"
  24     continue
  25 }
  26
  27 set int_types { tc ts ti tl tll }
  28 set float_types { tf td tld }
  29 set complex_types { tfc tdc tldc }
  30
  31 set compile_flags {debug}
  32 if [support_complex_tests] {
  33     lappend compile_flags "additional_flags=-DTEST_COMPLEX"
  34 }
  35
  36 # Given N (0..25), return the corresponding alphabetic letter in upper
  37 # case.
  38
  39 proc I2A { n } {
  40     return [string range "ABCDEFGHIJKLMNOPQRSTUVWXYZ" $n $n]
  41 }
  42
  43 # Compile a variant of nested-structs.c using TYPES to specify the
  44 # types of the struct fields within the source.  Run up to main.
  45 # Also updates the global "testfile" to reflect the most recent build.
  46
  47 proc start_nested_structs_test { types } {
  48     global testfile
  49     global srcfile
  50     global binfile
  51     global subdir
  52     global srcdir
  53     global compile_flags
  54
  55     standard_testfile .c
  56
  57     # Create the additional flags
  58     set flags $compile_flags
  59
  60     for {set n 0} {$n<[llength ${types}]} {incr n} {
  61         set m [I2A ${n}]
  62         set t [lindex ${types} $n]
  63         lappend flags "additional_flags=-Dt${m}=${t}"
  64         append testfile "-" "$t"
  65     }
  66
  67     set binfile [standard_output_file ${testfile}]
  68     if  { [gdb_compile "${srcdir}/${subdir}/${srcfile}" "${binfile}" executable "${flags}"] != "" } {
  69         unresolved "failed to compile"
  70         return 0
  71     }
  72
  73     # Start with a fresh gdb.
  74     clean_restart ${binfile}
  75
  76     # Make certain that the output is consistent
  77     gdb_test_no_output "set print sevenbit-strings"
  78     gdb_test_no_output "set print address off"
  79     gdb_test_no_output "set print pretty off"
  80     gdb_test_no_output "set width 0"
  81     gdb_test_no_output "set print elements 300"
  82
  83     # Advance to main
  84     if { ![runto_main] } then {
  85         fail "can't run to main"
  86         return 0
  87     }
  88
  89     # Now continue forward to a suitable location to run the tests.
  90     # Some targets only enable the FPU on first use, so ensure that we
  91     # have used the FPU before we make calls from GDB to code that
  92     # could use the FPU.
  93     gdb_breakpoint [gdb_get_line_number "Break Here"] temporary
  94     gdb_continue_to_breakpoint "breakpt" ".* Break Here\\. .*"
  95
  96     return 1
  97 }
  98
  99 # Assuming GDB is stopped at main within a test binary, run some tests
 100 # passing structures, and reading return value structures.
 101
 102 proc run_tests {} {
 103     global gdb_prompt
 104
 105     foreach {name} {struct_01_01 struct_01_02 struct_01_03 struct_01_04
 106                     struct_02_01 struct_02_02 struct_02_03 struct_02_04
 107                     struct_04_01 struct_04_02 struct_04_03 struct_04_04
 108                     struct_05_01 struct_05_02 struct_05_03 struct_05_04} {
 109         gdb_test "p/d check_arg_${name} (ref_val_${name})" "= 1"
 110
 111         set refval [ get_valueof "" "ref_val_${name}" "" ]
 112         verbose -log "Refval: ${refval}"
 113
 114         set test "check return value ${name}"
 115         if { ${refval} != "" } {
 116             set answer [ get_valueof "" "rtn_str_${name} ()" "XXXX"]
 117             verbose -log "Answer: ${answer}"
 118             gdb_assert [string eq ${answer} ${refval}] ${test}
 119         } else {
 120             unresolved $test
 121         }
 122     }
 123 }
 124
 125 # Set up a test prefix, compile the test binary, run to main, and then
 126 # run some tests.
 127
 128 proc start_gdb_and_run_tests { types } {
 129     set prefix "types"
 130
 131     foreach t $types {
 132         append prefix "-" "${t}"
 133     }
 134
 135     with_test_prefix $prefix {
 136         if { [start_nested_structs_test $types] } {
 137             run_tests
 138         }
 139     }
 140 }
 141
 142 foreach ta $int_types {
 143     start_gdb_and_run_tests $ta
 144 }
 145
 146 if [support_complex_tests] {
 147     foreach ta $complex_types {
 148         start_gdb_and_run_tests $ta
 149     }
 150 }
 151
 152 if ![gdb_skip_float_test] {
 153     foreach ta $float_types {
 154         start_gdb_and_run_tests $ta
 155     }
 156
 157     foreach ta $int_types {
 158         foreach tb $float_types {
 159             start_gdb_and_run_tests [list $ta $tb]
 160         }
 161     }
 162
 163     foreach ta $float_types {
 164         foreach tb $int_types {
 165             start_gdb_and_run_tests [list $ta $tb]
 166         }
 167
 168         foreach tb $float_types {
 169             start_gdb_and_run_tests [list $ta $tb]
 170         }
 171     }
 172 }