1# Copyright 2002, 2003, 2004, 2007 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# This file was written by Joel Brobecker. (brobecker@gnat.com), derived 17# from selftest.exp, written by Rob Savoye. 18 19if $tracelevel then { 20 strace $tracelevel 21} 22 23set prms_id 0 24set bug_id 0 25 26# are we on a target board 27if { [is_remote target] || ![isnative] } then { 28 return 29} 30 31proc setup_test { executable } { 32 global gdb_prompt 33 global timeout 34 35 # load yourself into the debugger 36 # This can take a relatively long time, particularly for testing where 37 # the executable is being accessed over a network, or where gdb does not 38 # support partial symbols for a particular target and has to load the 39 # entire symbol table. Set the timeout to 10 minutes, which should be 40 # adequate for most environments (it *has* timed out with 5 min on a 41 # SPARCstation SLC under moderate load, so this isn't unreasonable). 42 # After gdb is started, set the timeout to 30 seconds for the duration 43 # of this test, and then back to the original value. 44 45 set oldtimeout $timeout 46 set timeout 600 47 verbose "Timeout is now $timeout seconds" 2 48 49 global gdb_file_cmd_debug_info 50 set gdb_file_cmd_debug_info "unset" 51 52 set result [gdb_load $executable] 53 set timeout $oldtimeout 54 verbose "Timeout is now $timeout seconds" 2 55 56 if { $result != 0 } then { 57 return -1 58 } 59 60 if { $gdb_file_cmd_debug_info != "debug" } then { 61 untested "No debug information, skipping testcase." 62 return -1 63 } 64 65 # Set a breakpoint at main 66 gdb_test "break captured_main" \ 67 "Breakpoint.*at.* file.*, line.*" \ 68 "breakpoint in captured_main" 69 70 # run yourself 71 # It may take a very long time for the inferior gdb to start (lynx), 72 # so we bump it back up for the duration of this command. 73 set timeout 600 74 75 set description "run until breakpoint at captured_main" 76 send_gdb "run -nw\n" 77 gdb_expect { 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 timeout { 97 fail "$description (timeout)" 98 } 99 } 100 101 set timeout $oldtimeout 102 verbose "Timeout is now $timeout seconds" 2 103 104 return 0 105} 106 107proc test_with_self { executable } { 108 109 set setup_result [setup_test $executable] 110 if {$setup_result <0} then { 111 return -1 112 } 113 114 # A file which contains a directory prefix 115 gdb_test "print xfullpath (\"./xfullpath.exp\")" \ 116 ".\[0-9\]+ =.*\".*/xfullpath.exp\"" \ 117 "A filename with ./ as the directory prefix" 118 119 # A file which contains a directory prefix 120 gdb_test "print xfullpath (\"../../defs.h\")" \ 121 ".\[0-9\]+ =.*\".*/defs.h\"" \ 122 "A filename with ../ in the directory prefix" 123 124 # A one-character filename 125 gdb_test "print xfullpath (\"./a\")" \ 126 ".\[0-9\]+ =.*\".*/a\"" \ 127 "A one-char filename in the current directory" 128 129 # A file in the root directory 130 gdb_test "print xfullpath (\"/root_file_which_should_exist\")" \ 131 ".\[0-9\]+ =.*\"/root_file_which_should_exist\"" \ 132 "A filename in the root directory" 133 134 # A file which does not have a directory prefix 135 gdb_test "print xfullpath (\"xfullpath.exp\")" \ 136 ".\[0-9\]+ =.*\"xfullpath.exp\"" \ 137 "A filename without any directory prefix" 138 139 # A one-char filename without any directory prefix 140 gdb_test "print xfullpath (\"a\")" \ 141 ".\[0-9\]+ =.*\"a\"" \ 142 "A one-char filename without any directory prefix" 143 144 # An empty filename 145 gdb_test "print xfullpath (\"\")" \ 146 ".\[0-9\]+ =.*\"\"" \ 147 "An empty filename" 148 149 return 0 150} 151 152# Find a pathname to a file that we would execute if the shell was asked 153# to run $arg using the current PATH. 154 155proc find_gdb { arg } { 156 157 # If the arg directly specifies an existing executable file, then 158 # simply use it. 159 160 if [file executable $arg] then { 161 return $arg 162 } 163 164 set result [which $arg] 165 if [string match "/" [ string range $result 0 0 ]] then { 166 return $result 167 } 168 169 # If everything fails, just return the unqualified pathname as default 170 # and hope for best. 171 172 return $arg 173} 174 175# Run the test with self. 176# Copy the file executable file in case this OS doesn't like to edit its own 177# text space. 178 179set GDB_FULLPATH [find_gdb $GDB] 180 181# Remove any old copy lying around. 182remote_file host delete x$tool 183 184gdb_start 185set file [remote_download host $GDB_FULLPATH x$tool] 186set result [test_with_self $file]; 187gdb_exit; 188catch "remote_file host delete $file"; 189 190if {$result <0} then { 191 warning "Couldn't test self" 192 return -1 193} 194