+2002-04-26 Martin M. Hunt <hunt@redhat.com>
+
+ * defs (gdbtk_test_done): Call gdbtk_force_quit.
+
+2002-04-26 Martin M. Hunt <hunt@redhat.com>
+
+ * srcwin.test (click): Take a button number as an arg.
+ Generate a ButtonPress event then a ButtonRelease event
+ for that button number.
+ (4.4): Fix args for click().
+ (5.1): Fix results again.
+
2002-03-07 Martin M. Hunt <hunt@redhat.com>
* srcwin.test (5.1): Adjust line numbers to
proc gdbtk_test_done {} {
global _test env
-
+
if {$_test(logfile) != ""} {
close $_test(logfile)
}
set env(GDBTK_TEST_RUNNING) 0
if {![info exists _test(interactive)] || !$_test(interactive)} {
- gdb_force_quit
+ gdbtk_force_quit
}
}
return 1
}
-proc click {win bbox event} {
+proc click {win bbox bnum} {
if {![move_mouse_to $win $bbox]} {
return 0
}
set x [expr [lindex $bbox 0] + [lindex $bbox 2] / 2]
set y [expr [lindex $bbox 1] + [lindex $bbox 3] / 2]
- if {[catch {event generate $win $event -x $x -y $y} result]} {
+ if {[catch {event generate $win <Button-$bnum> -x $x -y $y} result]} {
+ return 0
+ }
+ if {[catch {event generate $win <ButtonRelease-$bnum> -x $x -y $y} result]} {
return 0
}
return 1
set r 0
# click mouse button 1 at index 20.1
- if {![click $twin [$twin bbox 20.1] <Button-1>]} {
+ if {![click $twin [$twin bbox 20.1] 1]} {
set r "Click failed on line 20.1"
} else {
move_mouse_to $twin [$twin bbox 20.$index]
sleep 1
if {[winfo ismapped $balloon]} {
- if {![string compare "x=5" [$balloon.label cget -text]]} {incr r}
- gdb_immediate "continue" 1
if {![string compare "x=9" [$balloon.label cget -text]]} {incr r}
+ gdb_immediate "continue" 1
+ sleep 1
+ if {![string compare "x=13" [$balloon.label cget -text]]} {incr r}
} else {
set r -1
}