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

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