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