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.

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
+    }
+}