gdb/testsuite/gdb.multi/multi-target.exp.tcl

   1 # Copyright 2017-2020 Free Software Foundation, Inc.
   2
   3 # This program is free software; you can redistribute it and/or modify
   4 # it under the terms of the GNU General Public License as published by
   5 # the Free Software Foundation; either version 3 of the License, or
   6 # (at your option) any later version.
   7 #
   8 # This program is distributed in the hope that it will be useful,
   9 # but WITHOUT ANY WARRANTY; without even the implied warranty of
  10 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  11 # GNU General Public License for more details.
  12 #
  13 # You should have received a copy of the GNU General Public License
  14 # along with this program.  If not, see <http://www.gnu.org/licenses/>.
  15
  16 # Common routines for testing multi-target features.
  17
  18 load_lib gdbserver-support.exp
  19
  20 standard_testfile multi-target.c
  21
  22 # Keep a list of (inferior ID, spawn ID).
  23 set server_spawn_ids [list]
  24
  25 proc connect_target_extended_remote {binfile num} {
  26     set res [gdbserver_start "--multi" ""]
  27     global server_spawn_ids server_spawn_id
  28     lappend server_spawn_ids $num $server_spawn_id
  29     set gdbserver_gdbport [lindex $res 1]
  30     return [gdb_target_cmd "extended-remote" $gdbserver_gdbport]
  31 }
  32
  33 # Add and start inferior number NUM.  Returns true on success, false
  34 # otherwise.
  35 proc add_inferior {num target binfile {gcorefile ""}} {
  36     # Start another inferior.
  37     gdb_test "add-inferior -no-connection" "Added inferior $num" \
  38         "add empty inferior $num"
  39     gdb_test "inferior $num" "Switching to inferior $num.*" \
  40         "switch to inferior $num"
  41     gdb_test "file ${binfile}" ".*" "load file in inferior $num"
  42     gdb_test_no_output "set remote exec-file ${binfile}" \
  43         "set remote-exec file in inferior $num"
  44
  45     if {$target == "core"} {
  46         gdb_test "core $gcorefile" "Core was generated by.*" \
  47             "core [file tail $gcorefile], inf $num"
  48         return 1
  49     }
  50
  51     if {$target == "extended-remote"} {
  52         if {[connect_target_extended_remote $binfile $num]} {
  53             return 0
  54         }
  55     }
  56     if ![runto "all_started"] then {
  57         return 0
  58     }
  59     delete_breakpoints
  60
  61     return 1
  62 }
  63
  64 proc prepare_core {} {
  65     global gcorefile gcore_created
  66     global binfile
  67
  68     clean_restart ${binfile}
  69
  70     if ![runto all_started] then {
  71         return -1
  72     }
  73
  74     global testfile
  75     set gcorefile [standard_output_file $testfile.gcore]
  76     set gcore_created [gdb_gcore_cmd $gcorefile "save a core file"]
  77 }
  78
  79 proc next_live_inferior {inf} {
  80     incr inf
  81     if {$inf == 3} {
  82         # 3 is a core.
  83         return 4
  84     }
  85     if {$inf > 5} {
  86         # 6 is a core.
  87         return 1
  88     }
  89
  90     return $inf
  91 }
  92
  93 # Clean up the server_spawn_ids.
  94 proc cleanup_gdbservers { } {
  95     global server_spawn_id
  96     global server_spawn_ids
  97     foreach { inferior_id spawn_id } $server_spawn_ids {
  98         set server_spawn_id $spawn_id
  99         gdb_test "inferior $inferior_id"
 100         gdbserver_exit 0
 101     }
 102     set server_spawn_ids [list]
 103 }
 104
 105 # Return true on success, false otherwise.
 106
 107 proc setup {non-stop} {
 108     global gcorefile gcore_created
 109     global binfile
 110
 111     cleanup_gdbservers
 112     clean_restart ${binfile}
 113
 114     # multi-target depends on target running in non-stop mode.  Force
 115     # it on for remote targets, until this is the default.
 116     gdb_test_no_output "maint set target-non-stop on"
 117
 118     gdb_test_no_output "set non-stop ${non-stop}"
 119
 120     if ![runto all_started] then {
 121         return 0
 122     }
 123
 124     delete_breakpoints
 125
 126     # inferior 1 -> native
 127     # inferior 2 -> extended-remote
 128     # inferior 3 -> core
 129     # inferior 4 -> native
 130     # inferior 5 -> extended-remote
 131     # inferior 6 -> core
 132     if {![add_inferior 2 "extended-remote" $binfile]} {
 133         return 0
 134     }
 135     if {![add_inferior 3 "core" $binfile $gcorefile]} {
 136         return 0
 137     }
 138     if {![add_inferior 4 "native" $binfile]} {
 139         return 0
 140     }
 141     if {![add_inferior 5 "extended-remote" $binfile]} {
 142         return 0
 143     }
 144     if {![add_inferior 6 "core" $binfile $gcorefile]} {
 145         return 0
 146     }
 147
 148     # For debugging.
 149     gdb_test "info threads" ".*"
 150
 151     # Make "continue" resume all inferiors.
 152     if {${non-stop} == "off"} {
 153         gdb_test_no_output "set schedule-multiple on"
 154     }
 155
 156     return 1
 157 }
 158
 159 proc multi_target_prepare {} {
 160     global binfile srcfile
 161
 162     if { [skip_gdbserver_tests] } {
 163         return 0
 164     }
 165
 166     # The plain remote target can't do multiple inferiors.
 167     if {[target_info gdb_protocol] != ""} {
 168         return 0
 169     }
 170
 171     if { [prepare_for_testing "failed to prepare" ${binfile} "${srcfile}" \
 172               {debug pthreads}] } {
 173         return 0
 174     }
 175
 176     # Make a core file with two threads upfront.  Several tests load
 177     # the same core file.
 178     prepare_core
 179
 180     return 1
 181 }
 182
 183 proc multi_target_cleanup {} {
 184     cleanup_gdbservers
 185 }