[python] add MI tests

[Tom Tromey <tromey at redhat dot com>]

I'm going to start sending python patches here, so that Paul (and
presumably Thiago :) can see them.  If this gets too noisy, we can
make another list.


This patch adds some initial tests for the MI pretty-printing.

Tom

b/gdb/testsuite/ChangeLog:
2008-10-22  Tom Tromey  <tromey@redhat.com>

	* gdb.python/python-prettyprint.py: Add MI pretty printer.
	* gdb.python/python-mi.exp: New file.
	* lib/mi-support.exp (mi_child_regexp): New proc.
	(mi_list_varobj_children): Use it.
	(mi_varobj_update_dynamic): New proc.
	(mi_get_features): New proc.

diff --git a/gdb/testsuite/gdb.python/python-mi.exp b/gdb/testsuite/gdb.python/python-mi.exp
new file mode 100644
index 0000000..a8730f4
--- /dev/null
+++ b/gdb/testsuite/gdb.python/python-mi.exp
@@ -0,0 +1,67 @@
+# Copyright (C) 2008 Free Software Foundation, Inc.
+
+# This program is free software; you can redistribute it and/or modify
+# it under the terms of the GNU General Public License as published by
+# the Free Software Foundation; either version 3 of the License, or
+# (at your option) any later version.
+#
+# This program is distributed in the hope that it will be useful,
+# but WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+# GNU General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License
+# along with this program.  If not, see <http://www.gnu.org/licenses/>.
+
+# This file is part of the GDB testsuite.  It tests Python-based
+# pretty-printing for MI.
+
+load_lib mi-support.exp
+set MIFLAGS "-i=mi2"
+
+gdb_exit
+if [mi_gdb_start] {
+    continue
+}
+
+set testfile "python-prettyprint"
+set srcfile ${testfile}.c
+set binfile ${objdir}/${subdir}/${testfile}
+if  { [gdb_compile "${srcdir}/${subdir}/${srcfile}" "${binfile}" executable {debug}] != "" } {
+    untested mi2-var-child.exp
+    return -1
+}
+
+mi_delete_breakpoints
+mi_gdb_reinitialize_dir $srcdir/$subdir
+mi_gdb_load ${binfile}
+
+if {[lsearch -exact [mi_get_features] python] < 0} {
+    unsupported "python support is disabled"
+    return -1
+}
+
+mi_runto main
+
+mi_gdb_test "python execfile ('${srcdir}/${subdir}/${testfile}.py')" ""
+
+mi_continue_to_line [gdb_get_line_number {MI breakpoint here} ${testfile}.c] \
+  "step to breakpoint"
+
+mi_create_varobj container c "create container varobj"
+
+mi_list_varobj_children container {
+} "examine container children=0"
+
+mi_next "next over update 1"
+
+mi_varobj_update_dynamic container {
+    { {container.\[0\]} {\[0\]} 0 int }
+} "varobj update 1"
+
+mi_next "next over update 2"
+
+mi_varobj_update_dynamic container {
+    { {container.\[0\]} {\[0\]} 0 int }
+    { {container.\[1\]} {\[1\]} 0 int }
+} "varobj update 2"
diff --git a/gdb/testsuite/gdb.python/python-prettyprint.c b/gdb/testsuite/gdb.python/python-prettyprint.c
index 9daceb2..8e7473a 100644
--- a/gdb/testsuite/gdb.python/python-prettyprint.c
+++ b/gdb/testsuite/gdb.python/python-prettyprint.c
@@ -138,7 +138,7 @@ main ()
   SSS sss(15, cps);
 #endif
 
-  add_item (&c, 23);
+  add_item (&c, 23);		/* MI breakpoint here */
   add_item (&c, 72);
 
   return 0;      /* break to inspect struct and union */
diff --git a/gdb/testsuite/gdb.python/python-prettyprint.py b/gdb/testsuite/gdb.python/python-prettyprint.py
index cee4683..2c30ef3 100644
--- a/gdb/testsuite/gdb.python/python-prettyprint.py
+++ b/gdb/testsuite/gdb.python/python-prettyprint.py
@@ -75,3 +75,6 @@ gdb.cli_pretty_printers['^struct string_repr$'] = string_print
 gdb.cli_pretty_printers['^struct container$'] = ContainerPrinter()
 gdb.cli_pretty_printers['^string_repr$'] = string_print
 gdb.cli_pretty_printers['^container$'] = ContainerPrinter()
+
+
+gdb.mi_pretty_printers['^struct container$'] = ContainerPrinter
diff --git a/gdb/testsuite/lib/mi-support.exp b/gdb/testsuite/lib/mi-support.exp
index 71c0f59..716db9e 100644
--- a/gdb/testsuite/lib/mi-support.exp
+++ b/gdb/testsuite/lib/mi-support.exp
@@ -1231,6 +1231,21 @@ proc mi_varobj_update_with_type_change { name new_type new_children testname } {
     mi_gdb_test "-var-update $name" $er $testname
 }
 
+# Update a dynamic varobj named NAME.  CHILDREN is a list of children,
+# in the same form as mi_list_varobj_children.  TESTNAME is the name
+# of the test.
+proc mi_varobj_update_dynamic {name children testname} {
+    set children_exp_j [mi_child_regexp $children 0]
+
+    set er "\\^done,changelist=\\\["
+
+    append er "{name=\"$name\",in_scope=\"true\",type_changed=\"false\""
+    append er ",children=\\\[$children_exp_j.*\\\]}\\\]"
+
+    verbose -log "Expecting: $er"
+    mi_gdb_test "-var-update $name" $er $testname
+}
+
 proc mi_check_varobj_value { name value testname } {
 
     mi_gdb_test "-var-evaluate-expression $name" \
@@ -1238,6 +1253,42 @@ proc mi_check_varobj_value { name value testname } {
 	$testname
 }
 
+# Helper proc which constructs a child regexp for
+# mi_list_varobj_children and mi_varobj_update_dynamic.
+proc mi_child_regexp {children add_child} {
+    set children_exp {}
+    set whatever "\"\[^\"\]+\""
+
+    if {$add_child} {
+	set pre "child="
+    } else {
+	set pre ""
+    }
+
+    foreach item $children {
+
+        set name [lindex $item 0]
+        set exp [lindex $item  1]
+        set numchild [lindex $item 2]
+        if {[llength $item] == 5} {
+            set type [lindex $item 3]
+            set value [lindex $item 4]
+
+            lappend children_exp\
+                "$pre{name=\"$name\",exp=\"$exp\",numchild=\"$numchild\",value=\"$value\",type=\"$type\"\(,thread-id=\"\[0-9\]+\")?}"
+        } elseif {[llength $item] == 4} {
+            set type [lindex $item 3]
+
+            lappend children_exp\
+                "$pre{name=\"$name\",exp=\"$exp\",numchild=\"$numchild\",type=\"$type\"\(,thread-id=\"\[0-9\]+\")?}"
+        } else {
+            lappend children_exp\
+                "$pre{name=\"$name\",exp=\"$exp\",numchild=\"$numchild\"(,thread-id=\"\[0-9\]+\")?}"
+        }
+    }
+    return [join $children_exp ","]
+}
+
 # Check the results of the:
 #
 #   -var-list-children VARNAME
@@ -1267,31 +1318,9 @@ proc mi_list_varobj_children { varname children testname } {
     }
 
     set numchildren [llength $children]
-    set children_exp {}
     set whatever "\"\[^\"\]+\""
 
-    foreach item $children {
-
-        set name [lindex $item 0]
-        set exp [lindex $item  1]
-        set numchild [lindex $item 2]
-        if {[llength $item] == 5} {
-            set type [lindex $item 3]
-            set value [lindex $item 4]
-
-            lappend children_exp\
-                "child={name=\"$name\",exp=\"$exp\",numchild=\"$numchild\",value=\"$value\",type=\"$type\"\(,thread-id=\"\[0-9\]+\")?}"
-        } elseif {[llength $item] == 4} {
-            set type [lindex $item 3]
-
-            lappend children_exp\
-                "child={name=\"$name\",exp=\"$exp\",numchild=\"$numchild\",type=\"$type\"\(,thread-id=\"\[0-9\]+\")?}"
-        } else {
-            lappend children_exp\
-                "child={name=\"$name\",exp=\"$exp\",numchild=\"$numchild\"(,thread-id=\"\[0-9\]+\")?}"
-        }
-    }
-    set children_exp_j [join $children_exp ","]
+    set children_exp_j [mi_child_regexp $children 1]
     if {$numchildren} {
         set expected "\\^done,numchild=\".*\",children=\\\[$children_exp_j.*\\\]"
     } {
@@ -1762,3 +1791,25 @@ proc mi_check_thread_states { xstates test } {
     verbose -log "expecting: $pattern"
     mi_gdb_test "-thread-info" $pattern $test
 }
+
+# Return a list of MI features supported by this gdb.
+proc mi_get_features {} {
+    global expect_out mi_gdb_prompt
+
+    send_gdb "-list-features\n"
+
+    gdb_expect {
+	-re "\\^done,features=\\\[(.*)\\\]\r\n$mi_gdb_prompt$" {
+	    regsub -all -- \" $expect_out(1,string) "" features
+	    return [split $features ,]
+	}
+	-re ".*\r\n$mi_gdb_prompt$" {
+	    verbose -log "got $expect_out(buffer)"
+	    return ""
+	}
+	timeout {
+	    verbose -log "timeout in mi_gdb_prompt"
+	    return ""
+	}
+    }
+}