fixed bad "fd" reference in send.test and unixSend.test--now refers to

::tcltest::fd (bugID 1523).

renamed "visual" test file to "visual_bb.test" and made it use the "test"
command with the userInteractive constraint.

3 files changed, 119 insertions, 10 deletions

diff --git a/tests/send.test b/tests/send.test
index 11f50c9..cb66069 100644
--- a/tests/send.test
+++ b/tests/send.test
@@ -7,7 +7,7 @@
 # Copyright (c) 1998-1999 by Scriptics Corporation.
 # All rights reserved.
 #
-# RCS: @(#) $Id: send.test,v 1.1.4.7 1999/03/26 00:08:05 hershey Exp $
+# RCS: @(#) $Id: send.test,v 1.1.4.8 1999/04/05 18:36:04 hershey Exp $
 
 if {[lsearch [namespace children] ::tcltest] == -1} {
     source [file join [pwd] [file dirname [info script]] defs.tcl]
@@ -552,7 +552,7 @@ r
 	setupbg
 	dobg {tk appname t_s_3}
 	set x [list [catch {send t_s_3 exit} msg] $msg]
-	close $fd
+	close $::tcltest::fd
 	set x
     } {1 {target application died}}
 
@@ -583,15 +583,15 @@ test send-12.2 {TimeoutProc procedure} {
     tk appname tktest
     update
     setupbg
-    puts $fd {after 10 {after 5000; exit}; puts [tk appname]; puts **DONE**; flush stdout}
+    puts $::tcltest::fd {after 10 {after 5000; exit}; puts [tk appname]; puts **DONE**; flush stdout}
     set ::tcltest::bgDone 0
     set ::tcltest::bgData {}
-    flush $fd
+    flush $::tcltest::fd
     tkwait variable ::tcltest::bgDone
     set app $::tcltest::bgData
     after 200
     set result [list [catch {send $app foo} msg] $msg]
-    close $fd
+    close $::tcltest::fd
     set result
 } {1 {target application died}}
 
diff --git a/tests/unixSend.test b/tests/unixSend.test
index f5f7ef0..a8cc1b8 100644
--- a/tests/unixSend.test
+++ b/tests/unixSend.test
@@ -7,7 +7,7 @@
 # Copyright (c) 1998-1999 by Scriptics Corporation.
 # All rights reserved.
 #
-# RCS: @(#) $Id: unixSend.test,v 1.1.2.6 1999/03/26 00:08:09 hershey Exp $
+# RCS: @(#) $Id: unixSend.test,v 1.1.2.7 1999/04/05 18:36:05 hershey Exp $
 
 if {[lsearch [namespace children] ::tcltest] == -1} {
     source [file join [pwd] [file dirname [info script]] defs.tcl]
@@ -552,7 +552,7 @@ r
 	setupbg
 	dobg {tk appname t_s_3}
 	set x [list [catch {send t_s_3 exit} msg] $msg]
-	close $fd
+	close $::tcltest::fd
 	set x
     } {1 {target application died}}
 
@@ -583,15 +583,15 @@ test unixSend-12.2 {TimeoutProc procedure} {
     tk appname tktest
     update
     setupbg
-    puts $fd {after 10 {after 5000; exit}; puts [tk appname]; puts **DONE**; flush stdout}
+    puts $::tcltest::fd {after 10 {after 5000; exit}; puts [tk appname]; puts **DONE**; flush stdout}
     set ::tcltest::bgDone 0
     set ::tcltest::bgData {}
-    flush $fd
+    flush $::tcltest::fd
     tkwait variable ::tcltest::bgDone
     set app $::tcltest::bgData
     after 200
     set result [list [catch {send $app foo} msg] $msg]
-    close $fd
+    close $::tcltest::fd
     set result
 } {1 {target application died}}
 
diff --git a/tests/visual_bb.test b/tests/visual_bb.test
new file mode 100644
index 0000000..d1640b4
--- /dev/null
+++ b/tests/visual_bb.test
@@ -0,0 +1,109 @@
+#!/usr/local/bin/wish -f
+#
+# This script displays provides visual tests for many of Tk's features.
+# Each test displays a window with various information in it, along
+# with instructions about how the window should appear.  You can look
+# at the window to make sure it appears as expected.  Individual tests
+# are kept in separate ".tcl" files in this directory.
+#
+# RCS: @(#) $Id: visual_bb.test,v 1.1.2.1 1999/04/05 18:36:06 hershey Exp $
+
+if {[lsearch [namespace children] ::tcltest] == -1} {
+    source [file join [pwd] [file dirname [info script]] defs.tcl]
+}
+
+set auto_path ". $auto_path"
+wm title . "Visual Tests for Tk"
+
+set testNum 1
+
+# Each menu entry invokes a visual test file
+
+proc runTest {file} {
+    global testNum
+
+    test "2.$testNum" "testing $file" {userInteraction} {
+	uplevel \#0 source [file join $::tcltest::testsDir $file]
+	concat ""
+    } {}
+    incr testNum
+}
+
+# The following procedure is invoked to print the contents of a canvas:
+
+proc lpr c {
+    exec rm -f tmp.ps
+    $c postscript -file tmp.ps
+    exec lpr tmp.ps
+    exec rm -f tmp.ps
+}
+
+test 1.1 "running visual tests" {userInteraction} {
+
+    #-------------------------------------------------------
+    # The code below create the main window, consisting of a
+    # menu bar and a message explaining the basic operation
+    # of the program.
+    #-------------------------------------------------------
+
+    frame .menu -relief raised -borderwidth 1
+    message .msg -font {Times 18} -relief raised -width 4i \
+	    -borderwidth 1 -text "This application provides a collection of visual tests for the Tk toolkit.  Each menu entry invokes a test, which displays information on the screen.  You can then verify visually that the information is being displayed in the correct way.  The tests under the \"Postscript\" menu exercise the Postscript-generation capabilities of canvas widgets."
+    
+    pack .menu -side top -fill x
+    pack .msg -side bottom -expand yes -fill both
+
+    #-------------------------------------------------------
+    # The code below creates all the menus, which invoke procedures
+    # to create particular demonstrations of various widgets.
+    #-------------------------------------------------------
+
+    menubutton .menu.file -text "File" -menu .menu.file.m
+    menu .menu.file.m
+    .menu.file.m add command -label "Quit" -command ::tcltest::cleanupTests
+    
+    menubutton .menu.group1 -text "Group 1" -menu .menu.group1.m
+    menu .menu.group1.m
+    .menu.group1.m add command -label "Canvas arcs" -command {runTest arc.tcl}
+    .menu.group1.m add command -label "Beveled borders in text widgets" \
+	    -command {runTest bevel.tcl}
+    .menu.group1.m add command -label "Colormap management" \
+	    -command {runTest cmap.tcl}
+    .menu.group1.m add command -label "Label/button geometry" \
+	    -command {runTest butGeom.tcl}
+    .menu.group1.m add command -label "Label/button colors" \
+	    -command {runTest butGeom2.tcl}
+    
+    menubutton .menu.ps -text "Canvas Postscript" -menu .menu.ps.m
+    menu .menu.ps.m
+    .menu.ps.m add command -label "Rectangles and other graphics" \
+	    -command {runTest canvPsGrph.tcl}
+    .menu.ps.m add command -label "Text" \
+	    -command {runTest canvPsText.tcl}
+    .menu.ps.m add command -label "Bitmaps" \
+	    -command {runTest canvPsBmap.tcl}
+    .menu.ps.m add command -label "Arcs" \
+	    -command {runTest canvPsArc.tcl}
+    
+    pack .menu.file .menu.group1 .menu.ps -side left -padx 1m
+    
+    # Set up for keyboard-based menu traversal
+    
+    bind . <Any-FocusIn> {
+	if {("%d" == "NotifyVirtual") && ("%m" == "NotifyNormal")} {
+	    focus .menu
+	}
+    }
+    tk_menuBar .menu .menu.file .menu.group1 .menu.ps
+
+    # Set up a class binding to allow objects to be deleted from a canvas
+    # by clicking with mouse button 1:
+
+    bind Canvas <1> {%W delete [%W find closest %x %y]}
+
+    concat ""
+} {}
+
+if {!$::tcltest::testConfig(userInteraction)} {
+    ::tcltest::cleanupTests
+}