This is the mail archive of the gdb-patches@sourceware.org mailing list for the GDB project.


Index Nav: [Date Index] [Subject Index] [Author Index] [Thread Index]
Message Nav: [Date Prev] [Date Next] [Thread Prev] [Thread Next]
Other format: [Raw text]

Simplified MI tests


Hello,
at the moment, writing MI tests is not very easy. Part of the problem is that
the tests consist of a C program and a Tcl program. The Tcl program has to
try certain commands while gdb is standing on a specific line of the C program,
and tracking correspondence between the lines in C and in Tcl is hard.

It's somewhat possible to keep this in mind while writing a single test, but some time
later it becomes completely incomprehensible. To understand what's going on in a test,
one has to jump back and forth between C and Tcl.

I've just implemented a mechanism to describe tests in a single file -- the C one. The
program should contain special comments containing Tcl code. Here's an example:


    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 :*/
    }

and the Tcl file only contains:

	mi_prepare_inline_tests $srcfile
	mi_run_inline_test reference_update


Each Tcl block in comment is executed immediately after the preceding C statement 
is executed, and single-stepping to right positions is handled automaitcally.
The only restriction is that each special comment should be immediately preceded by an
executable statement.

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?

- 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): 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/gdb.mi/mi-var-cp.exp	(/patches/gdb/mi_continue_to/gdb_mainline)	(revision 2760)
+++ gdb/testsuite/gdb.mi/mi-var-cp.exp	(/patches/gdb/mi_inline_tests/gdb_mainline)	(revision 2760)
@@ -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 2760)
+++ gdb/testsuite/gdb.mi/mi-var-cp.cc	(/patches/gdb/mi_inline_tests/gdb_mainline)	(revision 2760)
@@ -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 2760)
+++ gdb/testsuite/lib/mi-support.exp	(/patches/gdb/mi_inline_tests/gdb_mainline)	(revision 2760)
@@ -1086,3 +1086,223 @@ 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
+}
+
+# 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} {
+
+    global mi_gdb_prompt
+
+    mi_gdb_test "-break-insert -t $location" \
+        {\^done,bkpt=.*} \
+        "run to $location (set breakpoint)"
+   
+    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)
+        }
+        timeout {
+            return -1
+        }
+    }
+}
+
+# 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.
+            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"]
+        }
+
+        if {$line_now!=$line} {
+            fail "$testcase: step 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.
+        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"
+            }
+        }
+        # 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


Index Nav: [Date Index] [Subject Index] [Author Index] [Thread Index]
Message Nav: [Date Prev] [Date Next] [Thread Prev] [Thread Next]