From 05961d4dc9e4b65d07feac195998ca0f969b06d9 Mon Sep 17 00:00:00 2001 From: dgp Date: Sat, 13 Jul 2002 20:28:35 +0000 Subject: * Converted more files to tcltest and factored out common code. --- ChangeLog | 5 ++ tests/constraints.tcl | 70 +++++++++++++++++---------- tests/macEmbed.test | 88 ++++++++++------------------------ tests/macFont.test | 15 +++--- tests/macMenu.test | 36 +++++--------- tests/macWinMenu.test | 36 ++++---------- tests/macscrollbar.test | 21 ++++---- tests/main.test | 29 ++++++----- tests/menu.test | 46 +++++------------- tests/menuDraw.test | 39 +++++---------- tests/menubut.test | 55 +++++++++------------ tests/message.test | 11 +++-- tests/msgbox.test | 16 +++---- tests/obj.test | 19 ++++---- tests/oldpack.test | 13 +++-- tests/option.test | 22 +++++---- tests/pack.test | 11 +++-- tests/panedwindow.test | 25 ++++------ tests/place.test | 17 +++---- tests/raise.test | 23 ++++----- tests/safe.test | 13 +++-- tests/scale.test | 18 ++----- tests/scrollbar.test | 17 +++---- tests/select.test | 9 ++-- tests/send.test | 14 +----- tests/spinbox.test | 18 ++----- tests/text.test | 24 ++++------ tests/textBTree.test | 9 ++-- tests/textDisp.test | 20 +++----- tests/textImage.test | 7 +-- tests/textIndex.test | 7 +-- tests/textMark.test | 10 ++-- tests/textTag.test | 10 ++-- tests/textWind.test | 11 +---- tests/tk.test | 9 ++-- tests/unixButton.test | 37 ++++++-------- tests/unixEmbed.test | 125 +++++++++++++----------------------------------- tests/unixFont.test | 7 +-- tests/unixMenu.test | 17 +------ tests/unixSelect.test | 8 +--- tests/unixWm.test | 37 ++++++-------- tests/util.test | 15 +++--- tests/visual.test | 18 +++---- tests/visual_bb.test | 10 ++-- tests/winButton.test | 49 ++++++++----------- tests/winClipboard.test | 11 +++-- tests/winDialog.test | 15 +++--- tests/winFont.test | 10 ++-- tests/winMenu.test | 34 ++++--------- tests/winSend.test | 19 +++----- tests/winWm.test | 12 ++--- tests/window.test | 17 +++---- tests/winfo.test | 36 +++++--------- tests/wm.test | 17 +++---- tests/xmfbox.test | 9 ++-- 55 files changed, 506 insertions(+), 790 deletions(-) diff --git a/ChangeLog b/ChangeLog index c25bedc..1721d8e 100644 --- a/ChangeLog +++ b/ChangeLog @@ -1,3 +1,8 @@ +2002-07-12 Don Porter + + * tests/constraints.tcl: Converted more files to tcltest and + * tests/[m-x]*.test: factored out common code. + 2002-07-11 Don Porter * tests/canvPsImg.tcl: Converted several files in the diff --git a/tests/constraints.tcl b/tests/constraints.tcl index 065e52e..f58cf67 100644 --- a/tests/constraints.tcl +++ b/tests/constraints.tcl @@ -1,31 +1,12 @@ package require Tcl 8.4 + package require Tk 8.4 +tk appname tktest +wm title . tktest + package require tcltest 2.1 -namespace import -force tcltest::testConstraint -testConstraint userInteraction 0 -testConstraint altDisplay [info exists env(TK_ALT_DISPLAY)] -testConstraint noExceed [expr {![testConstraint unix] - || [catch {font actual "\{xyz"}]}] -testConstraint testImageType [expr {[lsearch [image types] test] >= 0}] -testConstraint fonts 1 -destroy .e -entry .e -width 0 -font {Helvetica -12} -bd 1 -.e insert end a.bcd -if {([winfo reqwidth .e] != 37) || ([winfo reqheight .e] != 20)} { - testConstraint fonts 0 -} -destroy .e -text .t -width 80 -height 20 -font {Times -14} -bd 1 -pack .t -.t insert end "This is\na dot." -update -set x [list [.t bbox 1.3] [.t bbox 2.5]] -destroy .t -if {![string match {{22 3 6 15} {31 18 [34] 15}} $x]} { - testConstraint fonts 0 -} -namespace eval ::tk { +namespace eval tk { if {[namespace exists test]} { namespace delete test } @@ -110,8 +91,47 @@ namespace eval ::tk { Export bg::setup as setupbg Export bg::cleanup as cleanupbg Export bg::do as dobg + + namespace export deleteWindows + proc deleteWindows {} { + eval destroy [winfo children .] + } } } -namespace import -force ::tk::test::* +namespace import -force tk::test::* + +namespace import -force tcltest::testConstraint +testConstraint userInteraction 0 +testConstraint nonUnixUserInteraction [expr {[testConstraint userInteraction] + || [testConstraint unix]}] +testConstraint altDisplay [info exists env(TK_ALT_DISPLAY)] +testConstraint noExceed [expr {![testConstraint unix] + || [catch {font actual "\{xyz"}]}] +testConstraint testImageType [expr {[lsearch [image types] test] >= 0}] +testConstraint fonts 1 +destroy .e +entry .e -width 0 -font {Helvetica -12} -bd 1 +.e insert end a.bcd +if {([winfo reqwidth .e] != 37) || ([winfo reqheight .e] != 20)} { + testConstraint fonts 0 +} +destroy .e +destroy .t +text .t -width 80 -height 20 -font {Times -14} -bd 1 +pack .t +.t insert end "This is\na dot." +update +set x [list [.t bbox 1.3] [.t bbox 2.5]] +destroy .t +if {![string match {{22 3 6 15} {31 18 [34] 15}} $x]} { + testConstraint fonts 0 +} + +eval tcltest::configure $argv +namespace import -force tcltest::test + +deleteWindows +wm geometry . {} +raise . diff --git a/tests/macEmbed.test b/tests/macEmbed.test index b6c2f68..bd9cdbc 100644 --- a/tests/macEmbed.test +++ b/tests/macEmbed.test @@ -6,16 +6,14 @@ # Copyright (c) 1998-1999 by Scriptics Corporation. # All rights reserved. # -# RCS: @(#) $Id: macEmbed.test,v 1.5 2001/03/28 17:27:10 dgp Exp $ - -if {[lsearch [namespace children] ::tcltest] == -1} { - source [file join [pwd] [file dirname [info script]] defs.tcl] -} - -eval destroy [winfo children .] -wm geometry . {} -raise . +# RCS: @(#) $Id: macEmbed.test,v 1.6 2002/07/13 20:28:35 dgp Exp $ +package require tcltest 2.1 +namespace import -force tcltest::configure +namespace import -force tcltest::testsDirectory +configure -testdir [file join [pwd] [file dirname [info script]]] +configure -loadfile [file join [testsDirectory] constraints.tcl] +tcltest::loadTestedCommands test macEmbed-1.1 {TkpUseWindow procedure, bad window identifier} {macOnly} { catch {destroy .t} @@ -34,7 +32,7 @@ if {[string compare testembed [info commands testembed]] != 0} { } test macEmbed-1.3 {TkpUseWindow procedure, creating Container records} {macOnly} { - eval destroy [winfo child .] + deleteWindows frame .f1 -container 1 -width 200 -height 50 frame .f2 -container 1 -width 200 -height 50 pack .f1 .f2 @@ -43,7 +41,7 @@ test macEmbed-1.3 {TkpUseWindow procedure, creating Container records} {macOnly} list [testembed] [expr [lindex [lindex [testembed all] 1] 0] - $w] } {{{XXX .f2 {} {}} {XXX .f1 XXX .t}} 0} test macEmbed-1.4 {TkpUseWindow procedure, creating Container records} {macOnly} { - eval destroy [winfo child .] + deleteWindows frame .f1 -container 1 -width 200 -height 50 frame .f2 -container 1 -width 200 -height 50 pack .f1 .f2 @@ -58,9 +56,7 @@ test macEmbed-1.4 {TkpUseWindow procedure, creating Container records} {macOnly} # TkpMakeContainer, or EmbedErrorProc. test macEmbed-2.1 {EmbeddedEventProc procedure} {macOnly} { - foreach w [winfo child .] { - catch {destroy $w} - } + deleteWindows frame .f1 -container 1 -width 200 -height 50 pack .f1 set w1 [winfo id .f1] @@ -71,9 +67,7 @@ test macEmbed-2.1 {EmbeddedEventProc procedure} {macOnly} { testembed } {} test macEmbed-2.2 {EmbeddedEventProc procedure} {macOnly} { - foreach w [winfo child .] { - catch {destroy $w} - } + deleteWindows frame .f1 -container 1 -width 200 -height 50 pack .f1 toplevel .t1 -use [winfo id .f1] @@ -82,9 +76,7 @@ test macEmbed-2.2 {EmbeddedEventProc procedure} {macOnly} { testembed } {} test macEmbed-2.3 {EmbeddedEventProc procedure} {macOnly} { - foreach w [winfo child .] { - catch {destroy $w} - } + deleteWindows frame .f1 -container 1 -width 200 -height 50 pack .f1 toplevel .t1 -use [winfo id .f1] @@ -95,9 +87,7 @@ test macEmbed-2.3 {EmbeddedEventProc procedure} {macOnly} { } {{} {}} test macEmbed-3.1 {EmbeddedEventProc procedure, detect creation} {macOnly} { - foreach w [winfo child .] { - catch {destroy $w} - } + deleteWindows frame .f1 -container 1 -width 200 -height 50 pack .f1 set w1 [winfo id .f1] @@ -108,9 +98,7 @@ test macEmbed-3.1 {EmbeddedEventProc procedure, detect creation} {macOnly} { } {{{XXX .f1 {} {}}} {{XXX .f1 XXX .t1}}} test macEmbed-3.2 {EmbeddedEventProc procedure, disallow position changes} \ {macOnly} { - foreach w [winfo child .] { - catch {destroy $w} - } + deleteWindows frame .f1 -container 1 -width 200 -height 50 pack .f1 set w1 [winfo id .f1] @@ -122,9 +110,7 @@ test macEmbed-3.2 {EmbeddedEventProc procedure, disallow position changes} \ } {200x200+0+0} test macEmbed-3.3 {EmbeddedEventProc procedure, disallow position changes} \ {macOnly} { - foreach w [winfo child .] { - catch {destroy $w} - } + deleteWindows frame .f1 -container 1 -width 200 -height 50 pack .f1 set w1 [winfo id .f1] @@ -135,9 +121,7 @@ test macEmbed-3.3 {EmbeddedEventProc procedure, disallow position changes} \ wm geometry .t1 } {300x100+0+0} test macEmbed-3.4 {EmbeddedEventProc procedure, geometry requests} {macOnly} { - foreach w [winfo child .] { - catch {destroy $w} - } + deleteWindows toplevel .t1 -container 1 -width 200 -height 50 set w1 [winfo id .t1] toplevel .t2 -use $w1 @@ -147,9 +131,7 @@ test macEmbed-3.4 {EmbeddedEventProc procedure, geometry requests} {macOnly} { list [winfo width .t1] [winfo height .t1] [wm geometry .t2] } {300 80 300x80+0+0} test macEmbed-3.5 {EmbeddedEventProc procedure, map requests} {macOnly} { - foreach w [winfo child .] { - catch {destroy $w} - } + deleteWindows frame .f1 -container 1 -width 200 -height 50 pack .f1 set w1 [winfo id .f1] @@ -162,9 +144,7 @@ test macEmbed-3.5 {EmbeddedEventProc procedure, map requests} {macOnly} { set x } {mapped} test macEmbed-3.6 {EmbeddedEventProc procedure, destroy events} {macOnly} { - foreach w [winfo child .] { - catch {destroy $w} - } + deleteWindows frame .f1 -container 1 -width 200 -height 50 pack .f1 set w1 [winfo id .f1] @@ -178,9 +158,7 @@ test macEmbed-3.6 {EmbeddedEventProc procedure, destroy events} {macOnly} { } {dead 0} test macEmbed-4.1 {EmbedStructureProc procedure, configure events} {macOnly} { - foreach w [winfo child .] { - catch {destroy $w} - } + deleteWindows frame .f1 -container 1 -width 200 -height 50 pack .f1 set w1 [winfo id .f1] @@ -191,9 +169,7 @@ test macEmbed-4.1 {EmbedStructureProc procedure, configure events} {macOnly} { winfo geometry .t1 } {180x100+0+0} test macEmbed-4.2 {EmbedStructureProc procedure, destroy events} {macOnly} { - foreach w [winfo child .] { - catch {destroy $w} - } + deleteWindows frame .f1 -container 1 -width 200 -height 50 pack .f1 set w1 [winfo id .f1] @@ -208,9 +184,7 @@ test macEmbed-4.2 {EmbedStructureProc procedure, destroy events} {macOnly} { test unixEmbed-5.1 {TkpClaimFocus procedure} {macOnly tempNotMac} { catch {interp delete child} - foreach w [winfo child .] { - catch {destroy $w} - } + deleteWindows frame .f1 -container 1 -width 200 -height 50 frame .f2 -width 200 -height 50 pack .f1 .f2 @@ -232,9 +206,7 @@ test unixEmbed-5.1 {TkpClaimFocus procedure} {macOnly tempNotMac} { catch {interp delete child} test macEmbed-6.1 {EmbedWindowDeleted procedure, check parentPtr} {macOnly} { - foreach w [winfo child .] { - catch {destroy $w} - } + deleteWindows frame .f1 -container 1 -width 200 -height 50 frame .f2 -container 1 -width 200 -height 50 frame .f3 -container 1 -width 200 -height 50 @@ -249,9 +221,7 @@ test macEmbed-6.1 {EmbedWindowDeleted procedure, check parentPtr} {macOnly} { set x } {{{XXX .f4 {} {}} {XXX .f3 {} {}} {XXX .f2 {} {}} {XXX .f1 {} {}}} {{XXX .f4 {} {}} {XXX .f2 {} {}} {XXX .f1 {} {}}} {{XXX .f2 {} {}} {XXX .f1 {} {}}} {{XXX .f2 {} {}}} {}} test macEmbed-6.2 {EmbedWindowDeleted procedure, check embeddedPtr} {macOnly} { - foreach w [winfo child .] { - catch {destroy $w} - } + deleteWindows frame .f1 -container 1 -width 200 -height 50 pack .f1 set w1 [winfo id .f1] @@ -264,9 +234,7 @@ test macEmbed-6.2 {EmbedWindowDeleted procedure, check embeddedPtr} {macOnly} { } {{{XXX .f1 XXX .t1}} {}} test macEmbed-7.1 {geometry propagation in tkUnixWm.c/UpdateGeometryInfo} {macOnly} { - foreach w [winfo child .] { - catch {destroy $w} - } + deleteWindows frame .f1 -container 1 -width 200 -height 50 pack .f1 toplevel .t1 -use [winfo id .f1] -width 150 -height 80 @@ -276,9 +244,7 @@ test macEmbed-7.1 {geometry propagation in tkUnixWm.c/UpdateGeometryInfo} {macOn wm geometry .t1 } {150x80+0+0} test macEmbed-7.2 {geometry propagation in tkUnixWm.c/UpdateGeometryInfo} {macOnly} { - foreach w [winfo child .] { - catch {destroy $w} - } + deleteWindows frame .f1 -container 1 -width 200 -height 50 pack .f1 toplevel .t1 -use [winfo id .f1] -width 150 -height 80 @@ -290,9 +256,7 @@ test macEmbed-7.2 {geometry propagation in tkUnixWm.c/UpdateGeometryInfo} {macOn -foreach w [winfo child .] { - catch {destroy $w} -} +deleteWindows # cleanup ::tcltest::cleanupTests diff --git a/tests/macFont.test b/tests/macFont.test index 972f81d..f4e3083 100644 --- a/tests/macFont.test +++ b/tests/macFont.test @@ -10,11 +10,14 @@ # Copyright (c) 1998-1999 by Scriptics Corporation. # All rights reserved. # -# RCS: @(#) $Id: macFont.test,v 1.4 2001/09/21 20:38:18 hobbs Exp $ +# RCS: @(#) $Id: macFont.test,v 1.5 2002/07/13 20:28:35 dgp Exp $ -if {[lsearch [namespace children] ::tcltest] == -1} { - source [file join [pwd] [file dirname [info script]] defs.tcl] -} +package require tcltest 2.1 +namespace import -force tcltest::configure +namespace import -force tcltest::testsDirectory +configure -testdir [file join [pwd] [file dirname [info script]]] +configure -loadfile [file join [testsDirectory] constraints.tcl] +tcltest::loadTestedCommands catch {destroy .b} toplevel .b @@ -39,11 +42,11 @@ proc getsize {} { return "[winfo reqwidth .b.l] [winfo reqheight .b.l]" } -set ::tcltest::testConfig(gothic) 0 +testConstraint gothic 0 set gothic {gothic 12} set mx [font measure $gothic \u4e4e] if {[font actual $gothic -family] != [font actual system -family]} { - set ::tcltest::testConfig(gothic) 1 + testConstraint gothic 1 } test macFont-1.1 {TkpFontPkgInit} {macOnly} { diff --git a/tests/macMenu.test b/tests/macMenu.test index f1ee519..2a36c60 100644 --- a/tests/macMenu.test +++ b/tests/macMenu.test @@ -7,24 +7,14 @@ # Copyright (c) 1998-1999 by Scriptics Corporation. # All rights reserved. # -# RCS: @(#) $Id: macMenu.test,v 1.6 2001/09/21 20:38:18 hobbs Exp $ +# RCS: @(#) $Id: macMenu.test,v 1.7 2002/07/13 20:28:35 dgp Exp $ -if {[lsearch [namespace children] ::tcltest] == -1} { - source [file join [pwd] [file dirname [info script]] defs.tcl] -} - -set ::tcltest::testConfig(testimage) \ - [expr {[lsearch [image types] test] >= 0}] - -proc deleteWindows {} { - foreach i [winfo children .] { - catch [destroy $i] - } -} - -deleteWindows -wm geometry . {} -raise . +package require tcltest 2.1 +namespace import -force tcltest::configure +namespace import -force tcltest::testsDirectory +configure -testdir [file join [pwd] [file dirname [info script]]] +configure -loadfile [file join [testsDirectory] constraints.tcl] +tcltest::loadTestedCommands test macMenu-1.0 {TkMacUseMenuID} {macOnly} { # Can't really test TkMacUseMenuID; it's only called on startup. @@ -184,7 +174,7 @@ test macMenu-8.1 {GetEntryText} {macOnly} { catch {destroy .m1} list [catch {menu .m1} msg] $msg [destroy .m1] } {0 .m1 {}} -test macMenu-8.2 {GetEntryText} {macOnly testimage} { +test macMenu-8.2 {GetEntryText} {macOnly testImageType} { catch {destroy .m1} catch {image delete image1} menu .m1 @@ -1377,7 +1367,7 @@ test macMenu-41.12 {TkpComputeStandardMenuGeometry - indicator} {macOnly} { .m1 invoke 1 list [update idletasks] [destroy .m1] } {{} {}} -test macMenu-41.13 {TkpComputeStandardMenuGeometry - second indicator less or equal } {macOnly testimage} { +test macMenu-41.13 {TkpComputeStandardMenuGeometry - second indicator less or equal } {macOnly testImageType} { catch {destroy .m1} catch {image delete image1} image create test image1 @@ -1449,7 +1439,7 @@ test macMenu-42.1 {DrawMenuEntryLabel - setting indicatorSpace} {macOnly} { set tearoff [tk::TearOffMenu .m1] list [update idletasks] [destroy .m1] } {{} {}} -test macMenu-42.2 {DrawMenuEntryLabel - drawing image} {macOnly testimage} { +test macMenu-42.2 {DrawMenuEntryLabel - drawing image} {macOnly testImageType} { catch {destroy .m1} catch {image delete image1} image create test image1 @@ -1458,7 +1448,7 @@ test macMenu-42.2 {DrawMenuEntryLabel - drawing image} {macOnly testimage} { set tearoff [tk::TearOffMenu .m1] list [update idletasks] [destroy .m1] [image delete image1] } {{} {} {}} -test macMenu-42.3 {DrawMenuEntryLabel - drawing select image} {macOnly testimage} { +test macMenu-42.3 {DrawMenuEntryLabel - drawing select image} {macOnly testImageType} { catch {destroy .m1} catch {eval image delete [image names]} image create test image1 @@ -1497,7 +1487,7 @@ test macMenu-42.7 {DrawMenuEntryLabel - drawing disabled label} {macOnly} { set tearoff [tk::TearOffMenu .m1] list [update idletasks] [destroy .m1] } {{} {}} -test macMenu-42.8 {DrawMenuEntryLabel - disabled images} {macOnly testimage} { +test macMenu-42.8 {DrawMenuEntryLabel - disabled images} {macOnly testImageType} { catch {destroy .m1} catch {image delete image1} image create test image1 @@ -1507,7 +1497,7 @@ test macMenu-42.8 {DrawMenuEntryLabel - disabled images} {macOnly testimage} { list [update idletasks] [destroy .m1] [image delete image1] } {{} {} {}} -test macMenu-43.1 {GetMenuLabelGeometry - image} {macOnly testimage} { +test macMenu-43.1 {GetMenuLabelGeometry - image} {macOnly testImageType} { catch {destroy .m1} catch {image delete image1} menu .m1 diff --git a/tests/macWinMenu.test b/tests/macWinMenu.test index 2aad508..315f2aa 100644 --- a/tests/macWinMenu.test +++ b/tests/macWinMenu.test @@ -6,34 +6,14 @@ # Copyright (c) 1998-1999 by Scriptics Corporation. # All rights reserved. # -# RCS: @(#) $Id: macWinMenu.test,v 1.3 1999/04/16 01:51:39 stanton Exp $ - -if {[lsearch [namespace children] ::tcltest] == -1} { - source [file join [pwd] [file dirname [info script]] defs.tcl] -} - -if {[lsearch [image types] test] < 0} { - puts "This application hasn't been compiled with the \"test\" image" - puts "type, so I can't run this test. Are you sure you're using" - puts "tktest instead of wish?" - ::tcltest::cleanupTests - return -} - -# Some tests require user interaction on non-unix platform -set ::tcltest::testConfig(nonUnixUserInteraction) \ - [expr {$::tcltest::testConfig(userInteraction) || \ - $::tcltest::testConfig(unixOnly)}] - -proc deleteWindows {} { - foreach i [winfo children .] { - catch [destroy $i] - } -} - -deleteWindows -wm geometry . {} -raise . +# RCS: @(#) $Id: macWinMenu.test,v 1.4 2002/07/13 20:28:35 dgp Exp $ + +package require tcltest 2.1 +namespace import -force tcltest::configure +namespace import -force tcltest::testsDirectory +configure -testdir [file join [pwd] [file dirname [info script]]] +configure -loadfile [file join [testsDirectory] constraints.tcl] +tcltest::loadTestedCommands test macWinMenu-1.1 {PreprocessMenu} {macOrPc nonUnixUserInteraction} { catch {destroy .m1} diff --git a/tests/macscrollbar.test b/tests/macscrollbar.test index 479f8c6..b62c65e 100644 --- a/tests/macscrollbar.test +++ b/tests/macscrollbar.test @@ -7,17 +7,15 @@ # Copyright (c) 1998-1999 by Scriptics Corporation. # All rights reserved. # -# RCS: @(#) $Id: macscrollbar.test,v 1.4 2001/09/21 20:38:18 hobbs Exp $ +# RCS: @(#) $Id: macscrollbar.test,v 1.5 2002/07/13 20:28:35 dgp Exp $ -if {[lsearch [namespace children] ::tcltest] == -1} { - source [file join [pwd] [file dirname [info script]] defs.tcl] -} +package require tcltest 2.1 +namespace import -force tcltest::configure +namespace import -force tcltest::testsDirectory +configure -testdir [file join [pwd] [file dirname [info script]]] +configure -loadfile [file join [testsDirectory] constraints.tcl] +tcltest::loadTestedCommands -foreach i [winfo children .] { - destroy $i -} -wm geometry . {} -raise . update # Tests for display and layout @@ -91,10 +89,7 @@ test macscroll-1.7 {TkpDisplayScrollbar procedure} {macOnly} { place .s2 -x 0 -y 284 -width 300 } {} -foreach i [winfo children .] { - destroy $i -} - +deleteWindows # cleanup ::tcltest::cleanupTests return diff --git a/tests/main.test b/tests/main.test index 0422223..0f25637 100644 --- a/tests/main.test +++ b/tests/main.test @@ -8,30 +8,33 @@ # Copyright (c) 1998-1999 by Scriptics Corporation. # All rights reserved. # -# RCS: @(#) $Id: main.test,v 1.5 1999/04/16 01:51:39 stanton Exp $ +# RCS: @(#) $Id: main.test,v 1.6 2002/07/13 20:28:35 dgp Exp $ -if {[lsearch [namespace children] ::tcltest] == -1} { - source [file join [pwd] [file dirname [info script]] defs.tcl] -} +package require tcltest 2.1 +namespace import -force tcltest::configure +namespace import -force tcltest::testsDirectory +configure -testdir [file join [pwd] [file dirname [info script]]] +configure -loadfile [file join [testsDirectory] constraints.tcl] +tcltest::loadTestedCommands -test main-1.1 {StdinProc} {unixOnly} { - catch {removeFile script} - set fd [open script w] - puts $fd { +namespace import -force tcltest::interpreter +namespace import -force tcltest::makeFile +namespace import -force tcltest::removeFile + +test main-1.1 {StdinProc} {unix} { + set script [makeFile { close stdin; exit - } - close $fd - if {[catch {exec $::tcltest::tktest