URL https://opencores.org/ocsvn/openrisc/openrisc/trunk

Subversion Repositories openrisc

[/] [openrisc/] [trunk/] [gnu-old/] [gdb-7.1/] [gdb/] [testsuite/] [lib/] [gdbserver-support.exp] - Blame information for rev 862

Go to most recent revision | Details | Compare with Previous | View Log


# Copyright 2000, 2002, 2003, 2004, 2005, 2006, 2007, 2008, 2009, 2010
# Free Software Foundation, Inc.
 
# This program is free software; you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by
# the Free Software Foundation; either version 3 of the License, or
# (at your option) any later version.
#
# This program is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
# GNU General Public License for more details.
#
# You should have received a copy of the GNU General Public License
# along with this program.  If not, see .
 
# This file is based on config/gdbserver.exp, which was written by
# Michael Snyder (msnyder@redhat.com).
 
#
# To be addressed or set in your baseboard config file:
#
#   set_board_info gdb_protocol "remote"
#       Unles you have a gdbserver that uses a different protocol...
#
#   set_board_info gdb_server_prog
#       This will be the path to the gdbserver program you want to test.
#       Defaults to "gdbserver".
#
#   set_board_info sockethost
#       The name of the host computer whose socket is being used.
#       Defaults to "localhost".  Note: old gdbserver requires
#       that you define this, but libremote/gdbserver does not.
#
#   set_board_info gdb,socketport
#       Port id to use for socket connection.  If not set explicitly,
#       it will start at "2345" and increment for each use.
#
 
#
# gdb_target_cmd
# Send gdb the "target" command
#
proc gdb_target_cmd { targetname serialport } {
    global gdb_prompt
 
    set serialport_re [string_to_regexp $serialport]
    for {set i 1} {$i <= 3} {incr i} {
        send_gdb "target $targetname $serialport\n"
        gdb_expect 60 {
            -re "A program is being debugged already.*ill it.*y or n. $" {
                send_gdb "y\n"
                exp_continue
            }
            -re "unknown host.*$gdb_prompt" {
                verbose "Couldn't look up $serialport"
            }
            -re "Couldn't establish connection to remote.*$gdb_prompt $" {
                verbose "Connection failed"
            }
            -re "Remote MIPS debugging.*$gdb_prompt" {
                verbose "Set target to $targetname"
                return 0
            }
            -re "Remote debugging using .*$serialport_re.*$gdb_prompt $" {
                verbose "Set target to $targetname"
                return 0
            }
            -re "Remote target $targetname connected to.*$gdb_prompt $" {
                verbose "Set target to $targetname"
                return 0
            }
            -re "Connected to.*$gdb_prompt $" {
                verbose "Set target to $targetname"
                return 0
            }
            -re "Ending remote.*$gdb_prompt $" { }
            -re "Connection refused.*$gdb_prompt $" {
                verbose "Connection refused by remote target.  Pausing, and trying again."
                sleep 30
                continue
            }
            -re "Timeout reading from remote system.*$gdb_prompt $" {
                verbose "Got timeout error from gdb."
            }
            -notransfer -re "Remote debugging using .*\r\n> $" {
                # We got an unexpected prompt while creating the target.
                # Leave it there for the test to diagnose.
                return 1
            }
            timeout {
                send_gdb ""
                break
            }
        }
    }
    return 1
}
 
 
global portnum
set portnum "2345"
 
# Locate the gdbserver binary.  Returns "" if gdbserver could not be found.
 
proc find_gdbserver { } {
  global GDB
  global GDBSERVER
 
  if [info exists GDBSERVER] {
    return ${GDBSERVER}
  }
 
  if [target_info exists gdb_server_prog] {
    return [target_info gdb_server_prog]
  }
 
  set gdbserver "${GDB}server"
  if { [file isdirectory $gdbserver] } {
    append gdbserver "/gdbserver"
  }
 
  if { [file executable $gdbserver] } {
    return $gdbserver
  }
 
  return ""
}
 
# Return non-zero if we should skip gdbserver-specific tests.
 
proc skip_gdbserver_tests { } {
  if { [find_gdbserver] == "" } {
    return 1
  }
 
  return 0
}
 
# Download the currently loaded program to the target if necessary.
# Return the target system filename.
# NOTE: This was named "gdbserver_download", but that collides with the
# dejagnu "download" API function when using load_generic_config "gdbserver".
 
proc gdbserver_download_current_prog { } {
    global gdbserver_host_exec
    global gdbserver_host_mtime
    global gdbserver_server_exec
    global last_loaded_file
 
    set host_exec $last_loaded_file
 
    # If we already downloaded a file to the target, see if we can reuse it.
    set reuse 0
    if { [info exists gdbserver_server_exec] } {
        set reuse 1
 
        # If the file has changed, we can not.
        if { $host_exec != $gdbserver_host_exec } {
            set reuse 0
        }
 
        # If the mtime has changed, we can not.
        if { [file mtime $host_exec] != $gdbserver_host_mtime } {
            set reuse 0
        }
    }
 
    if { $reuse == 0 } {
        set gdbserver_host_exec $host_exec
        set gdbserver_host_mtime [file mtime $host_exec]
        if [is_remote target] {
            set gdbserver_server_exec [gdb_download $host_exec]
        } else {
            set gdbserver_server_exec $host_exec
        }
    }
 
    return $gdbserver_server_exec
}
 
# Start a gdbserver process with initial OPTIONS and trailing ARGUMENTS.
# The port will be filled in between them automatically.
#
# Returns the target protocol and socket to connect to.
 
proc gdbserver_start { options arguments } {
    global portnum
 
    # Port id -- either specified in baseboard file, or managed here.
    if [target_info exists gdb,socketport] {
        set portnum [target_info gdb,socketport]
    } else {
        # Bump the port number to avoid conflicts with hung ports.
        incr portnum
    }
 
    # Extract the local and remote host ids from the target board struct.
    if [target_info exists sockethost] {
        set debughost [target_info sockethost]
    } else {
        set debughost "localhost:"
    }
 
    # Extract the protocol
    if [target_info exists gdb_protocol] {
        set protocol [target_info gdb_protocol]
    } else {
        set protocol "remote"
    }
 
    set gdbserver [find_gdbserver]
 
    # Loop till we find a free port.
    while 1 {
        # Export the host:port pair.
        set gdbport $debughost$portnum
 
        # Fire off the debug agent.
        set gdbserver_command "$gdbserver"
        if { $options != "" } {
            append gdbserver_command " $options"
        }
        append gdbserver_command " :$portnum"
        if { $arguments != "" } {
            append gdbserver_command " $arguments"
        }
 
        set server_spawn_id [remote_spawn target $gdbserver_command]
 
        # Wait for the server to open its TCP socket, so that GDB can connect.
        expect {
            -i $server_spawn_id
            -notransfer
            -re "Listening on" { }
            -re "Can't bind address: Address already in use\\.\r\n" {
                verbose -log "Port $portnum is already in use."
                if ![target_info exists gdb,socketport] {
                    # Bump the port number to avoid the conflict.
                    wait -i $expect_out(spawn_id)
                    incr portnum
                    continue
                }
            }
        }
        break
    }
 
    # We can't just call close, because if gdbserver is local then that means
    # that it will get a SIGHUP.  Doing it this way could also allow us to
    # get at the inferior's input or output if necessary, and means that we
    # don't need to redirect output.
    expect_background {
        -i $server_spawn_id
        full_buffer { }
        eof {
            # The spawn ID is already closed now (but not yet waited for).
            wait -i $expect_out(spawn_id)
        }
    }
 
    return [list $protocol $gdbport]
}
 
# Start a gdbserver process running SERVER_EXEC, and connect GDB
# to it.  CHILD_ARGS are passed to the inferior.
#
# Returns the target protocol and socket to connect to.
 
proc gdbserver_spawn { child_args } {
    set target_exec [gdbserver_download_current_prog]
 
    # Fire off the debug agent.  This flavour of gdbserver takes as
    # arguments the port information, the name of the executable file to
    # be debugged, and any arguments.
    set arguments "$target_exec"
    if { $child_args != "" } {
        append arguments " $child_args"
    }
    return [gdbserver_start "" $arguments]
}
 
# Start a gdbserver process running HOST_EXEC and pass CHILD_ARGS
# to it.  Return 0 on success, or non-zero on failure.
 
proc gdbserver_run { child_args } {
    global gdbserver_protocol
    global gdbserver_gdbport
 
    # Kill anything running before we try to start gdbserver, in case
    # we are sharing a serial connection.
    global gdb_prompt
    send_gdb "kill\n"
    gdb_expect 120 {
        -re "Kill the program being debugged. .y or n. $" {
            send_gdb "y\n"
            verbose "\t\tKilling previous program being debugged"
            exp_continue
        }
        -re "$gdb_prompt $" {
            # OK.
        }
    }
 
    set res [gdbserver_spawn $child_args]
    set gdbserver_protocol [lindex $res 0]
    set gdbserver_gdbport [lindex $res 1]
 
    return [gdb_target_cmd $gdbserver_protocol $gdbserver_gdbport]
}
 
# Reconnect to the previous gdbserver session.
 
proc gdbserver_reconnect { } {
    global gdbserver_protocol
    global gdbserver_gdbport
 
    return [gdb_target_cmd $gdbserver_protocol $gdbserver_gdbport]
}
 
# Start and connect to a gdbserver in extended mode.
proc gdbserver_start_extended { } {
    set res [gdbserver_start "--multi" ""]
    set gdbserver_protocol "extended-[lindex $res 0]"
    set gdbserver_gdbport [lindex $res 1]
 
    return [gdb_target_cmd $gdbserver_protocol $gdbserver_gdbport]
}

Browse

Tools

Subversion Repositories openrisc

[/] [openrisc/] [trunk/] [gnu-old/] [gdb-7.1/] [gdb/] [testsuite/] [lib/] [gdbserver-support.exp] - Blame information for rev 862

Line No.	Rev	Author	Line
1	227	jeremybenn	`# Copyright 2000, 2002, 2003, 2004, 2005, 2006, 2007, 2008, 2009, 2010`
2			`# Free Software Foundation, Inc.`
3
4			`# This program is free software; you can redistribute it and/or modify`
5			`# it under the terms of the GNU General Public License as published by`
6			`# the Free Software Foundation; either version 3 of the License, or`
7			`# (at your option) any later version.`
8			`#`
9			`# This program is distributed in the hope that it will be useful,`
10			`# but WITHOUT ANY WARRANTY; without even the implied warranty of`
11			`# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the`
12			`# GNU General Public License for more details.`
13			`#`
14			`# You should have received a copy of the GNU General Public License`
15			`# along with this program. If not, see .`
16
17			`# This file is based on config/gdbserver.exp, which was written by`
18			`# Michael Snyder (msnyder@redhat.com).`
19
20			`#`
21			`# To be addressed or set in your baseboard config file:`
22			`#`
23			`# set_board_info gdb_protocol "remote"`
24			`# Unles you have a gdbserver that uses a different protocol...`
25			`#`
26			`# set_board_info gdb_server_prog`
27			`# This will be the path to the gdbserver program you want to test.`
28			`# Defaults to "gdbserver".`
29			`#`
30			`# set_board_info sockethost`
31			`# The name of the host computer whose socket is being used.`
32			`# Defaults to "localhost". Note: old gdbserver requires`
33			`# that you define this, but libremote/gdbserver does not.`
34			`#`
35			`# set_board_info gdb,socketport`
36			`# Port id to use for socket connection. If not set explicitly,`
37			`# it will start at "2345" and increment for each use.`
38			`#`
39
40			`#`
41			`# gdb_target_cmd`
42			`# Send gdb the "target" command`
43			`#`
44			`proc gdb_target_cmd { targetname serialport } {`
45			`global gdb_prompt`
46
47			`set serialport_re [string_to_regexp $serialport]`
48			`for {set i 1} {$i <= 3} {incr i} {`
49			`send_gdb "target $targetname $serialport\n"`
50			`gdb_expect 60 {`
51			`-re "A program is being debugged already.ill it.y or n. $" {`
52			`send_gdb "y\n"`
53			`exp_continue`
54			`}`
55			`-re "unknown host.*$gdb_prompt" {`
56			`verbose "Couldn't look up $serialport"`
57			`}`
58			`-re "Couldn't establish connection to remote.*$gdb_prompt $" {`
59			`verbose "Connection failed"`
60			`}`
61			`-re "Remote MIPS debugging.*$gdb_prompt" {`
62			`verbose "Set target to $targetname"`
63			`return 0`
64			`}`
65			`-re "Remote debugging using .$serialport_re.$gdb_prompt $" {`
66			`verbose "Set target to $targetname"`
67			`return 0`
68			`}`
69			`-re "Remote target $targetname connected to.*$gdb_prompt $" {`
70			`verbose "Set target to $targetname"`
71			`return 0`
72			`}`
73			`-re "Connected to.*$gdb_prompt $" {`
74			`verbose "Set target to $targetname"`
75			`return 0`
76			`}`
77			`-re "Ending remote.*$gdb_prompt $" { }`
78			`-re "Connection refused.*$gdb_prompt $" {`
79			`verbose "Connection refused by remote target. Pausing, and trying again."`
80			`sleep 30`
81			`continue`
82			`}`
83			`-re "Timeout reading from remote system.*$gdb_prompt $" {`
84			`verbose "Got timeout error from gdb."`
85			`}`
86			`-notransfer -re "Remote debugging using .*\r\n> $" {`
87			`# We got an unexpected prompt while creating the target.`
88			`# Leave it there for the test to diagnose.`
89			`return 1`
90			`}`
91			`timeout {`
92			`send_gdb ""`
93			`break`
94			`}`
95			`}`
96			`}`
97			`return 1`
98			`}`
99
100
101			`global portnum`
102			`set portnum "2345"`
103
104			`# Locate the gdbserver binary. Returns "" if gdbserver could not be found.`
105
106			`proc find_gdbserver { } {`
107			`global GDB`
108			`global GDBSERVER`
109
110			`if [info exists GDBSERVER] {`
111			`return ${GDBSERVER}`
112			`}`
113
114			`if [target_info exists gdb_server_prog] {`
115			`return [target_info gdb_server_prog]`
116			`}`
117
118			`set gdbserver "${GDB}server"`
119			`if { [file isdirectory $gdbserver] } {`
120			`append gdbserver "/gdbserver"`
121			`}`
122
123			`if { [file executable $gdbserver] } {`
124			`return $gdbserver`
125			`}`
126
127			`return ""`
128			`}`
129
130			`# Return non-zero if we should skip gdbserver-specific tests.`
131
132			`proc skip_gdbserver_tests { } {`
133			`if { [find_gdbserver] == "" } {`
134			`return 1`
135			`}`
136
137			`return 0`
138			`}`
139
140			`# Download the currently loaded program to the target if necessary.`
141			`# Return the target system filename.`
142			`# NOTE: This was named "gdbserver_download", but that collides with the`
143			`# dejagnu "download" API function when using load_generic_config "gdbserver".`
144
145			`proc gdbserver_download_current_prog { } {`
146			`global gdbserver_host_exec`
147			`global gdbserver_host_mtime`
148			`global gdbserver_server_exec`
149			`global last_loaded_file`
150
151			`set host_exec $last_loaded_file`
152
153			`# If we already downloaded a file to the target, see if we can reuse it.`
154			`set reuse 0`
155			`if { [info exists gdbserver_server_exec] } {`
156			`set reuse 1`
157
158			`# If the file has changed, we can not.`
159			`if { $host_exec != $gdbserver_host_exec } {`
160			`set reuse 0`
161			`}`
162
163			`# If the mtime has changed, we can not.`
164			`if { [file mtime $host_exec] != $gdbserver_host_mtime } {`
165			`set reuse 0`
166			`}`
167			`}`
168
169			`if { $reuse == 0 } {`
170			`set gdbserver_host_exec $host_exec`
171			`set gdbserver_host_mtime [file mtime $host_exec]`
172			`if [is_remote target] {`
173			`set gdbserver_server_exec [gdb_download $host_exec]`
174			`} else {`
175			`set gdbserver_server_exec $host_exec`
176			`}`
177			`}`
178
179			`return $gdbserver_server_exec`
180			`}`
181
182			`# Start a gdbserver process with initial OPTIONS and trailing ARGUMENTS.`
183			`# The port will be filled in between them automatically.`
184			`#`
185			`# Returns the target protocol and socket to connect to.`
186
187			`proc gdbserver_start { options arguments } {`
188			`global portnum`
189
190			`# Port id -- either specified in baseboard file, or managed here.`
191			`if [target_info exists gdb,socketport] {`
192			`set portnum [target_info gdb,socketport]`
193			`} else {`
194			`# Bump the port number to avoid conflicts with hung ports.`
195			`incr portnum`
196			`}`
197
198			`# Extract the local and remote host ids from the target board struct.`
199			`if [target_info exists sockethost] {`
200			`set debughost [target_info sockethost]`
201			`} else {`
202			`set debughost "localhost:"`
203			`}`
204
205			`# Extract the protocol`
206			`if [target_info exists gdb_protocol] {`
207			`set protocol [target_info gdb_protocol]`
208			`} else {`
209			`set protocol "remote"`
210			`}`
211
212			`set gdbserver [find_gdbserver]`
213
214			`# Loop till we find a free port.`
215			`while 1 {`
216			`# Export the host:port pair.`
217			`set gdbport $debughost$portnum`
218
219			`# Fire off the debug agent.`
220			`set gdbserver_command "$gdbserver"`
221			`if { $options != "" } {`
222			`append gdbserver_command " $options"`
223			`}`
224			`append gdbserver_command " :$portnum"`
225			`if { $arguments != "" } {`
226			`append gdbserver_command " $arguments"`
227			`}`
228
229			`set server_spawn_id [remote_spawn target $gdbserver_command]`
230
231			`# Wait for the server to open its TCP socket, so that GDB can connect.`
232			`expect {`
233			`-i $server_spawn_id`
234			`-notransfer`
235			`-re "Listening on" { }`
236			`-re "Can't bind address: Address already in use\\.\r\n" {`
237			`verbose -log "Port $portnum is already in use."`
238			`if ![target_info exists gdb,socketport] {`
239			`# Bump the port number to avoid the conflict.`
240			`wait -i $expect_out(spawn_id)`
241			`incr portnum`
242			`continue`
243			`}`
244			`}`
245			`}`
246			`break`
247			`}`
248
249			`# We can't just call close, because if gdbserver is local then that means`
250			`# that it will get a SIGHUP. Doing it this way could also allow us to`
251			`# get at the inferior's input or output if necessary, and means that we`
252			`# don't need to redirect output.`
253			`expect_background {`
254			`-i $server_spawn_id`
255			`full_buffer { }`
256			`eof {`
257			`# The spawn ID is already closed now (but not yet waited for).`
258			`wait -i $expect_out(spawn_id)`
259			`}`
260			`}`
261
262			`return [list $protocol $gdbport]`
263			`}`
264
265			`# Start a gdbserver process running SERVER_EXEC, and connect GDB`
266			`# to it. CHILD_ARGS are passed to the inferior.`
267			`#`
268			`# Returns the target protocol and socket to connect to.`
269
270			`proc gdbserver_spawn { child_args } {`
271			`set target_exec [gdbserver_download_current_prog]`
272
273			`# Fire off the debug agent. This flavour of gdbserver takes as`
274			`# arguments the port information, the name of the executable file to`
275			`# be debugged, and any arguments.`
276			`set arguments "$target_exec"`
277			`if { $child_args != "" } {`
278			`append arguments " $child_args"`
279			`}`
280			`return [gdbserver_start "" $arguments]`
281			`}`
282
283			`# Start a gdbserver process running HOST_EXEC and pass CHILD_ARGS`
284			`# to it. Return 0 on success, or non-zero on failure.`
285
286			`proc gdbserver_run { child_args } {`
287			`global gdbserver_protocol`
288			`global gdbserver_gdbport`
289
290			`# Kill anything running before we try to start gdbserver, in case`
291			`# we are sharing a serial connection.`
292			`global gdb_prompt`
293			`send_gdb "kill\n"`
294			`gdb_expect 120 {`
295			`-re "Kill the program being debugged. .y or n. $" {`
296			`send_gdb "y\n"`
297			`verbose "\t\tKilling previous program being debugged"`
298			`exp_continue`
299			`}`
300			`-re "$gdb_prompt $" {`
301			`# OK.`
302			`}`
303			`}`
304
305			`set res [gdbserver_spawn $child_args]`
306			`set gdbserver_protocol [lindex $res 0]`
307			`set gdbserver_gdbport [lindex $res 1]`
308
309			`return [gdb_target_cmd $gdbserver_protocol $gdbserver_gdbport]`
310			`}`
311
312			`# Reconnect to the previous gdbserver session.`
313
314			`proc gdbserver_reconnect { } {`
315			`global gdbserver_protocol`
316			`global gdbserver_gdbport`
317
318			`return [gdb_target_cmd $gdbserver_protocol $gdbserver_gdbport]`
319			`}`
320
321			`# Start and connect to a gdbserver in extended mode.`
322			`proc gdbserver_start_extended { } {`
323			`set res [gdbserver_start "--multi" ""]`
324			`set gdbserver_protocol "extended-[lindex $res 0]"`
325			`set gdbserver_gdbport [lindex $res 1]`
326
327			`return [gdb_target_cmd $gdbserver_protocol $gdbserver_gdbport]`
328			`}`