diff options
author | Vladimir Prus <vladimir@codesourcery.com> | 2007-01-04 20:12:15 +0000 |
---|---|---|
committer | Vladimir Prus <vladimir@codesourcery.com> | 2007-01-04 20:12:15 +0000 |
commit | 2d0720d988230d947d5eee9245a7d2fc3f0eeb0a (patch) | |
tree | 71bb59981f532d851c6f809519a8c477663ecd4d /gdb | |
parent | a028a6f5344b31f555a14d6769b61e6871317475 (diff) | |
download | binutils-2d0720d988230d947d5eee9245a7d2fc3f0eeb0a.zip binutils-2d0720d988230d947d5eee9245a7d2fc3f0eeb0a.tar.gz binutils-2d0720d988230d947d5eee9245a7d2fc3f0eeb0a.tar.bz2 |
Implement specification of MI tests as comments
in C and C++ sources.
* 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_continue_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.
Diffstat (limited to 'gdb')
-rw-r--r-- | gdb/ChangeLog | 14 | ||||
-rw-r--r-- | gdb/testsuite/gdb.mi/mi-var-cp.cc | 31 | ||||
-rw-r--r-- | gdb/testsuite/gdb.mi/mi-var-cp.exp | 49 | ||||
-rw-r--r-- | gdb/testsuite/lib/mi-support.exp | 248 |
4 files changed, 295 insertions, 47 deletions
diff --git a/gdb/ChangeLog b/gdb/ChangeLog index 96edccd..ed80928 100644 --- a/gdb/ChangeLog +++ b/gdb/ChangeLog @@ -1,3 +1,17 @@ +2007-01-04 Vladimir Prus <vladimir@codesourcery.com> + + Implement specification of MI tests as comments + in C and C++ sources. + * 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_continue_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. + 2007-01-04 Daniel Jacobowitz <dan@codesourcery.com> * configure.ac (build_warnings): Use -Wall and diff --git a/gdb/testsuite/gdb.mi/mi-var-cp.cc b/gdb/testsuite/gdb.mi/mi-var-cp.cc index 6027051..8489b55 100644 --- a/gdb/testsuite/gdb.mi/mi-var-cp.cc +++ b/gdb/testsuite/gdb.mi/mi-var-cp.cc @@ -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 () diff --git a/gdb/testsuite/gdb.mi/mi-var-cp.exp b/gdb/testsuite/gdb.mi/mi-var-cp.exp index fea145f..7582301 100644 --- a/gdb/testsuite/gdb.mi/mi-var-cp.exp +++ b/gdb/testsuite/gdb.mi/mi-var-cp.exp @@ -39,53 +39,10 @@ if {[gdb_compile $srcdir/$subdir/$srcfile $binfile executable {debug c++}] != "" 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 diff --git a/gdb/testsuite/lib/mi-support.exp b/gdb/testsuite/lib/mi-support.exp index 975c842..ad968ce 100644 --- a/gdb/testsuite/lib/mi-support.exp +++ b/gdb/testsuite/lib/mi-support.exp @@ -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,249 @@ proc mi_list_varobj_children { varname children testname } { 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_continue_to_line {location command} { + + mi_tbreak $location + mi_send_resuming_command "exec-continue" "run to $location (exec-continue)" + 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_continue_to_line "$mi_autotest_source:$line"] + } + + 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 + } +} |