This is the mail archive of the
gdb-patches@sourceware.org
mailing list for the GDB project.
Re: Simplified MI tests
- From: Vladimir Prus <vladimir at codesourcery dot com>
- To: Daniel Jacobowitz <drow at false dot org>
- Cc: gdb-patches at sources dot redhat dot com
- Date: Thu, 4 Jan 2007 21:13:28 +0300
- Subject: Re: Simplified MI tests
- References: <200612201417.30428.vladimir@codesourcery.com> <20070103231355.GT17935@nevyn.them.org>
On Thursday 04 January 2007 02:13, Daniel Jacobowitz wrote:
> On Wed, Dec 20, 2006 at 02:17:30PM +0300, Vladimir Prus wrote:
> > I've converted one of MI tests to use this mechanism and found that
> > the result is much more clear than it was. There are problems --
> > namely that the syntax of the special comments looks weird and that
> > Emacs does not highlight them as Tcl. But I think those I minor
> > glitches and the new way is overall better?
> >
> > OK?
>
> No one commented, and overall I think it's a good idea. I'll approve
> the patch if you'll fix one thing for me...
>
> > + if {$first==1} {
> > + # Start the program afresh.
> > + set line_now [mi_run_to_line "$mi_autotest_source:$line"\
> > + "exec-run"]
> > + set first 0
> > + } elseif {$line_now!=$line} {
> > + set line_now [mi_run_to_line "$mi_autotest_source:$line"\
> > + "exec-continue"]
> > + }
>
> Instead of using exec-run, can you arrange to use mi_runto, or at least
> mi_run_cmd? You can't "run" a remote target, e.g. gdbserver or
> foo-elf.
Revised patch, and a delta, are attached. Is it better?
- Volodya
* lib/mi-support.exp (mi_autotest_data): New variable.
(mi_autotest_source): New variable.
(count_newlines, mi_prepare_inline_tests)
(mi_get_inline_test, mi_run_to_line)
(mi_run_inline_test, mi_tbreak)
(mi_send_resuming_command, mi_wait_for_stop): New functions.
* gdb.mi/mi-var-cp.exp: Move most content to the C file.
Run inline tests.
* gdb.mi/mi-var-cp.cc: Define tests here.
--- gdb/testsuite/lib/mi-support.exp (revision 3040)
+++ gdb/testsuite/lib/mi-support.exp (local)
@@ -822,7 +822,7 @@ proc mi_run_cmd {args} {
return
}
}
- # NOTE: Shortly after this there will be a ``000*stopping,...(gdb)''
+ # NOTE: Shortly after this there will be a ``000*stopped,...(gdb)''
}
#
@@ -1188,32 +1188,65 @@ proc mi_get_inline_test {testcase} {
return $result
}
-# Helper to mi_run_inline_test below.
-# Sets a temporary breakpoint at LOCATION and runs
-# the program using COMMAND. When the program is stopped
-# returns the line at which it. Returns -1 if line cannot
-# be determined.
-# Does not check that the line is the same as requested.
-# The caller can check itself if required.
-proc mi_run_to_line {location command} {
+# Sets temporary breakpoint at LOCATION.
+proc mi_tbreak {location} {
global mi_gdb_prompt
mi_gdb_test "-break-insert -t $location" \
{\^done,bkpt=.*} \
- "run to $location (set breakpoint)"
-
+ "run to $location (set breakpoint)"
+}
+
+# Send COMMAND that must be a command that resumes
+# the inferiour (run/continue/next/etc) and consumes
+# the "^running" output from it.
+proc mi_send_resuming_command {command test} {
+
+ global mi_gdb_prompt
+
send_gdb "220-$command\n"
gdb_expect {
- -re "220\\^running\r\n${mi_gdb_prompt}.*line=\"(.*)\".*\r\n$mi_gdb_prompt$" {
- return $expect_out(1,string)
+ -re "220\\^running\r\n${mi_gdb_prompt}" {
}
timeout {
- return -1
+ fail $test
}
}
}
+# Helper to mi_run_inline_test below.
+# Sets a temporary breakpoint at LOCATION and runs
+# the program using COMMAND. When the program is stopped
+# returns the line at which it. Returns -1 if line cannot
+# be determined.
+# Does not check that the line is the same as requested.
+# The caller can check itself if required.
+proc mi_run_to_line {location command} {
+
+ mi_tbreak $location
+ mi_send_resuming_command $command "run to $location ($command)"
+ return [mi_wait_for_stop]
+}
+
+# Wait until gdb prints the current line.
+proc mi_wait_for_stop {test} {
+
+ global mi_gdb_prompt
+
+ gdb_expect {
+ -re ".*line=\"(.*)\".*\r\n$mi_gdb_prompt$" {
+ return $expect_out(1,string)
+ }
+ -re ".*$mi_gdb_prompt$" {
+ fail "wait for stop ($test)"
+ }
+ timeout {
+ fail "wait for stop ($test)"
+ }
+ }
+}
+
# Run a MI test embedded in comments in a C file.
# The C file should contain special comments in the following
# three forms:
@@ -1272,8 +1305,9 @@ proc mi_run_inline_test { testcase } {
if {$first==1} {
# Start the program afresh.
- set line_now [mi_run_to_line "$mi_autotest_source:$line"\
- "exec-run"]
+ mi_tbreak "$mi_autotest_source:$line"
+ mi_run_cmd
+ set line_now [mi_wait_for_stop "$testcase: step to $line"]
set first 0
} elseif {$line_now!=$line} {
set line_now [mi_run_to_line "$mi_autotest_source:$line"\
@@ -1281,7 +1315,7 @@ proc mi_run_inline_test { testcase } {
}
if {$line_now!=$line} {
- fail "$testcase: step to line $line"
+ fail "$testcase: go to line $line"
}
# We're not at the statement right above the comment.
@@ -1289,16 +1323,9 @@ proc mi_run_inline_test { testcase } {
# the state after the statement is executed.
# Single-step past the line.
- send_gdb "220-exec-next\n"
- gdb_expect {
- -re "220\\^running\r\n${mi_gdb_prompt}.*line=\"(.*)\".*\r\n$mi_gdb_prompt$" {
- set line_now $expect_out(1,string)
- pass "$testcase: step over line $line"
- }
- timeout {
- fail "$testcase: step over line $line"
- }
- }
+ mi_send_resuming_command "exec-next" "$testcase: step over $line"
+ set line_now [mi_wait_for_stop "$testcase: step over $line"]
+
# We probably want to use 'uplevel' so that statements
# have direct access to global variables that the
# main 'exp' file has set up. But it's not yet clear,
--- gdb/testsuite/gdb.mi/mi-var-cp.exp (/patches/gdb/mi_continue_to/gdb_mainline) (revision 3041)
+++ gdb/testsuite/gdb.mi/mi-var-cp.exp (/patches/gdb/mi_inline_tests/gdb_mainline) (revision 3041)
@@ -39,53 +39,10 @@ if {[gdb_compile $srcdir/$subdir/$srcfil
mi_gdb_load ${binfile}
-# Test that children of classes are properly reported
-
-mi_runto reference_update_tests
-
-mi_create_varobj "RX" "rx" "create varobj for rx"
-
-set x_assignment [gdb_get_line_number "x = 567;"]
-mi_next_to "reference_update_tests" {} ".*${srcfile}" [expr $x_assignment-1] \
- "step to x assignment"
-mi_next_to "reference_update_tests" {} ".*${srcfile}" [expr $x_assignment] \
- "step to x assignment"
-
-mi_varobj_update RX {RX} "update RX (1)"
-
-mi_check_varobj_value RX 167 "check RX: expect 167"
-
-# Execute the first 'x = 567' line.
-mi_next_to "reference_update_tests" {} ".*${srcfile}" [expr $x_assignment+1] \
- "step to x assignment"
-
-mi_varobj_update RX {RX} "update RX (2)"
-mi_check_varobj_value RX 567 "check RX: expect 567"
-
-# Execute the second 'x = 567' line.
-mi_next_to "reference_update_tests" {} ".*${srcfile}" [expr $x_assignment+2] \
- "step to x assignment"
-
-mi_varobj_update RX {} "update RX (3)"
-
-mi_runto base_in_reference_test
-
-mi_create_varobj "S2" "s2" "create varobj for s2"
-
-mi_list_varobj_children "S2" {{"S2.S" "S" "1" "S"}} "list children of s2"
-
-mi_list_varobj_children "S2.S" {{"S2.S.public" "public" "2"}} \
- "list children of s2.s"
-
-mi_list_varobj_children "S2.S.public"\
-{
- {"S2.S.public.i" "i" "0" "int"}
- {"S2.S.public.j" "j" "0" "int"}
-} "list children of s2.s.public"
-
-mi_check_varobj_value "S2.S.public.i" "67" "check S2.S.public.i"
-mi_check_varobj_value "S2.S.public.j" "89" "check S2.S.public.j"
+mi_prepare_inline_tests $srcfile
+mi_run_inline_test reference_update
+mi_run_inline_test base_in_reference
mi_gdb_exit
return 0
--- gdb/testsuite/gdb.mi/mi-var-cp.cc (/patches/gdb/mi_continue_to/gdb_mainline) (revision 3041)
+++ gdb/testsuite/gdb.mi/mi-var-cp.cc (/patches/gdb/mi_inline_tests/gdb_mainline) (revision 3041)
@@ -17,10 +17,22 @@
void reference_update_tests ()
{
+ /*: BEGIN: reference_update :*/
int x = 167;
+ /*: mi_create_varobj "RX" "rx" "create varobj for rx" :*/
int& rx = x;
+ /*: mi_varobj_update RX {RX} "update RX (1)"
+ mi_check_varobj_value RX 167 "check RX: expect 167"
+ :*/
x = 567;
+ /*: mi_varobj_update RX {RX} "update RX (2)"
+ mi_check_varobj_value RX 567 "check RX: expect 567"
+ :*/
x = 567;
+ /*: mi_varobj_update RX {} "update RX (3)"
+ :*/
+
+ /*: END: reference_update :*/
}
struct S { int i; int j; };
@@ -28,7 +40,26 @@ struct S2 : S {};
int base_in_reference_test (S2& s2)
{
+ /*: BEGIN: base_in_reference :*/
return s2.i;
+ /*:
+ mi_create_varobj "S2" "s2" "create varobj for s2"
+ mi_list_varobj_children "S2" {
+ {"S2.S" "S" "1" "S"}
+ } "list children of s2"
+ mi_list_varobj_children "S2.S" {
+ {"S2.S.public" "public" "2"}
+ } "list children of s2.s"
+ mi_list_varobj_children "S2.S.public" {
+ {"S2.S.public.i" "i" "0" "int"}
+ {"S2.S.public.j" "j" "0" "int"}
+ } "list children of s2.s.public"
+
+ mi_check_varobj_value "S2.S.public.i" "67" "check S2.S.public.i"
+ mi_check_varobj_value "S2.S.public.j" "89" "check S2.S.public.j"
+
+ :*/
+ /*: END: base_in_reference :*/
}
void base_in_reference_test_main ()
--- gdb/testsuite/lib/mi-support.exp (/patches/gdb/mi_continue_to/gdb_mainline) (revision 3041)
+++ gdb/testsuite/lib/mi-support.exp (/patches/gdb/mi_inline_tests/gdb_mainline) (revision 3041)
@@ -822,7 +822,7 @@ proc mi_run_cmd {args} {
return
}
}
- # NOTE: Shortly after this there will be a ``000*stopping,...(gdb)''
+ # NOTE: Shortly after this there will be a ``000*stopped,...(gdb)''
}
#
@@ -1086,3 +1086,250 @@ proc mi_list_varobj_children { varname c
mi_gdb_test "-var-list-children $varname" $expected $testname
}
+
+# A list of two-element lists. First element of each list is
+# a Tcl statement, and the second element is the line
+# number of source C file where the statement originates.
+set mi_autotest_data ""
+# The name of the source file for autotesting.
+set mi_autotest_source ""
+
+proc count_newlines { string } {
+ return [regexp -all "\n" $string]
+}
+
+# Prepares for running inline tests in FILENAME.
+# See comments for mi_run_inline_test for detailed
+# explanation of the idea and syntax.
+proc mi_prepare_inline_tests { filename } {
+
+ global srcdir
+ global subdir
+ global mi_autotest_source
+ global mi_autotest_data
+
+ set mi_autotest_data {}
+
+ set mi_autotest_source $filename
+
+ if { ! [regexp "^/" "$filename"] } then {
+ set filename "$srcdir/$subdir/$filename"
+ }
+
+ set chan [open $filename]
+ set content [read $chan]
+ set line_number 1
+ while {1} {
+ set start [string first "/*:" $content]
+ if {$start != -1} {
+ set end [string first ":*/" $content]
+ if {$end == -1} {
+ error "Unterminated special comment in $filename"
+ }
+
+ set prefix [string range $content 0 $start]
+ set prefix_newlines [count_newlines $prefix]
+
+ set line_number [expr $line_number+$prefix_newlines]
+ set comment_line $line_number
+
+ set comment [string range $content [expr $start+3] [expr $end-1]]
+
+ set comment_newlines [count_newlines $comment]
+ set line_number [expr $line_number+$comment_newlines]
+
+ set comment [string trim $comment]
+ set content [string range $content [expr $end+3] \
+ [string length $content]]
+ lappend mi_autotest_data [list $comment $comment_line]
+ } else {
+ break
+ }
+ }
+ close $chan
+}
+
+# Helper to mi_run_inline_test below.
+# Return the list of all (statement,line_number) lists
+# that comprise TESTCASE. The begin and end markers
+# are not included.
+proc mi_get_inline_test {testcase} {
+
+ global mi_gdb_prompt
+ global mi_autotest_data
+ global mi_autotest_source
+
+ set result {}
+
+ set seen_begin 0
+ set seen_end 0
+ foreach l $mi_autotest_data {
+
+ set comment [lindex $l 0]
+
+ if {$comment == "BEGIN: $testcase"} {
+ set seen_begin 1
+ } elseif {$comment == "END: $testcase"} {
+ set seen_end 1
+ break
+ } elseif {$seen_begin==1} {
+ lappend result $l
+ }
+ }
+
+ if {$seen_begin == 0} {
+ error "Autotest $testcase not found"
+ }
+
+ if {$seen_begin == 1 && $seen_end == 0} {
+ error "Missing end marker for test $testcase"
+ }
+
+ return $result
+}
+
+# Sets temporary breakpoint at LOCATION.
+proc mi_tbreak {location} {
+
+ global mi_gdb_prompt
+
+ mi_gdb_test "-break-insert -t $location" \
+ {\^done,bkpt=.*} \
+ "run to $location (set breakpoint)"
+}
+
+# Send COMMAND that must be a command that resumes
+# the inferiour (run/continue/next/etc) and consumes
+# the "^running" output from it.
+proc mi_send_resuming_command {command test} {
+
+ global mi_gdb_prompt
+
+ send_gdb "220-$command\n"
+ gdb_expect {
+ -re "220\\^running\r\n${mi_gdb_prompt}" {
+ }
+ timeout {
+ fail $test
+ }
+ }
+}
+
+# Helper to mi_run_inline_test below.
+# Sets a temporary breakpoint at LOCATION and runs
+# the program using COMMAND. When the program is stopped
+# returns the line at which it. Returns -1 if line cannot
+# be determined.
+# Does not check that the line is the same as requested.
+# The caller can check itself if required.
+proc mi_run_to_line {location command} {
+
+ mi_tbreak $location
+ mi_send_resuming_command $command "run to $location ($command)"
+ return [mi_wait_for_stop]
+}
+
+# Wait until gdb prints the current line.
+proc mi_wait_for_stop {test} {
+
+ global mi_gdb_prompt
+
+ gdb_expect {
+ -re ".*line=\"(.*)\".*\r\n$mi_gdb_prompt$" {
+ return $expect_out(1,string)
+ }
+ -re ".*$mi_gdb_prompt$" {
+ fail "wait for stop ($test)"
+ }
+ timeout {
+ fail "wait for stop ($test)"
+ }
+ }
+}
+
+# Run a MI test embedded in comments in a C file.
+# The C file should contain special comments in the following
+# three forms:
+#
+# /*: BEGIN: testname :*/
+# /*: <Tcl statements> :*/
+# /*: END: testname :*/
+#
+# This procedure find the begin and end marker for the requested
+# test. Then, a temporary breakpoint is set at the begin
+# marker and the program is run (from start).
+#
+# After that, for each special comment between the begin and end
+# marker, the Tcl statements are executed. It is assumed that
+# for each comment, the immediately preceding line is executable
+# C statement. Then, gdb will be single-stepped until that
+# preceding C statement is executed, and after that the
+# Tcl statements in the comment will be executed.
+#
+# For example:
+#
+# /*: BEGIN: assignment-test :*/
+# v = 10;
+# /*: <Tcl code to check that 'v' is indeed 10 :*/
+# /*: END: assignment-test :*/
+#
+# The mi_prepare_inline_tests function should be called before
+# calling this function. A given C file can contain several
+# inline tests. The names of the tests must be unique within one
+# C file.
+#
+proc mi_run_inline_test { testcase } {
+
+ global mi_gdb_prompt
+ global hex
+ global decimal
+ global fullname_syntax
+ global mi_autotest_source
+
+ set commands [mi_get_inline_test $testcase]
+
+ set first 1
+ set line_now 1
+
+ foreach c $commands {
+ set statements [lindex $c 0]
+ set line [lindex $c 1]
+ set line [expr $line-1]
+
+ # We want gdb to be stopped at the expression immediately
+ # before the comment. If this is the first comment, the
+ # program is either not started yet or is in some random place,
+ # so we run it. For further comments, we might be already
+ # standing at the right line. If not continue till the
+ # right line.
+
+ if {$first==1} {
+ # Start the program afresh.
+ mi_tbreak "$mi_autotest_source:$line"
+ mi_run_cmd
+ set line_now [mi_wait_for_stop "$testcase: step to $line"]
+ set first 0
+ } elseif {$line_now!=$line} {
+ set line_now [mi_run_to_line "$mi_autotest_source:$line"\
+ "exec-continue"]
+ }
+
+ if {$line_now!=$line} {
+ fail "$testcase: go to line $line"
+ }
+
+ # We're not at the statement right above the comment.
+ # Execute that statement so that the comment can test
+ # the state after the statement is executed.
+
+ # Single-step past the line.
+ mi_send_resuming_command "exec-next" "$testcase: step over $line"
+ set line_now [mi_wait_for_stop "$testcase: step over $line"]
+
+ # We probably want to use 'uplevel' so that statements
+ # have direct access to global variables that the
+ # main 'exp' file has set up. But it's not yet clear,
+ # will need more experience to be sure.
+ eval $statements
+ }
+}
Property changes on: gdb/testsuite/lib
___________________________________________________________________
Name: svk:merge
+d48a11ec-ee1c-0410-b3f5-c20844f99675:/patches/gdb/frozen/gdb_mainline/gdb/testsuite/lib:2741
Property changes on:
___________________________________________________________________
Name: csl:base
+/all/patches/gdb/mi_continue_to/gdb_mainline
Name: svk:merge
+d48a11ec-ee1c-0410-b3f5-c20844f99675:/patches/gdb/mi_continue_to/gdb_mainline:2736