OpenCores
URL https://opencores.org/ocsvn/or1k/or1k/trunk

Subversion Repositories or1k

[/] [or1k/] [trunk/] [insight/] [gdb/] [testsuite/] [lib/] [mi-support.exp] - Blame information for rev 1767

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

Line No. Rev Author Line
1 578 markom
# Copyright 1999, 2000 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.
26
global mi_gdb_prompt
27
if ![info exists mi_gdb_prompt] then {
28
    set mi_gdb_prompt "\[(\]gdb\[)\] \r\n"
29
}
30
 
31
set MIFLAGS "-i=mi"
32
 
33
#
34
# mi_gdb_exit -- exit the GDB, killing the target program if necessary
35
#
36
proc mi_gdb_exit {} {
37
    catch mi_uncatched_gdb_exit
38
}
39
 
40
proc 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
#
90
proc 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
    verbose "Spawning $GDB -nw $GDBFLAGS $MIFLAGS"
103
 
104
    if [info exists gdb_spawn_id] {
105
        return 0;
106
    }
107
 
108
    if ![is_remote host] {
109
        if { [which $GDB] == 0 } then {
110
            perror "$GDB does not exist."
111
            exit 1
112
        }
113
    }
114
    set res [remote_spawn host "$GDB -nw $GDBFLAGS $MIFLAGS [host_info gdb_opts]"];
115
    if { $res < 0 || $res == "" } {
116
        perror "Spawning $GDB failed."
117
        return 1;
118
    }
119
    gdb_expect {
120
        -re ".*MI_OUT.*$mi_gdb_prompt$" {
121
            verbose "GDB initialized."
122
        }
123
        -re ".*$mi_gdb_prompt$" {
124
            untested "Skip mi tests (output not in headless format)."
125
            remote_close host;
126
            return -1;
127
        }
128
        -re ".*$gdb_prompt $" {
129
            untested "Skip mi tests (got non-mi prompt)."
130
            remote_close host;
131
            return -1;
132
        }
133
        -re ".*unrecognized option.*for a complete list of options." {
134
            untested "Skip mi tests (not compiled with mi support)."
135
            remote_close host;
136
            return -1;
137
        }
138
        -re ".*Interpreter `mi' unrecognized." {
139
            untested "Skip mi tests (not compiled with mi support)."
140
            remote_close host;
141
            return -1;
142
        }
143
        timeout {
144
            perror "(timeout) GDB never initialized after 10 seconds."
145
            remote_close host;
146
            return -1
147
        }
148
    }
149
    set gdb_spawn_id -1;
150
 
151
    # FIXME: mi output does not go through pagers, so these can be removed.
152
    # force the height to "unlimited", so no pagers get used
153
    send_gdb "100-gdb-set height 0\n"
154
    gdb_expect 10 {
155
        -re ".*100-gdb-set height 0\r\n100\\\^done\r\n$mi_gdb_prompt$" {
156
            verbose "Setting height to 0." 2
157
        }
158
        timeout {
159
            warning "Couldn't set the height to 0"
160
        }
161
    }
162
    # force the width to "unlimited", so no wraparound occurs
163
    send_gdb "101-gdb-set width 0\n"
164
    gdb_expect 10 {
165
        -re ".*101-gdb-set width 0\r\n101\\\^done\r\n$mi_gdb_prompt$" {
166
            verbose "Setting width to 0." 2
167
        }
168
        timeout {
169
            warning "Couldn't set the width to 0."
170
        }
171
    }
172
 
173
    # Finally start SID.
174
    if { [info procs sid_start] != "" } {
175
        verbose "Spawning SID"
176
        sid_start
177
    }
178
 
179
    return 0;
180
}
181
 
182
# Many of the tests depend on setting breakpoints at various places and
183
# running until that breakpoint is reached.  At times, we want to start
184
# with a clean-slate with respect to breakpoints, so this utility proc
185
# lets us do this without duplicating this code everywhere.
186
#
187
 
188
proc mi_delete_breakpoints {} {
189
    global mi_gdb_prompt
190
 
191
# FIXME: The mi operation won't accept a prompt back and will use the 'all' arg
192
    send_gdb "102-break-delete\n"
193
    gdb_expect 30 {
194
         -re "Delete all breakpoints.*y or n.*$" {
195
            send_gdb "y\n";
196
            exp_continue
197
         }
198
         -re ".*102-break-delete\r\n102\\\^done\r\n$mi_gdb_prompt$" {
199
            # This happens if there were no breakpoints
200
         }
201
         timeout { perror "Delete all breakpoints in delete_breakpoints (timeout)" ; return }
202
    }
203
 
204
# The correct output is not "No breakpoints or watchpoints." but an
205
# empty BreakpointTable. Also, a query is not acceptable with mi.
206
    send_gdb "103-break-list\n"
207
    gdb_expect 30 {
208
         -re "103-break-list\r\n103\\\^done,BreakpointTable=\{\}\r\n$mi_gdb_prompt$" {}
209
         -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=\\\[\\\]\}" {}
210
         -re "103-break-list\r\n103\\\^doneNo breakpoints or watchpoints.\r\n\r\n$mi_gdb_prompt$" {warning "Unexpected console text received"}
211
         -re "$mi_gdb_prompt$" { perror "Breakpoints not deleted" ; return }
212
         -re "Delete all breakpoints.*or n.*$" {
213
            warning "Unexpected prompt for breakpoints deletion";
214
            send_gdb "y\n";
215
            exp_continue
216
        }
217
         timeout { perror "-break-list (timeout)" ; return }
218
    }
219
}
220
 
221
proc mi_gdb_reinitialize_dir { subdir } {
222
    global mi_gdb_prompt
223
 
224
    global suppress_flag
225
    if { $suppress_flag } {
226
        return
227
    }
228
 
229
    if [is_remote host] {
230
        return "";
231
    }
232
 
233
    send_gdb "104-environment-directory\n"
234
    gdb_expect 60 {
235
        -re ".*Reinitialize source path to empty.*y or n. " {
236
            warning "Got confirmation prompt for dir reinitialization."
237
            send_gdb "y\n"
238
            gdb_expect 60 {
239
                -re "$mi_gdb_prompt$" {}
240
                timeout {error "Dir reinitialization failed (timeout)"}
241
            }
242
        }
243
        -re "$mi_gdb_prompt$" {}
244
        timeout {error "Dir reinitialization failed (timeout)"}
245
    }
246
 
247
    send_gdb "105-environment-directory $subdir\n"
248
    gdb_expect 60 {
249
        -re "Source directories searched.*$mi_gdb_prompt$" {
250
            verbose "Dir set to $subdir"
251
        }
252
        -re "105\\\^done\r\n$mi_gdb_prompt$" {
253
            # FIXME: We return just the prompt for now.
254
            verbose "Dir set to $subdir"
255
            # perror "Dir \"$subdir\" failed."
256
        }
257
    }
258
}
259
 
260
#
261
# load a file into the debugger.
262
# return a -1 if anything goes wrong.
263
#
264
proc mi_gdb_load { arg } {
265
    global verbose
266
    global loadpath
267
    global loadfile
268
    global GDB
269
    global mi_gdb_prompt
270
    upvar timeout timeout
271
 
272
    # ``gdb_unload''
273
 
274
    # ``gdb_file_cmd''
275
# FIXME: Several of these patterns are only acceptable for console
276
# output.  Queries are an error for mi.
277
    send_gdb "105-file-exec-and-symbols $arg\n"
278
    gdb_expect 120 {
279
        -re "Reading symbols from.*done.*$mi_gdb_prompt$" {
280
            verbose "\t\tLoaded $arg into the $GDB"
281
            # All OK
282
        }
283
        -re "has no symbol-table.*$mi_gdb_prompt$" {
284
            perror "$arg wasn't compiled with \"-g\""
285
            return -1
286
        }
287
        -re "A program is being debugged already.*Kill it.*y or n. $" {
288
            send_gdb "y\n"
289
                verbose "\t\tKilling previous program being debugged"
290
            exp_continue
291
        }
292
        -re "Load new symbol table from \".*\".*y or n. $" {
293
            send_gdb "y\n"
294
            gdb_expect 120 {
295
                -re "Reading symbols from.*done.*$mi_gdb_prompt$" {
296
                    verbose "\t\tLoaded $arg with new symbol table into $GDB"
297
                    # All OK
298
                }
299
                timeout {
300
                    perror "(timeout) Couldn't load $arg, other program already loaded."
301
                    return -1
302
                }
303
            }
304
        }
305
        -re "No such file or directory.*$mi_gdb_prompt$" {
306
            perror "($arg) No such file or directory\n"
307
            return -1
308
        }
309
        -re "105-file-exec-and-symbols .*\r\n105\\\^done\r\n$mi_gdb_prompt$" {
310
            # We are just giving the prompt back for now
311
            # All OK
312
            }
313
        timeout {
314
            perror "couldn't load $arg into $GDB (timed out)."
315
            return -1
316
        }
317
        eof {
318
            # This is an attempt to detect a core dump, but seems not to
319
            # work.  Perhaps we need to match .* followed by eof, in which
320
            # gdb_expect does not seem to have a way to do that.
321
            perror "couldn't load $arg into $GDB (end of file)."
322
            return -1
323
        }
324
    }
325
 
326
    # ``load''
327
    if { [info procs send_target_sid] != "" } {
328
        # For SID, things get complex
329
        send_target_sid
330
        gdb_expect 60 {
331
            -re "\\^done,.*$mi_gdb_prompt$" {
332
            }
333
            timeout {
334
                perror "Unable to connect to SID target"
335
                return -1
336
            }
337
        }
338
        send_gdb "48-target-download\n"
339
        gdb_expect 10 {
340
            -re "48\\^done.*$mi_gdb_prompt$" {
341
            }
342
            timeout {
343
                perror "Unable to download to SID target"
344
                return -1
345
            }
346
        }
347
    } elseif { [target_info protocol] == "sim" } {
348
        # For the simulator, just connect to it directly.
349
        send_gdb "47-target-select sim\n"
350
        gdb_expect 10 {
351
            -re "47\\^connected.*$mi_gdb_prompt$" {
352
            }
353
            timeout {
354
                perror "Unable to select sim target"
355
                return -1
356
            }
357
        }
358
        send_gdb "48-target-download\n"
359
        gdb_expect 10 {
360
            -re "48\\^done.*$mi_gdb_prompt$" {
361
            }
362
            timeout {
363
                perror "Unable to download to sim target"
364
                return -1
365
            }
366
        }
367
    }
368
    return 0
369
}
370
 
371
# mi_gdb_test COMMAND PATTERN MESSAGE -- send a command to gdb; test the result.
372
#
373
# COMMAND is the command to execute, send to GDB with send_gdb.  If
374
#   this is the null string no command is sent.
375
# PATTERN is the pattern to match for a PASS, and must NOT include
376
#   the \r\n sequence immediately before the gdb prompt.
377
# MESSAGE is an optional message to be printed.  If this is
378
#   omitted, then the pass/fail messages use the command string as the
379
#   message.  (If this is the empty string, then sometimes we don't
380
#   call pass or fail at all; I don't understand this at all.)
381
#
382
# Returns:
383
#    1 if the test failed,
384
#    0 if the test passes,
385
#   -1 if there was an internal error.
386
#
387
proc mi_gdb_test { args } {
388
    global verbose
389
    global mi_gdb_prompt
390
    global GDB
391
    upvar timeout timeout
392
 
393
    if [llength $args]>2 then {
394
        set message [lindex $args 2]
395
    } else {
396
        set message [lindex $args 0]
397
    }
398
    set command [lindex $args 0]
399
    set pattern [lindex $args 1]
400
 
401
    if [llength $args]==5 {
402
        set question_string [lindex $args 3];
403
        set response_string [lindex $args 4];
404
    } else {
405
        set question_string "^FOOBAR$"
406
    }
407
 
408
    if $verbose>2 then {
409
        send_user "Sending \"$command\" to gdb\n"
410
        send_user "Looking to match \"$pattern\"\n"
411
        send_user "Message is \"$message\"\n"
412
    }
413
 
414
    set result -1
415
    set string "${command}\n";
416
    if { $command != "" } {
417
        while { "$string" != "" } {
418
            set foo [string first "\n" "$string"];
419
            set len [string length "$string"];
420
            if { $foo < [expr $len - 1] } {
421
                set str [string range "$string" 0 $foo];
422
                if { [send_gdb "$str"] != "" } {
423
                    global suppress_flag;
424
 
425
                    if { ! $suppress_flag } {
426
                        perror "Couldn't send $command to GDB.";
427
                    }
428
                    fail "$message";
429
                    return $result;
430
                }
431
                gdb_expect 2 {
432
                    -re "\[\r\n\]" { }
433
                    timeout { }
434
                }
435
                set string [string range "$string" [expr $foo + 1] end];
436
            } else {
437
                break;
438
            }
439
        }
440
        if { "$string" != "" } {
441
            if { [send_gdb "$string"] != "" } {
442
                global suppress_flag;
443
 
444
                if { ! $suppress_flag } {
445
                    perror "Couldn't send $command to GDB.";
446
                }
447
                fail "$message";
448
                return $result;
449
            }
450
        }
451
    }
452
 
453
    if [info exists timeout] {
454
        set tmt $timeout;
455
    } else {
456
        global timeout;
457
        if [info exists timeout] {
458
            set tmt $timeout;
459
        } else {
460
            set tmt 60;
461
        }
462
    }
463
    gdb_expect $tmt {
464
         -re "\\*\\*\\* DOSEXIT code.*" {
465
             if { $message != "" } {
466
                 fail "$message";
467
             }
468
             gdb_suppress_entire_file "GDB died";
469
             return -1;
470
         }
471
         -re "Ending remote debugging.*$mi_gdb_prompt\[ \]*$" {
472
            if ![isnative] then {
473
                warning "Can`t communicate to remote target."
474
            }
475
            gdb_exit
476
            gdb_start
477
            set result -1
478
        }
479
         -re "(${question_string})$" {
480
            send_gdb "$response_string\n";
481
            exp_continue;
482
        }
483
         -re "Undefined.* command:.*$mi_gdb_prompt\[ \]*$" {
484
            perror "Undefined command \"$command\"."
485
            fail "$message"
486
            set result 1
487
        }
488
         -re "Ambiguous command.*$mi_gdb_prompt\[ \]*$" {
489
            perror "\"$command\" is not a unique command name."
490
            fail "$message"
491
            set result 1
492
        }
493
         -re "\[\r\n\]*($pattern)\[\r\n\]+$mi_gdb_prompt\[ \]*$" {
494
            if ![string match "" $message] then {
495
                pass "$message"
496
            }
497
            set result 0
498
        }
499
         -re "Program exited with code \[0-9\]+.*$mi_gdb_prompt\[ \]*$" {
500
            if ![string match "" $message] then {
501
                set errmsg "$message: the program exited"
502
            } else {
503
                set errmsg "$command: the program exited"
504
            }
505
            fail "$errmsg"
506
            return -1
507
        }
508
         -re "The program is not being run.*$mi_gdb_prompt\[ \]*$" {
509
            if ![string match "" $message] then {
510
                set errmsg "$message: the program is no longer running"
511
            } else {
512
                set errmsg "$command: the program is no longer running"
513
            }
514
            fail "$errmsg"
515
            return -1
516
        }
517
         -re ".*$mi_gdb_prompt\[ \]*$" {
518
            if ![string match "" $message] then {
519
                fail "$message"
520
            }
521
            set result 1
522
        }
523
         "" {
524
            send_gdb "\n"
525
            perror "Window too small."
526
            fail "$message"
527
        }
528
         -re "\\(y or n\\) " {
529
            send_gdb "n\n"
530
            perror "Got interactive prompt."
531
            fail "$message"
532
        }
533
         eof {
534
             perror "Process no longer exists"
535
             if { $message != "" } {
536
                 fail "$message"
537
             }
538
             return -1
539
        }
540
         full_buffer {
541
            perror "internal buffer is full."
542
            fail "$message"
543
        }
544
        timeout {
545
            if ![string match "" $message] then {
546
                fail "$message (timeout)"
547
            }
548
            set result 1
549
        }
550
    }
551
    return $result
552
}
553
 
554
#
555
# MI run command.  (A modified version of gdb_run_cmd)
556
#
557
 
558
# In patterns, the newline sequence ``\r\n'' is matched explicitly as
559
# ``.*$'' could swallow up output that we attempt to match elsewhere.
560
 
561
proc mi_run_cmd {args} {
562
    global suppress_flag
563
    if { $suppress_flag } {
564
        return -1
565
    }
566
    global mi_gdb_prompt
567
 
568
    if [target_info exists gdb_init_command] {
569
        send_gdb "[target_info gdb_init_command]\n";
570
        gdb_expect 30 {
571
            -re "$mi_gdb_prompt$" { }
572
            default {
573
                perror "gdb_init_command for target failed";
574
                return;
575
            }
576
        }
577
    }
578
 
579
    if [target_info exists use_gdb_stub] {
580
        if [target_info exists gdb,do_reload_on_run] {
581
            # Specifying no file, defaults to the executable
582
            # currently being debugged.
583
            if { [mi_gdb_load ""] < 0 } {
584
                return;
585
            }
586
            send_gdb "000-exec-continue\n";
587
            gdb_expect 60 {
588
                -re "Continu\[^\r\n\]*\[\r\n\]" {}
589
                default {}
590
            }
591
            return;
592
        }
593
    }
594
 
595
    send_gdb "000-exec-run $args\n"
596
    gdb_expect {
597
        -re "000\\^running\r\n${mi_gdb_prompt}" {
598
        }
599
        timeout {
600
            perror "Unable to start target"
601
            return
602
        }
603
    }
604
    # NOTE: Shortly after this there will be a ``000*stopping,...(gdb)''
605
}
606
 
607
#
608
# Just like run-to-main but works with the MI interface
609
#
610
 
611
proc mi_run_to_main { } {
612
    global suppress_flag
613
    if { $suppress_flag } {
614
        return -1
615
    }
616
 
617
    global mi_gdb_prompt
618
    global hex
619
    global decimal
620
    global srcdir
621
    global subdir
622
    global binfile
623
    global srcfile
624
 
625
    set test "mi run-to-main"
626
    mi_delete_breakpoints
627
    mi_gdb_reinitialize_dir $srcdir/$subdir
628
    mi_gdb_load ${binfile}
629
 
630
    mi_gdb_test "200-break-insert main" \
631
            "200\\^done,bkpt=\{number=\"1\",type=\"breakpoint\",disp=\"keep\",enabled=\"y\",addr=\"$hex\",func=\"main\",file=\".*\",line=\"\[0-9\]*\",times=\"0\"\}" \
632
            "breakpoint at main"
633
 
634
    mi_run_cmd
635
    gdb_expect {
636
        -re "000\\*stopped,reason=\"breakpoint-hit\",bkptno=\"1\",thread-id=\"$decimal\",frame=\{addr=\"$hex\",func=\"main\",args=\(\\\[\\\]\|\{\}\),file=\".*\",line=\"\[0-9\]*\"\}\r\n$mi_gdb_prompt$" {
637
            pass "$test"
638
            return 0
639
        }
640
        timeout {
641
            fail "$test (timeout)"
642
            return -1
643
        }
644
    }
645
}
646
 
647
 
648
# Next to the next statement
649
 
650
proc mi_next { test } {
651
    global suppress_flag
652
    if { $suppress_flag } {
653
        return -1
654
    }
655
    global mi_gdb_prompt
656
    send_gdb "220-exec-next\n"
657
    gdb_expect {
658
        -re "220\\^running\r\n${mi_gdb_prompt}220\\*stopped,reason=\"end-stepping-range\",thread-id=\"$decimal\",frame=\{addr=\"$hex\",func=\".*\",args=\[\\\[\{].*[\\\]\}\],,file=\".*\",line=\"\[0-9\]*\"\}\r\n$mi_gdb_prompt$" {
659
            pass "$test"
660
            return 0
661
        }
662
        timeout {
663
            fail "$test"
664
            return -1
665
        }
666
    }
667
}
668
 
669
 
670
# Step to the next statement
671
 
672
proc mi_step { test } {
673
    global suppress_flag
674
    if { $suppress_flag } {
675
        return -1
676
    }
677
    global mi_gdb_prompt
678
    send_gdb "220-exec-step\n"
679
    gdb_expect {
680
        -re "220\\^running\r\n${mi_gdb_prompt}220\\*stopped,reason=\"end-stepping-range\",thread-id=\"$decimal\",frame=\{addr=\"$hex\",func=\".*\",args=\[\\\[\{\].*\[\\\]\}\],,file=\".*\",line=\"\[0-9\]*\"\}\r\n$mi_gdb_prompt$" {
681
            pass "$test"
682
            return 0
683
        }
684
        timeout {
685
            fail "$test"
686
            return -1
687
        }
688
    }
689
}

powered by: WebSVN 2.1.0

© copyright 1999-2024 OpenCores.org, equivalent to Oliscience, all rights reserved. OpenCores®, registered trademark.