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.
This commit is contained in:
Vladimir Prus
parent
a028a6f534
commit
2d0720d988
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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 ()
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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
|
||||
}
|
||||
}
|
||||
|
|
|
|||
Loading…
Reference in New Issue