1# Copyright 1999, 2000, 2002, 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# Please email any bugs, comments, and/or additions to this file to:
18# bug-gdb@prep.ai.mit.edu
19
20# This file was based on a file written by Fred Fish. (fnf@cygnus.com)
21
22# Test setup routines that work with the MI interpreter.
23
24# The variable mi_gdb_prompt is a regexp which matches the gdb mi prompt.
25# Set it if it is not already set.
26global mi_gdb_prompt
27if ![info exists mi_gdb_prompt] then {
28    set mi_gdb_prompt "\[(\]gdb\[)\] \r\n"
29}
30
31set MIFLAGS "-i=mi"
32
33#
34# mi_gdb_exit -- exit the GDB, killing the target program if necessary
35#
36proc mi_gdb_exit {} {
37    catch mi_uncatched_gdb_exit
38}
39
40proc mi_uncatched_gdb_exit {} {
41    global GDB
42    global GDBFLAGS
43    global verbose
44    global gdb_spawn_id;
45    global gdb_prompt
46    global mi_gdb_prompt
47    global MIFLAGS
48
49    gdb_stop_suppressing_tests;
50
51    if { [info procs sid_exit] != "" } {
52	sid_exit
53    }
54
55    if ![info exists gdb_spawn_id] {
56	return;
57    }
58
59    verbose "Quitting $GDB $GDBFLAGS $MIFLAGS"
60
61    if { [is_remote host] && [board_info host exists fileid] } {
62	send_gdb "999-gdb-exit\n";
63	gdb_expect 10 {
64	    -re "y or n" {
65		send_gdb "y\n";
66		exp_continue;
67	    }
68            -re "Undefined command.*$gdb_prompt $" {
69                send_gdb "quit\n"
70		exp_continue;
71            }
72	    -re "DOSEXIT code" { }
73	    default { }
74	}
75    }
76
77    if ![is_remote host] {
78	remote_close host;
79    }
80    unset gdb_spawn_id
81}
82
83#
84# start gdb -- start gdb running, default procedure
85#
86# When running over NFS, particularly if running many simultaneous
87# tests on different hosts all using the same server, things can
88# get really slow.  Give gdb at least 3 minutes to start up.
89#
90proc mi_gdb_start { } {
91    global verbose
92    global GDB
93    global GDBFLAGS
94    global gdb_prompt
95    global mi_gdb_prompt
96    global timeout
97    global gdb_spawn_id;
98    global MIFLAGS
99
100    gdb_stop_suppressing_tests;
101
102    # Start SID.
103    if { [info procs sid_start] != "" } {
104	verbose "Spawning SID"
105	sid_start
106    }
107
108    verbose "Spawning $GDB -nw $GDBFLAGS $MIFLAGS"
109
110    if [info exists gdb_spawn_id] {
111	return 0;
112    }
113
114    if ![is_remote host] {
115	if { [which $GDB] == 0 } then {
116	    perror "$GDB does not exist."
117	    exit 1
118	}
119    }
120    set res [remote_spawn host "$GDB -nw $GDBFLAGS $MIFLAGS [host_info gdb_opts]"];
121    if { $res < 0 || $res == "" } {
122	perror "Spawning $GDB failed."
123	return 1;
124    }
125    gdb_expect {
126	-re "~\"GNU.*\r\n~\".*$mi_gdb_prompt$" {
127	    # We have a new format mi startup prompt.  If we are
128	    # running mi1, then this is an error as we should be
129	    # using the old-style prompt.
130	    if { $MIFLAGS == "-i=mi1" } {
131	        perror "(mi startup) Got unexpected new mi prompt."
132	        remote_close host;
133	        return -1;
134	    }
135	    verbose "GDB initialized."
136	}
137	-re "\[^~\].*$mi_gdb_prompt$" {
138	    # We have an old format mi startup prompt.  If we are
139	    # not running mi1, then this is an error as we should be
140	    # using the new-style prompt.
141	    if { $MIFLAGS != "-i=mi1" } {
142	        perror "(mi startup) Got unexpected old mi prompt."
143	        remote_close host;
144	        return -1;
145	    }
146	    verbose "GDB initialized."
147	}
148	-re ".*$gdb_prompt $" {
149	    untested "Skip mi tests (got non-mi prompt)."
150	    remote_close host;
151	    return -1;
152	}
153	-re ".*unrecognized option.*for a complete list of options." {
154	    untested "Skip mi tests (not compiled with mi support)."
155	    remote_close host;
156	    return -1;
157	}
158	-re ".*Interpreter `mi' unrecognized." {
159	    untested "Skip mi tests (not compiled with mi support)."
160	    remote_close host;
161	    return -1;
162	}
163	timeout {
164	    perror "(timeout) GDB never initialized after 10 seconds."
165	    remote_close host;
166	    return -1
167	}
168    }
169    set gdb_spawn_id -1;
170
171    # FIXME: mi output does not go through pagers, so these can be removed.
172    # force the height to "unlimited", so no pagers get used
173    send_gdb "100-gdb-set height 0\n"
174    gdb_expect 10 {
175	-re ".*100-gdb-set height 0\r\n100\\\^done\r\n$mi_gdb_prompt$" {
176	    verbose "Setting height to 0." 2
177	}
178	timeout {
179	    warning "Couldn't set the height to 0"
180	}
181    }
182    # force the width to "unlimited", so no wraparound occurs
183    send_gdb "101-gdb-set width 0\n"
184    gdb_expect 10 {
185	-re ".*101-gdb-set width 0\r\n101\\\^done\r\n$mi_gdb_prompt$" {
186	    verbose "Setting width to 0." 2
187	}
188	timeout {
189	    warning "Couldn't set the width to 0."
190	}
191    }
192
193    return 0;
194}
195
196# Many of the tests depend on setting breakpoints at various places and
197# running until that breakpoint is reached.  At times, we want to start
198# with a clean-slate with respect to breakpoints, so this utility proc
199# lets us do this without duplicating this code everywhere.
200#
201
202proc mi_delete_breakpoints {} {
203    global mi_gdb_prompt
204
205# FIXME: The mi operation won't accept a prompt back and will use the 'all' arg
206    send_gdb "102-break-delete\n"
207    gdb_expect 30 {
208	 -re "Delete all breakpoints.*y or n.*$" {
209	    send_gdb "y\n";
210	    exp_continue
211         }
212	 -re ".*102-break-delete\r\n102\\\^done\r\n$mi_gdb_prompt$" {
213            # This happens if there were no breakpoints
214	 }
215	 timeout { perror "Delete all breakpoints in mi_delete_breakpoints (timeout)" ; return }
216    }
217
218# The correct output is not "No breakpoints or watchpoints." but an
219# empty BreakpointTable. Also, a query is not acceptable with mi.
220    send_gdb "103-break-list\n"
221    gdb_expect 30 {
222	 -re "103-break-list\r\n103\\\^done,BreakpointTable=\{\}\r\n$mi_gdb_prompt$" {}
223	 -re "103-break-list\r\n103\\\^done,BreakpointTable=\{nr_rows=\".\",nr_cols=\".\",hdr=\\\[\{width=\".*\",alignment=\".*\",col_name=\"number\",colhdr=\"Num\"\}.*colhdr=\"Type\".*colhdr=\"Disp\".*colhdr=\"Enb\".*colhdr=\"Address\".*colhdr=\"What\".*\\\],body=\\\[\\\]\}" {}
224	 -re "103-break-list\r\n103\\\^doneNo breakpoints or watchpoints.\r\n\r\n$mi_gdb_prompt$" {warning "Unexpected console text received"}
225	 -re "$mi_gdb_prompt$" { perror "Breakpoints not deleted" ; return }
226	 -re "Delete all breakpoints.*or n.*$" {
227	    warning "Unexpected prompt for breakpoints deletion";
228	    send_gdb "y\n";
229	    exp_continue
230	}
231	 timeout { perror "-break-list (timeout)" ; return }
232    }
233}
234
235proc mi_gdb_reinitialize_dir { subdir } {
236    global mi_gdb_prompt
237    global MIFLAGS
238
239    global suppress_flag
240    if { $suppress_flag } {
241	return
242    }
243
244    if [is_remote host] {
245	return "";
246    }
247
248    if { $MIFLAGS == "-i=mi1" } {
249      send_gdb "104-environment-directory\n"
250      gdb_expect 60 {
251	-re ".*Reinitialize source path to empty.*y or n. " {
252            warning "Got confirmation prompt for dir reinitialization."
253	    send_gdb "y\n"
254	    gdb_expect 60 {
255		-re "$mi_gdb_prompt$" {}
256                timeout {error "Dir reinitialization failed (timeout)"}
257	    }
258	}
259	-re "$mi_gdb_prompt$" {}
260        timeout {error "Dir reinitialization failed (timeout)"}
261      }
262    } else {
263      send_gdb "104-environment-directory -r\n"
264      gdb_expect 60 {
265	-re "104\\\^done,source-path=.*\r\n$mi_gdb_prompt$" {}
266	-re "$mi_gdb_prompt$" {}
267        timeout {error "Dir reinitialization failed (timeout)"}
268      }
269    }
270
271    send_gdb "105-environment-directory $subdir\n"
272    gdb_expect 60 {
273	-re "Source directories searched.*$mi_gdb_prompt$" {
274	    verbose "Dir set to $subdir"
275	}
276	-re "105\\\^done.*\r\n$mi_gdb_prompt$" {
277            # FIXME: We return just the prompt for now.
278	    verbose "Dir set to $subdir"
279	    # perror "Dir \"$subdir\" failed."
280	}
281    }
282}
283
284# Send GDB the "target" command.
285# FIXME: Some of these patterns are not appropriate for MI.  Based on
286# config/monitor.exp:gdb_target_command.
287proc mi_gdb_target_cmd { targetname serialport } {
288    global mi_gdb_prompt
289
290    for {set i 1} {$i <= 3} {incr i} {
291	send_gdb "47-target-select $targetname $serialport\n"
292	gdb_expect 60 {
293	    -re "47\\^connected.*$mi_gdb_prompt$" {
294		verbose "Set target to $targetname";
295		return 0;
296	    }
297	    -re "Couldn't establish connection to remote.*$mi_gdb_prompt$" {
298		verbose "Connection failed";
299	    }
300	    -re "Remote MIPS debugging.*$mi_gdb_prompt$" {
301		verbose "Set target to $targetname";
302		return 0;
303	    }
304	    -re "Remote debugging using .*$serialport.*$mi_gdb_prompt$" {
305		verbose "Set target to $targetname";
306		return 0;
307	    }
308	    -re "Remote target $targetname connected to.*$mi_gdb_prompt$" {
309		verbose "Set target to $targetname";
310		return 0;
311	    }
312	    -re "Connected to.*$mi_gdb_prompt$" {
313		verbose "Set target to $targetname";
314		return 0;
315	    }
316	    -re "Ending remote.*$mi_gdb_prompt$" { }
317	    -re "Connection refused.*$mi_gdb_prompt$" {
318		verbose "Connection refused by remote target.  Pausing, and trying again."
319		sleep 5
320		continue
321	    }
322	    -re "Timeout reading from remote system.*$mi_gdb_prompt$" {
323		verbose "Got timeout error from gdb.";
324	    }
325	    timeout {
326		send_gdb "";
327		break
328	    }
329	}
330    }
331    return 1
332}
333
334#
335# load a file into the debugger (file command only).
336# return a -1 if anything goes wrong.
337#
338proc mi_gdb_file_cmd { arg } {
339    global verbose
340    global loadpath
341    global loadfile
342    global GDB
343    global mi_gdb_prompt
344    global last_mi_gdb_file
345    global last_mi_remote_file
346    upvar timeout timeout
347
348    if { $arg == "" } {
349	set arg $last_mi_gdb_file;
350    } else {
351	set last_mi_gdb_file $arg
352	if { [ info exists last_mi_remote_file ] } {
353	    unset last_mi_remote_file
354	}
355    }
356
357    if [is_remote host] {
358	set arg [remote_download host $arg];
359	if { $arg == "" } {
360	    error "download failed"
361	    return -1;
362	}
363    }
364
365# FIXME: Several of these patterns are only acceptable for console
366# output.  Queries are an error for mi.
367    send_gdb "105-file-exec-and-symbols $arg\n"
368    gdb_expect 120 {
369        -re "Reading symbols from.*done.*$mi_gdb_prompt$" {
370            verbose "\t\tLoaded $arg into the $GDB"
371            return 0
372        }
373        -re "has no symbol-table.*$mi_gdb_prompt$" {
374            perror "$arg wasn't compiled with \"-g\""
375            return -1
376        }
377        -re "A program is being debugged already.*Kill it.*y or n. $" {
378            send_gdb "y\n"
379                verbose "\t\tKilling previous program being debugged"
380            exp_continue
381        }
382        -re "Load new symbol table from \".*\".*y or n. $" {
383            send_gdb "y\n"
384            gdb_expect 120 {
385                -re "Reading symbols from.*done.*$mi_gdb_prompt$" {
386                    verbose "\t\tLoaded $arg with new symbol table into $GDB"
387                    # All OK
388                }
389                timeout {
390                    perror "(timeout) Couldn't load $arg, other program already loaded."
391                    return -1
392                }
393            }
394	}
395        -re "No such file or directory.*$mi_gdb_prompt$" {
396            perror "($arg) No such file or directory\n"
397            return -1
398        }
399        -re "105-file-exec-and-symbols .*\r\n105\\\^done\r\n$mi_gdb_prompt$" {
400            # We (MI) are just giving the prompt back for now, instead of giving
401	    # some acknowledgement.
402	    return 0
403	}
404        timeout {
405            perror "couldn't load $arg into $GDB (timed out)."
406            return -1
407        }
408	eof {
409            # This is an attempt to detect a core dump, but seems not to
410            # work.  Perhaps we need to match .* followed by eof, in which
411            # gdb_expect does not seem to have a way to do that.
412            perror "couldn't load $arg into $GDB (end of file)."
413            return -1
414        }
415    }
416}
417
418#
419# load a file into the debugger.
420# return a -1 if anything goes wrong.
421#
422proc mi_gdb_load { arg } {
423    global verbose
424    global loadpath
425    global loadfile
426    global GDB
427    global mi_gdb_prompt
428    upvar timeout timeout
429
430    # ``gdb_unload''
431    if { $arg != "" } {
432	mi_gdb_file_cmd $arg
433    }
434
435    # ``load''
436    if { [info procs gdbserver_gdb_load] != "" } {
437	global last_mi_gdb_file
438	global last_mi_remote_file
439
440	if { ! [info exists last_mi_remote_file] } {
441	    if [is_remote target] {
442		set last_mi_remote_file [remote_download target $arg]
443	    } else {
444		set last_mi_remote_file $last_mi_gdb_file
445	    }
446	}
447
448	set res [gdbserver_gdb_load $last_mi_remote_file]
449	set protocol [lindex $res 0]
450	set gdbport [lindex $res 1]
451
452	if { [mi_gdb_target_cmd $protocol $gdbport] != 0 } {
453	    return -1
454	}
455    } elseif { [info procs send_target_sid] != "" } {
456	# For SID, things get complex
457	send_target_sid
458	gdb_expect 60 {
459	    -re "\\^done,.*$mi_gdb_prompt$" {
460	    }
461	    timeout {
462		perror "Unable to connect to SID target"
463		return -1
464	    }
465	}
466	send_gdb "48-target-download\n"
467	gdb_expect 10 {
468	    -re "48\\^done.*$mi_gdb_prompt$" {
469	    }
470	    timeout {
471		perror "Unable to download to SID target"
472		return -1
473	    }
474	}
475    } elseif { [target_info protocol] == "sim" } {
476	# For the simulator, just connect to it directly.
477	send_gdb "47-target-select sim\n"
478	gdb_expect 10 {
479	    -re "47\\^connected.*$mi_gdb_prompt$" {
480	    }
481	    timeout {
482		perror "Unable to select sim target"
483		return -1
484	    }
485	}
486	send_gdb "48-target-download\n"
487	gdb_expect 10 {
488	    -re "48\\^done.*$mi_gdb_prompt$" {
489	    }
490	    timeout {
491		perror "Unable to download to sim target"
492		return -1
493	    }
494	}
495    } elseif { [target_info gdb_protocol] == "remote" } {
496	# remote targets
497	send_gdb "target [target_info gdb_protocol] [target_info netport]\n"
498	gdb_expect 60 {
499	    -re "\\^done,.*$mi_gdb_prompt$" {
500	    }
501	    timeout {
502		perror "Unable to connect to remote target"
503		return -1
504	    }
505	}
506	send_gdb "48-target-download\n"
507	gdb_expect 10 {
508	    -re "48\\^done.*$mi_gdb_prompt$" {
509	    }
510	    timeout {
511		perror "Unable to download to remote target"
512		return -1
513	    }
514	}
515    }
516    return 0
517}
518
519# mi_gdb_test COMMAND PATTERN MESSAGE -- send a command to gdb; test the result.
520#
521# COMMAND is the command to execute, send to GDB with send_gdb.  If
522#   this is the null string no command is sent.
523# PATTERN is the pattern to match for a PASS, and must NOT include
524#   the \r\n sequence immediately before the gdb prompt.
525# MESSAGE is an optional message to be printed.  If this is
526#   omitted, then the pass/fail messages use the command string as the
527#   message.  (If this is the empty string, then sometimes we don't
528#   call pass or fail at all; I don't understand this at all.)
529#
530# Returns:
531#    1 if the test failed,
532#    0 if the test passes,
533#   -1 if there was an internal error.
534#
535proc mi_gdb_test { args } {
536    global verbose
537    global mi_gdb_prompt
538    global GDB expect_out
539    upvar timeout timeout
540
541    if [llength $args]>2 then {
542	set message [lindex $args 2]
543    } else {
544	set message [lindex $args 0]
545    }
546    set command [lindex $args 0]
547    set pattern [lindex $args 1]
548
549    if [llength $args]==5 {
550	set question_string [lindex $args 3];
551	set response_string [lindex $args 4];
552    } else {
553	set question_string "^FOOBAR$"
554    }
555
556    if $verbose>2 then {
557	send_user "Sending \"$command\" to gdb\n"
558	send_user "Looking to match \"$pattern\"\n"
559	send_user "Message is \"$message\"\n"
560    }
561
562    set result -1
563    set string "${command}\n";
564    if { $command != "" } {
565	while { "$string" != "" } {
566	    set foo [string first "\n" "$string"];
567	    set len [string length "$string"];
568	    if { $foo < [expr $len - 1] } {
569		set str [string range "$string" 0 $foo];
570		if { [send_gdb "$str"] != "" } {
571		    global suppress_flag;
572
573		    if { ! $suppress_flag } {
574			perror "Couldn't send $command to GDB.";
575		    }
576		    fail "$message";
577		    return $result;
578		}
579		gdb_expect 2 {
580		    -re "\[\r\n\]" { }
581		    timeout { }
582		}
583		set string [string range "$string" [expr $foo + 1] end];
584	    } else {
585		break;
586	    }
587	}
588	if { "$string" != "" } {
589	    if { [send_gdb "$string"] != "" } {
590		global suppress_flag;
591
592		if { ! $suppress_flag } {
593		    perror "Couldn't send $command to GDB.";
594		}
595		fail "$message";
596		return $result;
597	    }
598	}
599    }
600
601    if [info exists timeout] {
602	set tmt $timeout;
603    } else {
604	global timeout;
605	if [info exists timeout] {
606	    set tmt $timeout;
607	} else {
608	    set tmt 60;
609	}
610    }
611    gdb_expect $tmt {
612	 -re "\\*\\*\\* DOSEXIT code.*" {
613	     if { $message != "" } {
614		 fail "$message";
615	     }
616	     gdb_suppress_entire_file "GDB died";
617	     return -1;
618	 }
619	 -re "Ending remote debugging.*$mi_gdb_prompt\[ \]*$" {
620	    if ![isnative] then {
621		warning "Can`t communicate to remote target."
622	    }
623	    gdb_exit
624	    gdb_start
625	    set result -1
626	}
627	 -re "\[\r\n\]*($pattern)\[\r\n\]+$mi_gdb_prompt\[ \]*$" {
628	    if ![string match "" $message] then {
629		pass "$message"
630	    }
631	    set result 0
632	}
633	 -re "(${question_string})$" {
634	    send_gdb "$response_string\n";
635	    exp_continue;
636	}
637	 -re "Undefined.* command:.*$mi_gdb_prompt\[ \]*$" {
638	    perror "Undefined command \"$command\"."
639            fail "$message"
640	    set result 1
641	}
642	 -re "Ambiguous command.*$mi_gdb_prompt\[ \]*$" {
643	    perror "\"$command\" is not a unique command name."
644            fail "$message"
645	    set result 1
646	}
647	 -re "Program exited with code \[0-9\]+.*$mi_gdb_prompt\[ \]*$" {
648	    if ![string match "" $message] then {
649		set errmsg "$message (the program exited)"
650	    } else {
651		set errmsg "$command (the program exited)"
652	    }
653	    fail "$errmsg"
654	    return -1
655	}
656	 -re "The program is not being run.*$mi_gdb_prompt\[ \]*$" {
657	    if ![string match "" $message] then {
658		set errmsg "$message (the program is no longer running)"
659	    } else {
660		set errmsg "$command (the program is no longer running)"
661	    }
662	    fail "$errmsg"
663	    return -1
664	}
665	 -re ".*$mi_gdb_prompt\[ \]*$" {
666	    if ![string match "" $message] then {
667		fail "$message"
668	    }
669	    set result 1
670	}
671	 "<return>" {
672	    send_gdb "\n"
673	    perror "Window too small."
674            fail "$message"
675	}
676	 -re "\\(y or n\\) " {
677	    send_gdb "n\n"
678	    perror "Got interactive prompt."
679            fail "$message"
680	}
681	 eof {
682	     perror "Process no longer exists"
683	     if { $message != "" } {
684		 fail "$message"
685	     }
686	     return -1
687	}
688	 full_buffer {
689	    perror "internal buffer is full."
690            fail "$message"
691	}
692	timeout	{
693	    if ![string match "" $message] then {
694		fail "$message (timeout)"
695	    }
696	    set result 1
697	}
698    }
699    return $result
700}
701
702#
703# MI run command.  (A modified version of gdb_run_cmd)
704#
705
706# In patterns, the newline sequence ``\r\n'' is matched explicitly as
707# ``.*$'' could swallow up output that we attempt to match elsewhere.
708
709proc mi_run_cmd {args} {
710    global suppress_flag
711    if { $suppress_flag } {
712	return -1
713    }
714    global mi_gdb_prompt
715
716    if [target_info exists gdb_init_command] {
717	send_gdb "[target_info gdb_init_command]\n";
718	gdb_expect 30 {
719	    -re "$mi_gdb_prompt$" { }
720	    default {
721		perror "gdb_init_command for target failed";
722		return;
723	    }
724	}
725    }
726
727    if [target_info exists use_gdb_stub] {
728	if [target_info exists gdb,do_reload_on_run] {
729	    # Specifying no file, defaults to the executable
730	    # currently being debugged.
731	    if { [mi_gdb_load ""] < 0 } {
732		return;
733	    }
734	    send_gdb "000-exec-continue\n";
735	    gdb_expect 60 {
736		-re "000\\^running\[\r\n\]+$mi_gdb_prompt$" {}
737		default {}
738	    }
739	    return;
740	}
741
742	if [target_info exists gdb,start_symbol] {
743	    set start [target_info gdb,start_symbol];
744	} else {
745	    set start "start";
746	}
747
748	# HACK: Should either use 000-jump or fix the target code
749	# to better handle RUN.
750	send_gdb  "jump *$start\n"
751	warning "Using CLI jump command, expect run-to-main FAIL"
752	return
753    }
754
755    send_gdb "000-exec-run $args\n"
756    gdb_expect {
757	-re "000\\^running\r\n${mi_gdb_prompt}" {
758	}
759	timeout {
760	    perror "Unable to start target"
761	    return
762	}
763    }
764    # NOTE: Shortly after this there will be a ``000*stopping,...(gdb)''
765}
766
767#
768# Just like run-to-main but works with the MI interface
769#
770
771proc mi_run_to_main { } {
772    global suppress_flag
773    if { $suppress_flag } {
774	return -1
775    }
776
777    global srcdir
778    global subdir
779    global binfile
780    global srcfile
781
782    mi_delete_breakpoints
783    mi_gdb_reinitialize_dir $srcdir/$subdir
784    mi_gdb_load ${binfile}
785
786    mi_runto main
787}
788
789
790# Just like gdb's "runto" proc, it will run the target to a given
791# function.  The big difference here between mi_runto and mi_execute_to
792# is that mi_execute_to must have the inferior running already.  This
793# proc will (like gdb's runto) (re)start the inferior, too.
794#
795# FUNC is the linespec of the place to stop (it inserts a breakpoint here).
796# It returns:
797#   -1  if test suppressed, failed, timedout
798#    0  if test passed
799
800proc mi_runto {func} {
801  global suppress_flag
802  if { $suppress_flag } {
803    return -1
804  }
805
806  global mi_gdb_prompt expect_out
807  global hex decimal
808
809  set test "mi runto $func"
810  mi_gdb_test "200-break-insert $func" \
811    "200\\^done,bkpt=\{number=\"\[0-9\]+\",type=\"breakpoint\",disp=\"keep\",enabled=\"y\",addr=\"$hex\",func=\"$func\",file=\".*\",line=\"\[0-9\]*\",times=\"0\"\}" \
812    "breakpoint at $func"
813
814  if {![regexp {number="[0-9]+"} $expect_out(buffer) str]
815      || ![scan $str {number="%d"} bkptno]} {
816    set bkptno {[0-9]+}
817  }
818
819  mi_run_cmd
820  gdb_expect {
821    -re ".*000\\*stopped,reason=\"breakpoint-hit\",bkptno=\"$bkptno\",thread-id=\"$decimal\",frame=\{addr=\"$hex\",func=\"$func\",args=\(\\\[.*\\\]\|\{.*\}\),file=\".*\",line=\"\[0-9\]*\"\}\r\n$mi_gdb_prompt$" {
822      pass "$test"
823      return 0
824    }
825    -re ".*$mi_gdb_prompt$" {
826      fail "$test (2)"
827    }
828    timeout {
829      fail "$test (timeout)"
830      return -1
831    }
832  }
833}
834
835
836# Next to the next statement
837# For return values, see mi_execute_to_helper
838
839proc mi_next { test } {
840  return [mi_next_to {.*} {.*} {.*} {.*} $test]
841}
842
843
844# Step to the next statement
845# For return values, see mi_execute_to_helper
846
847proc mi_step { test } {
848  return [mi_step_to {.*} {.*} {.*} {.*} $test]
849}
850
851# cmd should not include the number or newline (i.e. "exec-step 3", not
852# "220-exec-step 3\n"
853
854# Can not match -re ".*\r\n${mi_gdb_prompt}", because of false positives
855# after the first prompt is printed.
856
857proc mi_execute_to_helper { cmd reason func args file line extra test } {
858    global suppress_flag
859    if { $suppress_flag } {
860	return -1
861    }
862    global mi_gdb_prompt
863    global hex
864    global decimal
865    send_gdb "220-$cmd\n"
866    gdb_expect {
867	-re ".*220\\^running\r\n${mi_gdb_prompt}.*220\\*stopped,reason=\"$reason\",thread-id=\"$decimal\",frame=\{addr=\"$hex\",func=\"$func\",args=$args,file=\".*$file\",line=\"$line\"\}$extra\r\n$mi_gdb_prompt$" {
868	    pass "$test"
869	    return 0
870	}
871	-re ".*220\\^running\r\n${mi_gdb_prompt}.*220\\*stopped,reason=\"$reason\",thread-id=\"$decimal\",frame=\{addr=\"$hex\",func=\".*\",args=\[\\\[\{\].*\[\\\]\}\],file=\".*\",line=\"\[0-9\]*\"\}.*\r\n$mi_gdb_prompt$" {
872	    fail "$test (stopped at wrong place)"
873	    return -1
874	}
875	-re "220\\^running\r\n${mi_gdb_prompt}.*\r\n${mi_gdb_prompt}$" {
876	    fail "$test (unknown output after running)"
877	    return -1
878	}
879	timeout {
880	    fail "$test (timeout)"
881	    return -1
882	}
883    }
884}
885
886proc mi_execute_to { cmd reason func args file line extra test } {
887    mi_execute_to_helper "$cmd" "$reason" "$func" "\\\[$args\\\]" \
888	"$file" "$line" "$extra" "$test"
889}
890
891proc mi_next_to { func args file line test } {
892    mi_execute_to "exec-next" "end-stepping-range" "$func" "$args" \
893	"$file" "$line" "" "$test"
894}
895
896proc mi_step_to { func args file line test } {
897    mi_execute_to "exec-step" "end-stepping-range" "$func" "$args" \
898	"$file" "$line" "" "$test"
899}
900
901proc mi_finish_to { func args file line result ret test } {
902    mi_execute_to "exec-finish" "function-finished" "$func" "$args" \
903	"$file" "$line" \
904	",gdb-result-var=\"$result\",return-value=\"$ret\"" \
905	"$test"
906}
907
908proc mi_continue_to { bkptno func args file line test } {
909    mi_execute_to "exec-continue" "breakpoint-hit\",bkptno=\"$bkptno" \
910	"$func" "$args" "$file" "$line" "" "$test"
911}
912
913proc mi0_execute_to { cmd reason func args file line extra test } {
914    mi_execute_to_helper "$cmd" "$reason" "$func" "\{$args\}" \
915	"$file" "$line" "$extra" "$test"
916}
917
918proc mi0_next_to { func args file line test } {
919    mi0_execute_to "exec-next" "end-stepping-range" "$func" "$args" \
920	"$file" "$line" "" "$test"
921}
922
923proc mi0_step_to { func args file line test } {
924    mi0_execute_to "exec-step" "end-stepping-range" "$func" "$args" \
925	"$file" "$line" "" "$test"
926}
927
928proc mi0_finish_to { func args file line result ret test } {
929    mi0_execute_to "exec-finish" "function-finished" "$func" "$args" \
930	"$file" "$line" \
931	",gdb-result-var=\"$result\",return-value=\"$ret\"" \
932	"$test"
933}
934
935proc mi0_continue_to { bkptno func args file line test } {
936    mi0_execute_to "exec-continue" "breakpoint-hit\",bkptno=\"$bkptno" \
937	"$func" "$args" "$file" "$line" "" "$test"
938}
939