1# Copyright 2003, 2004 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 2 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, write to the Free Software 15# Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. 16 17# This file was written by Joel Brobecker (brobecker@gnat.com), derived 18# from xfullpath.exp. 19 20if $tracelevel then { 21 strace $tracelevel 22} 23 24set prms_id 0 25set bug_id 0 26 27# are we on a target board 28if [is_remote target] { 29 return 30} 31 32proc setup_test { executable } { 33 global gdb_prompt 34 global timeout 35 36 # load yourself into the debugger 37 # This can take a relatively long time, particularly for testing where 38 # the executable is being accessed over a network, or where gdb does not 39 # support partial symbols for a particular target and has to load the 40 # entire symbol table. Set the timeout to 10 minutes, which should be 41 # adequate for most environments (it *has* timed out with 5 min on a 42 # SPARCstation SLC under moderate load, so this isn't unreasonable). 43 # After gdb is started, set the timeout to 30 seconds for the duration 44 # of this test, and then back to the original value. 45 46 set oldtimeout $timeout 47 set timeout 600 48 verbose "Timeout is now $timeout seconds" 2 49 50 global gdb_file_cmd_debug_info 51 set gdb_file_cmd_debug_info "unset" 52 53 set result [gdb_load $executable] 54 set timeout $oldtimeout 55 verbose "Timeout is now $timeout seconds" 2 56 57 if { $result != 0 } then { 58 return -1 59 } 60 61 if { $gdb_file_cmd_debug_info != "debug" } then { 62 untested "No debug information, skipping testcase." 63 return -1 64 } 65 66 # Set a breakpoint at main 67 gdb_test "break captured_main" \ 68 "Breakpoint.*at.* file.*, line.*" \ 69 "breakpoint in captured_main" 70 71 # run yourself 72 # It may take a very long time for the inferior gdb to start (lynx), 73 # so we bump it back up for the duration of this command. 74 set timeout 600 75 76 set description "run until breakpoint at captured_main" 77 gdb_test_multiple "run -nw" "$description" { 78 -re "Starting program.*Breakpoint \[0-9\]+,.*captured_main .data.* at .*main.c:.*$gdb_prompt $" { 79 pass "$description" 80 } 81 -re "Starting program.*Breakpoint \[0-9\]+,.*captured_main .data.*$gdb_prompt $" { 82 xfail "$description (line numbers scrambled?)" 83 } 84 -re "vfork: No more processes.*$gdb_prompt $" { 85 fail "$description (out of virtual memory)" 86 set timeout $oldtimeout 87 verbose "Timeout is now $timeout seconds" 2 88 return -1 89 } 90 -re ".*$gdb_prompt $" { 91 fail "$description" 92 set timeout $oldtimeout 93 verbose "Timeout is now $timeout seconds" 2 94 return -1 95 } 96 } 97 98 set timeout $oldtimeout 99 verbose "Timeout is now $timeout seconds" 2 100 101 return 0 102} 103 104proc attach_first_observer { message } { 105 gdb_test "set \$first_obs = observer_attach_normal_stop (&observer_test_first_notification_function)" \ 106 "" "$message; attach first observer" 107} 108 109proc attach_second_observer { message } { 110 gdb_test "set \$second_obs = observer_attach_normal_stop (&observer_test_second_notification_function)" \ 111 "" "$message; attach second observer" 112} 113 114proc attach_third_observer { message } { 115 gdb_test "set \$third_obs = observer_attach_normal_stop (&observer_test_third_notification_function)" \ 116 "" "$message; attach third observer" 117} 118 119proc detach_first_observer { message } { 120 gdb_test "call observer_detach_normal_stop (\$first_obs)" \ 121 "" "$message; detach first observer" 122} 123 124proc detach_second_observer { message } { 125 gdb_test "call observer_detach_normal_stop (\$second_obs)" \ 126 "" "$message; detach second observer" 127} 128 129proc detach_third_observer { message } { 130 gdb_test "call observer_detach_normal_stop (\$third_obs)" \ 131 "" "$message; detach third observer" 132} 133 134proc check_counters { first second third message } { 135 gdb_test "print observer_test_first_observer" \ 136 ".\[0-9\]+ =.*$first" \ 137 "$message; check first observer counter value" 138 gdb_test "print observer_test_second_observer" \ 139 ".\[0-9\]+ =.*$second" \ 140 "$message; check second observer counter value" 141 gdb_test "print observer_test_third_observer" \ 142 ".\[0-9\]+ =.*$third" \ 143 "$message; check third observer counter value" 144} 145 146proc reset_counters { message } { 147 gdb_test "set variable observer_test_first_observer = 0" "" \ 148 "$message; reset first observer counter" 149 gdb_test "set variable observer_test_second_observer = 0" "" \ 150 "$message; reset second observer counter" 151 gdb_test "set variable observer_test_third_observer = 0" "" \ 152 "$message; reset third observer counter" 153} 154 155proc test_normal_stop_notifications { first second third message args } { 156 # Do any initialization 157 for {set i 0} {$i < [llength $args]} {incr i} { 158 [lindex $args $i] $message 159 } 160 reset_counters $message 161 # Call observer_notify_normal_stop. Note that this procedure 162 # takes one argument, but this argument is ignored by the observer 163 # callbacks we have installed. So we just pass an arbitrary value. 164 gdb_test "call observer_notify_normal_stop (0)" "" \ 165 "$message; sending notification" 166 check_counters $first $second $third $message 167} 168 169proc test_observer_normal_stop { executable } { 170 171 set setup_result [setup_test $executable] 172 if {$setup_result <0} then { 173 return -1 174 } 175 176 # First, try sending a notification without any observer attached. 177 test_normal_stop_notifications 0 0 0 "no observer attached" 178 179 # Now, attach one observer, and send a notification. 180 test_normal_stop_notifications 0 1 0 "second observer attached" \ 181 attach_second_observer 182 183 # Remove the observer, and send a notification. 184 test_normal_stop_notifications 0 0 0 "second observer detached" \ 185 detach_second_observer 186 187 # With a new observer. 188 test_normal_stop_notifications 1 0 0 "1st observer added" \ 189 attach_first_observer 190 191 # With 2 observers. 192 test_normal_stop_notifications 1 1 0 "2nd observer added" \ 193 attach_second_observer 194 195 # With 3 observers. 196 test_normal_stop_notifications 1 1 1 "3rd observer added" \ 197 attach_third_observer 198 199 # Remove middle observer. 200 test_normal_stop_notifications 1 0 1 "2nd observer removed" \ 201 detach_second_observer 202 203 # Remove first observer. 204 test_normal_stop_notifications 0 0 1 "1st observer removed" \ 205 detach_first_observer 206 207 # Remove last observer. 208 test_normal_stop_notifications 0 0 0 "3rd observer removed" \ 209 detach_third_observer 210 211 # Go back to 3 observers, and remove them in a different order... 212 test_normal_stop_notifications 1 1 1 "three observers added" \ 213 attach_first_observer \ 214 attach_second_observer \ 215 attach_third_observer 216 217 # Remove the third observer. 218 test_normal_stop_notifications 1 1 0 "third observer removed" \ 219 detach_third_observer 220 221 # Remove the second observer. 222 test_normal_stop_notifications 1 0 0 "second observer removed" \ 223 detach_second_observer 224 225 # Remove the first observer, no more observers. 226 test_normal_stop_notifications 0 0 0 "first observer removed" \ 227 detach_first_observer 228 229 return 0 230} 231 232# Find a pathname to a file that we would execute if the shell was asked 233# to run $arg using the current PATH. 234 235proc find_gdb { arg } { 236 237 # If the arg directly specifies an existing executable file, then 238 # simply use it. 239 240 if [file executable $arg] then { 241 return $arg 242 } 243 244 set result [which $arg] 245 if [string match "/" [ string range $result 0 0 ]] then { 246 return $result 247 } 248 249 # If everything fails, just return the unqualified pathname as default 250 # and hope for best. 251 252 return $arg 253} 254 255# Run the test with self. 256# Copy the file executable file in case this OS doesn't like to edit its own 257# text space. 258 259set GDB_FULLPATH [find_gdb $GDB] 260 261# Remove any old copy lying around. 262remote_file host delete x$tool 263 264gdb_start 265set file [remote_download host $GDB_FULLPATH x$tool] 266set result [test_observer_normal_stop $file]; 267gdb_exit; 268catch "remote_file host delete $file"; 269 270if {$result <0} then { 271 warning "Couldn't test self" 272 return -1 273} 274