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 # Only test C++ if we are able.  Always use C.
  28 if { [skip_cplus_tests] || [get_compiler_info "c++"] } {
  29     set lang {c}
  30 } else {
  31     set lang {c c++}
  32 }
  33
  34 foreach l $lang {
  35     set dir "$l"
  36     remote_exec host "rm -rf [standard_output_file ${dir}]"
  37     remote_exec host "mkdir -p [standard_output_file ${dir}]"
  38 }
  39
  40
  41 set int_types { tc ts ti tl tll }
  42 set float_types { tf td tld }
  43 set complex_types { tfc tdc tldc }
  44
  45 set compile_flags {debug}
  46 if [support_complex_tests] {
  47     lappend compile_flags "additional_flags=-DTEST_COMPLEX"
  48     lappend compile_flags "additional_flags=-Wno-psabi"
  49 }
  50
  51 # Given N (0..25), return the corresponding alphabetic letter in upper
  52 # case.
  53
  54 proc I2A { n } {
  55     return [string range "ABCDEFGHIJKLMNOPQRSTUVWXYZ" $n $n]
  56 }
  57
  58 # Compile a variant of nested-structs.c using TYPES to specify the
  59 # types of the struct fields within the source.  Run up to main.
  60 # Also updates the global "testfile" to reflect the most recent build.
  61
  62 proc start_nested_structs_test { lang types } {
  63     global testfile
  64     global srcfile
  65     global binfile
  66     global subdir
  67     global srcdir
  68     global compile_flags
  69
  70     standard_testfile .c
  71     set dir "$lang"
  72
  73     # Create the additional flags
  74     set flags $compile_flags
  75     lappend flags $lang
  76
  77     for {set n 0} {$n<[llength ${types}]} {incr n} {
  78         set m [I2A ${n}]
  79         set t [lindex ${types} $n]
  80         lappend flags "additional_flags=-Dt${m}=${t}"
  81         append testfile "-" "$t"
  82     }
  83
  84     set binfile [standard_output_file ${dir}/${testfile}]
  85     if  { [gdb_compile "${srcdir}/${subdir}/${srcfile}" "${binfile}" executable "${flags}"] != "" } {
  86         unresolved "failed to compile"
  87         return 0
  88     }
  89
  90     # Start with a fresh gdb.
  91     clean_restart ${binfile}
  92
  93     # Make certain that the output is consistent
  94     gdb_test_no_output "set print sevenbit-strings"
  95     gdb_test_no_output "set print address off"
  96     gdb_test_no_output "set print pretty off"
  97     gdb_test_no_output "set width 0"
  98     gdb_test_no_output "set print elements 300"
  99
 100     # Advance to main
 101     if { ![runto_main] } then {
 102         fail "can't run to main"
 103         return 0
 104     }
 105
 106     # Now continue forward to a suitable location to run the tests.
 107     # Some targets only enable the FPU on first use, so ensure that we
 108     # have used the FPU before we make calls from GDB to code that
 109     # could use the FPU.
 110     gdb_breakpoint [gdb_get_line_number "Break Here"] temporary
 111     gdb_continue_to_breakpoint "breakpt" ".* Break Here\\. .*"
 112
 113     return 1
 114 }
 115
 116 # Assuming GDB is stopped at main within a test binary, run some tests
 117 # passing structures, and reading return value structures.
 118
 119 proc run_tests { lang types } {
 120     global gdb_prompt
 121
 122     foreach {name} {struct_01_01 struct_01_02 struct_01_03 struct_01_04
 123                     struct_02_01 struct_02_02 struct_02_03 struct_02_04
 124                     struct_04_01 struct_04_02 struct_04_03 struct_04_04
 125                     struct_05_01 struct_05_02 struct_05_03 struct_05_04
 126                     struct_static_02_01 struct_static_02_02 struct_static_02_03 struct_static_02_04
 127                     struct_static_04_01 struct_static_04_02 struct_static_04_03 struct_static_04_04
 128                     struct_static_06_01 struct_static_06_02 struct_static_06_03 struct_static_06_04} {
 129
 130         # Only run static member tests on C++
 131         if { $lang == "c" && [regexp "static" $name match] } {
 132             continue
 133         }
 134
 135         if { $lang == "c++"
 136              && ( ( [regexp "struct_01_0(1|2|3)" $name match] && [regexp "^types-(td($|-)|tl(|l)(|-tf|-td|-tld)$)" $types match] )
 137                   || ( $name == "struct_01_02" && $types == "types-tfc" )
 138                   || ( $name == "struct_01_04" && [regexp "^types-(tf($|-)|ti(|-tf|-td|-tld)$)" $types match] )
 139                   || ( $name == "struct_02_01" && [regexp "^types-tf-t(c|s|i)" $types match] )
 140                   || ( $name == "struct_static_02_02" && [regexp "^types-(t(f|d|ld)-t(d|l|ll)$|t(d|l|ll)$|t(c|s|i|l|ll)-td)" $types match] )
 141                   || ( $name == "struct_static_02_03" && [regexp "^types-(ti-t(f|l|d|)|tf(-|$)|ti$)" $types match] )
 142                   || ( $name == "struct_static_04_02" && [regexp "^types-(t(c|s)-tf|tf-ts)" $types match] )
 143                   || ( $name == "struct_static_06_04" && ![regexp "^types-(t(c|dc|ldc|ld)$|t.-tld|tl(l|d)-tld|t(f|d|ld)-tc)" $types match] ) ) } {
 144             setup_xfail gdb/24104 "x86_64-*-linux*"
 145         }
 146         gdb_test "p/d check_arg_${name} (ref_val_${name})" "= 1"
 147
 148         set refval [ get_valueof "" "ref_val_${name}" "" ]
 149         verbose -log "Refval: ${refval}"
 150
 151         set test "check return value ${name}"
 152         if { ${refval} != "" } {
 153
 154             set answer [ get_valueof "" "rtn_str_${name} ()" "XXXX"]
 155             verbose -log "Answer: ${answer}"
 156
 157             if { ($lang == "c++" && $name == "struct_02_01" && [regexp "^types-(tf-t(c|s|i)|t(c|s|i)-tf)" $types match] ) } {
 158                 setup_xfail gdb/24104 "x86_64-*-linux*"
 159             }
 160             gdb_assert [string eq ${answer} ${refval}] ${test}
 161         } else {
 162             unresolved $test
 163         }
 164     }
 165 }
 166
 167 # Set up a test prefix, compile the test binary, run to main, and then
 168 # run some tests.
 169
 170 proc start_gdb_and_run_tests { lang types } {
 171     set prefix "types"
 172
 173     foreach t $types {
 174         append prefix "-" "${t}"
 175     }
 176
 177     foreach_with_prefix l $lang {
 178         with_test_prefix $prefix {
 179             if { [start_nested_structs_test $l $types] } {
 180                 run_tests $l $prefix
 181             }
 182         }
 183     }
 184 }
 185
 186 foreach ta $int_types {
 187     start_gdb_and_run_tests $lang $ta
 188 }
 189
 190 if [support_complex_tests] {
 191     foreach ta $complex_types {
 192         start_gdb_and_run_tests $lang $ta
 193     }
 194 }
 195
 196 if ![gdb_skip_float_test] {
 197     foreach ta $float_types {
 198         start_gdb_and_run_tests $lang $ta
 199     }
 200
 201     foreach ta $int_types {
 202         foreach tb $float_types {
 203             start_gdb_and_run_tests $lang [list $ta $tb]
 204         }
 205     }
 206
 207     foreach ta $float_types {
 208         foreach tb $int_types {
 209             start_gdb_and_run_tests $lang [list $ta $tb]
 210         }
 211
 212         foreach tb $float_types {
 213             start_gdb_and_run_tests $lang [list $ta $tb]
 214         }
 215     }
 216 }