diff options
| -rw-r--r-- | ChangeLog | 35 | ||||
| -rw-r--r-- | tests/choosedir.test | 84 | ||||
| -rw-r--r-- | tests/clipboard.test | 361 | ||||
| -rw-r--r-- | tests/embed.test | 98 | ||||
| -rw-r--r-- | tests/main.test | 138 |
5 files changed, 440 insertions, 276 deletions
@@ -1,3 +1,10 @@ +2008-08-12 Ania Pawelczyk <aniap@users.sourceforge.net> + + * test/choosedir.test: Update to tcltest2 + * test/clipboard.test: + * test/embed.test: + * test/main.test: + 2008-08-12 Don Porter <dgp@users.sourceforge.net> * README: Bump version number to 8.6a2 @@ -15,15 +22,15 @@ 2008-08-11 Ania Pawelczyk <aniap@users.sourceforge.net> * test/canvImg.test: Update to tcltest2 - * test/canvRect.test - * test/canvText.test - * test/obj.test + * test/canvRect.test: + * test/canvText.test: + * test/obj.test: 2008-08-07 Ania Pawelczyk <aniap@users.sourceforge.net> * test/canvPs.test: Update to tcltest2 - * test/config.test - * test/canvas.test + * test/config.test: + * test/canvas.test: 2008-08-05 Joe English <jenglish@users.sourceforge.net> @@ -34,8 +41,8 @@ 2008-08-03 Ania Pawelczyk <aniap@users.sourceforge.net> * test/cmds.test: Update to tcltest2 - * test/dialog.test - * test/get.test + * test/dialog.test: + * test/get.test: * test/text.test: Update to tcltest2; report: 33.11 fails 2008-08-01 Pat Thoyts <patthoyts@users.sourceforge.net> @@ -57,7 +64,7 @@ 2008-07-28 Ania Pawelczyk <aniap@users.sourceforge.net> * test/cursor.test: Update to tcltest2 - * test/message.test + * test/message.test: 2008-07-26 Pat Thoyts <patthoyts@users.sourceforge.net> @@ -87,12 +94,12 @@ 2008-07-22 Ania Pawelczyk <aniap@users.sourceforge.net> * test/bell.test: Update to tcltest2 - * test/bgerror.test - * test/bitmap.test - * test/border.test - * test/button.test - * test/entry.test - * test/spinbox.test + * test/bgerror.test: + * test/bitmap.test: + * test/border.test: + * test/button.test: + * test/entry.test: + * test/spinbox.test: 2008-07-22 Daniel Steffen <das@users.sourceforge.net> diff --git a/tests/choosedir.test b/tests/choosedir.test index 7d5d942..65cc4cb 100644 --- a/tests/choosedir.test +++ b/tests/choosedir.test @@ -5,10 +5,11 @@ # Copyright (c) 1998-1999 by Scriptics Corporation. # All rights reserved. # -# RCS: @(#) $Id: choosedir.test,v 1.15 2007/05/09 12:52:44 das Exp $ +# RCS: @(#) $Id: choosedir.test,v 1.16 2008/08/12 22:52:23 aniap Exp $ # -package require tcltest 2.1 +package require tcltest 2.2 +namespace import ::tcltest::* eval tcltest::configure $argv tcltest::loadTestedCommands @@ -87,61 +88,86 @@ set fake [file join $dir non-existant] set parent . -foreach opt {-initialdir -mustexist -parent -title} { - test choosedir-1.1$opt "tk_chooseDirectory command" unix { - list [catch {tk_chooseDirectory $opt} msg] $msg - } [list 1 "value for \"$opt\" missing"] -} -test choosedir-1.2 "tk_chooseDirectory command" unix { - list [catch {tk_chooseDirectory -foo bar} msg] $msg -} [list 1 "bad option \"-foo\": must be -initialdir, -mustexist, -parent, or -title"] -test choosedir-1.3 "tk_chooseDirectory command" unix { - list [catch {tk_chooseDirectory -parent foo.bar} msg] $msg -} {1 {bad window path name "foo.bar"}} - - -test choosedir-2.1 "tk_chooseDirectory command, cancel gives null" {unix notAqua} { +test choosedir-1.1 {tk_chooseDirectory command} -constraints unix -body { + tk_chooseDirectory -initialdir +} -returnCodes error -result {value for "-initialdir" missing} +test choosedir-1.2 {tk_chooseDirectory command} -constraints unix -body { + tk_chooseDirectory -mustexist +} -returnCodes error -result {value for "-mustexist" missing} +test choosedir-1.3 {tk_chooseDirectory command} -constraints unix -body { + tk_chooseDirectory -parent +} -returnCodes error -result {value for "-parent" missing} +test choosedir-1.4 {tk_chooseDirectory command} -constraints unix -body { + tk_chooseDirectory -title +} -returnCodes error -result {value for "-title" missing} + +test choosedir-1.5 {tk_chooseDirectory command} -constraints unix -body { + tk_chooseDirectory -foo bar +} -returnCodes error -result {bad option "-foo": must be -initialdir, -mustexist, -parent, or -title} +test choosedir-1.6 {tk_chooseDirectory command} -constraints unix -body { + tk_chooseDirectory -parent foo.bar +} -returnCodes error -result {bad window path name "foo.bar"} + + +test choosedir-2.1 {tk_chooseDirectory command, cancel gives null} -constraints { + unix notAqua +} -body { ToPressButton $parent cancel tk_chooseDirectory -title "Press Cancel" -parent $parent -} "" +} -result {} -test choosedir-3.1 "tk_chooseDirectory -mustexist 1" {unix notAqua} { + +test choosedir-3.1 {tk_chooseDirectory -mustexist 1} -constraints { + unix notAqua +} -body { # first enter a bogus dirname, then enter a real one. ToEnterDirsByKey $parent [list $fake $real $real] set result [tk_chooseDirectory \ -title "Enter \"$fake\", press OK, enter \"$real\", press OK" \ -parent $parent -mustexist 1] set result -} $real -test choosedir-3.2 "tk_chooseDirectory -mustexist 0" {unix notAqua} { +} -result $real +test choosedir-3.2 {tk_chooseDirectory -mustexist 0} -constraints { + unix notAqua +} -body { ToEnterDirsByKey $parent [list $fake $fake] tk_chooseDirectory -title "Enter \"$fake\", press OK" \ -parent $parent -mustexist 0 -} $fake +} -result $fake + -test choosedir-4.1 "tk_chooseDirectory command, initialdir" {unix notAqua} { +test choosedir-4.1 {tk_chooseDirectory command, initialdir} -constraints { + unix notAqua +} -body { ToPressButton $parent ok tk_chooseDirectory -title "Press Ok" -parent $parent -initialdir $real -} $real -test choosedir-4.2 "tk_chooseDirectory command, initialdir" {unix notAqua} { +} -result $real +test choosedir-4.2 {tk_chooseDirectory command, initialdir} -constraints { + unix notAqua +} -body { ToEnterDirsByKey $parent [list $fake $fake] tk_chooseDirectory \ -title "Enter \"$fake\" and press Ok" \ -parent $parent -initialdir $real -} $fake -test choosedir-4.3 "tk_chooseDirectory, -initialdir {}" {unix notAqua} { +} -result $fake +test choosedir-4.3 {tk_chooseDirectory command, {} initialdir} -constraints { + unix notAqua +} -body { catch {unset ::tk::dialog::file::__tk_choosedir} ToPressButton $parent ok tk_chooseDirectory \ -title "Press OK" \ -parent $parent -initialdir "" -} [pwd] +} -result [pwd] + -test choosedir-5.1 "tk_chooseDirectory, handles {} entry text" {unix notAqua} { +test choosedir-5.1 {tk_chooseDirectory, handles {} entry text} -constraints { + unix notAqua +} -body { ToEnterDirsByKey $parent [list "" $real $real] tk_chooseDirectory -title "Clear entry, Press OK; Enter $real, press OK" \ -parent $parent -} $real +} -result $real # cleanup removeDirectory choosedirTest diff --git a/tests/clipboard.test b/tests/clipboard.test index 5248cc9..8c31971 100644 --- a/tests/clipboard.test +++ b/tests/clipboard.test @@ -6,14 +6,15 @@ # Copyright (c) 1998-1999 by Scriptics Corporation. # All rights reserved. # -# RCS: @(#) $Id: clipboard.test,v 1.10 2008/07/23 23:24:25 nijtmans Exp $ +# RCS: @(#) $Id: clipboard.test,v 1.11 2008/08/12 22:52:23 aniap Exp $ # # Note: Multiple display clipboard handling will only be tested if the # environment variable TK_ALT_DISPLAY is set to an alternate display. # -package require tcltest 2.1 +package require tcltest 2.2 +namespace import ::tcltest::* eval tcltest::configure $argv tcltest::loadTestedCommands @@ -26,123 +27,188 @@ foreach i {a b c d e f g j h i j k l m o p q r s t u v w x y z} { # Now we start the main body of the test code -test clipboard-1.1 {ClipboardHandler procedure} { +test clipboard-1.1 {ClipboardHandler procedure} -setup { clipboard clear +} -body { clipboard append "test" clipboard get -} {test} -test clipboard-1.2 {ClipboardHandler procedure} { +} -cleanup { clipboard clear +} -result {test} +test clipboard-1.2 {ClipboardHandler procedure} -setup { + clipboard clear +} -body { clipboard append "test" clipboard append "ing" clipboard get -} {testing} -test clipboard-1.3 {ClipboardHandler procedure} { +} -cleanup { + clipboard clear +} -result {testing} +test clipboard-1.3 {ClipboardHandler procedure} -setup { clipboard clear +} -body { clipboard append "t" clipboard append "e" clipboard append "s" clipboard append "t" clipboard get -} {test} -test clipboard-1.4 {ClipboardHandler procedure} { +} -cleanup { + clipboard clear +} -result {test} +test clipboard-1.4 {ClipboardHandler procedure} -setup { clipboard clear +} -body { clipboard append $longValue clipboard get -} "$longValue" -test clipboard-1.5 {ClipboardHandler procedure} { +} -cleanup { clipboard clear +} -result "$longValue" +test clipboard-1.5 {ClipboardHandler procedure} -setup { + clipboard clear +} -body { clipboard append $longValue clipboard append "test" clipboard get -} "${longValue}test" -test clipboard-1.6 {ClipboardHandler procedure} { +} -cleanup { + clipboard clear +} -result "${longValue}test" +test clipboard-1.6 {ClipboardHandler procedure} -setup { clipboard clear +} -body { clipboard append -t TEST $longValue clipboard append -t STRING "test" - list [clipboard get -t STRING] \ - [clipboard get -t TEST] -} [list test $longValue] -test clipboard-1.7 {ClipboardHandler procedure} { + list [clipboard get -t STRING] [clipboard get -t TEST] +} -cleanup { clipboard clear +} -result [list test $longValue] +test clipboard-1.7 {ClipboardHandler procedure} -setup { + clipboard clear +} -body { clipboard append -t TEST [string range $longValue 1 4000] clipboard append -t STRING "test" - list [clipboard get -t STRING] \ - [clipboard get -t TEST] -} [list test [string range $longValue 1 4000]] -test clipboard-1.8 {ClipboardHandler procedure} { + list [clipboard get -t STRING] [clipboard get -t TEST] +} -cleanup { + clipboard clear +} -result [list test [string range $longValue 1 4000]] +test clipboard-1.8 {ClipboardHandler procedure} -setup { clipboard clear +} -body { clipboard append "" clipboard get -} {} -test clipboard-1.9 {ClipboardHandler procedure} { +} -cleanup { clipboard clear +} -result {} +test clipboard-1.9 {ClipboardHandler procedure} -setup { + clipboard clear +} -body { clipboard append "" clipboard append "Test" clipboard get -} {Test} +} -cleanup { + clipboard clear +} -result {Test} ############################################################################## -test clipboard-2.1 {ClipboardAppHandler procedure} { +test clipboard-2.1 {ClipboardAppHandler procedure} -setup { set oldAppName [tk appname] - tk appname UnexpectedName clipboard clear +} -body { + tk appname UnexpectedName clipboard append -type NEW_TYPE Data - set result [selection get -selection CLIPBOARD -type TK_APPLICATION] + selection get -selection CLIPBOARD -type TK_APPLICATION +} -cleanup { tk appname $oldAppName - set result -} {UnexpectedName} + clipboard clear +} -result {UnexpectedName} ############################################################################## -test clipboard-3.1 {ClipboardWindowHandler procedure} { +test clipboard-3.1 {ClipboardWindowHandler procedure} -setup { set oldAppName [tk appname] - tk appname UnexpectedName clipboard clear +} -body { + tk appname UnexpectedName clipboard append -type NEW_TYPE Data - set result [selection get -selection CLIPBOARD -type TK_WINDOW] + selection get -selection CLIPBOARD -type TK_WINDOW +} -cleanup { tk appname $oldAppName - set result -} {.} + clipboard clear +} -result {.} ############################################################################## -test clipboard-4.1 {ClipboardLostSel procedure} { +test clipboard-4.1 {ClipboardLostSel procedure} -setup { clipboard clear +} -body { clipboard append "Test" selection clear -s CLIPBOARD - list [catch {clipboard get} msg] $msg -} {1 {CLIPBOARD selection doesn't exist or form "STRING" not defined}} -test clipboard-4.2 {ClipboardLostSel procedure} { + clipboard get +} -cleanup { + clipboard clear +} -returnCodes error -result {CLIPBOARD selection doesn't exist or form "STRING" not defined} +test clipboard-4.2 {ClipboardLostSel procedure} -setup { clipboard clear +} -body { clipboard append "Test" clipboard append -t TEST "Test2" selection clear -s CLIPBOARD - list [catch {clipboard get} msg] $msg \ - [catch {clipboard get -t TEST} msg] $msg -} {1 {CLIPBOARD selection doesn't exist or form "STRING" not defined} 1 {CLIPBOARD selection doesn't exist or form "TEST" not defined}} -test clipboard-4.3 {ClipboardLostSel procedure} { + clipboard get +} -cleanup { + clipboard clear +} -returnCodes error -result {CLIPBOARD selection doesn't exist or form "STRING" not defined} +test clipboard-4.3 {ClipboardLostSel procedure} -setup { + clipboard clear +} -body { + clipboard append "Test" + clipboard append -t TEST "Test2" + selection clear -s CLIPBOARD + catch {clipboard get} + clipboard get -t TEST +} -cleanup { + clipboard clear +} -returnCodes error -result {CLIPBOARD selection doesn't exist or form "TEST" not defined} +test clipboard-4.4 {ClipboardLostSel procedure} -setup { + clipboard clear +} -body { + clipboard append "Test" + clipboard append -t TEST "Test2" + clipboard append "Test3" + selection clear -s CLIPBOARD + clipboard get +} -cleanup { + clipboard clear +} -returnCodes error -result {CLIPBOARD selection doesn't exist or form "STRING" not defined} +test clipboard-4.5 {ClipboardLostSel procedure} -setup { clipboard clear +} -body { clipboard append "Test" clipboard append -t TEST "Test2" clipboard append "Test3" selection clear -s CLIPBOARD - list [catch {clipboard get} msg] $msg \ - [catch {clipboard get -t TEST} msg] $msg -} {1 {CLIPBOARD selection doesn't exist or form "STRING" not defined} 1 {CLIPBOARD selection doesn't exist or form "TEST" not defined}} + catch {clipboard get} + clipboard get -t TEST +} -cleanup { + clipboard clear +} -returnCodes error -result {CLIPBOARD selection doesn't exist or form "TEST" not defined} + + ############################################################################## -test clipboard-5.1 {Tk_ClipboardClear procedure} { +test clipboard-5.1 {Tk_ClipboardClear procedure} -setup { clipboard clear +} -body { clipboard append -t TEST "test" set result [lsort [clipboard get TARGETS]] clipboard clear list $result [lsort [clipboard get TARGETS]] -} {{MULTIPLE TARGETS TEST TIMESTAMP TK_APPLICATION TK_WINDOW} {MULTIPLE TARGETS TIMESTAMP TK_APPLICATION TK_WINDOW}} -test clipboard-5.2 {Tk_ClipboardClear procedure} { +} -cleanup { + clipboard clear +} -result {{MULTIPLE TARGETS TEST TIMESTAMP TK_APPLICATION TK_WINDOW} {MULTIPLE TARGETS TIMESTAMP TK_APPLICATION TK_WINDOW}} +test clipboard-5.2 {Tk_ClipboardClear procedure} -setup { clipboard clear +} -body { clipboard append -t TEST "test" set result [lsort [clipboard get TARGETS]] selection own -s CLIPBOARD . @@ -150,97 +216,150 @@ test clipboard-5.2 {Tk_ClipboardClear procedure} { clipboard clear clipboard append -t TEST "test" lappend result [lsort [clipboard get TARGETS]] -} {MULTIPLE TARGETS TEST TIMESTAMP TK_APPLICATION TK_WINDOW {MULTIPLE TARGETS TIMESTAMP TK_APPLICATION TK_WINDOW} {MULTIPLE TARGETS TEST TIMESTAMP TK_APPLICATION TK_WINDOW}} +} -cleanup { + clipboard clear +} -result {MULTIPLE TARGETS TEST TIMESTAMP TK_APPLICATION TK_WINDOW {MULTIPLE TARGETS TIMESTAMP TK_APPLICATION TK_WINDOW} {MULTIPLE TARGETS TEST TIMESTAMP TK_APPLICATION TK_WINDOW}} ############################################################################## -test clipboard-6.1 {Tk_ClipboardAppend procedure} { +test clipboard-6.1 {Tk_ClipboardAppend procedure} -setup { clipboard clear +} -body { clipboard append "first chunk" selection own -s CLIPBOARD . - list [catch { clipboard append " second chunk" clipboard get - } msg] $msg -} {0 {first chunk second chunk}} -test clipboard-6.2 {Tk_ClipboardAppend procedure} unix { - setupbg +} -cleanup { clipboard clear +} -returnCodes ok -result {first chunk second chunk} +test clipboard-6.2 {Tk_ClipboardAppend procedure} -constraints unix -setup { + clipboard clear +} -body { + setupbg clipboard append -f INTEGER -t TEST "16" set result [dobg {clipboard get TEST}] + return $result +} -cleanup { + clipboard clear cleanupbg - set result -} {0x10} -test clipboard-6.3 {Tk_ClipboardAppend procedure} { +} -result {0x10} +test clipboard-6.3 {Tk_ClipboardAppend procedure} -setup { clipboard clear +} -body { clipboard append -f INTEGER -t TEST "16" - list [catch {clipboard append -t TEST "test"} msg] $msg -} {1 {format "STRING" does not match current format "INTEGER" for TEST}} + clipboard append -t TEST "test" +} -cleanup { + clipboard clear +} -returnCodes error -result {format "STRING" does not match current format "INTEGER" for TEST} ############################################################################## -test clipboard-7.1 {Tk_ClipboardCmd procedure} { - list [catch {clipboard} msg] $msg -} {1 {wrong # args: should be "clipboard option ?arg ...?"}} -test clipboard-7.2 {Tk_ClipboardCmd procedure} { - clipboard clear - list [catch {clipboard append --} msg] $msg \ - [selection get -selection CLIPBOARD] -} {0 {} --} -test clipboard-7.3 {Tk_ClipboardCmd procedure} { - clipboard clear - list [catch {clipboard append -- information} msg] $msg \ - [selection get -selection CLIPBOARD] -} {0 {} information} -test clipboard-7.4 {Tk_ClipboardCmd procedure} { - list [catch {clipboard append --x a b} msg] $msg -} {1 {bad option "--x": must be -displayof, -format, or -type}} -test clipboard-7.5 {Tk_ClipboardCmd procedure} { - list [catch {clipboard append -- a b} msg] $msg -} {1 {wrong # args: should be "clipboard append ?-option value ...? data"}} -test clipboard-7.6 {Tk_ClipboardCmd procedure} { - clipboard clear - list [catch {clipboard append -format} msg] $msg \ - [selection get -selection CLIPBOARD] -} {0 {} -format} -test clipboard-7.7 {Tk_ClipboardCmd procedure} { - list [catch {clipboard append -displayofoo f} msg] $msg -} {1 {bad option "-displayofoo": must be -displayof, -format, or -type}} -test clipboard-7.8 {Tk_ClipboardCmd procedure} { - list [catch {clipboard append -type TEST} msg] $msg -} {1 {wrong # args: should be "clipboard append ?-option value ...? data"}} -test clipboard-7.9 {Tk_ClipboardCmd procedure} { - list [catch {clipboard append -displayof foo "test"} msg] $msg -} {1 {bad window path name "foo"}} - -test clipboard-7.10 {Tk_ClipboardCmd procedure} { - list [catch {clipboard clear -displayof} msg] $msg -} {1 {wrong # args: should be "clipboard clear ?-displayof window?"}} -test clipboard-7.11 {Tk_ClipboardCmd procedure} { - list [catch {clipboard clear -displayofoo f} msg] $msg -} {1 {bad option "-displayofoo": must be -displayof}} -test clipboard-7.12 {Tk_ClipboardCmd procedure} { - list [catch {clipboard clear foo} msg] $msg -} {1 {wrong # args: should be "clipboard clear ?-displayof window?"}} -test clipboard-7.13 {Tk_ClipboardCmd procedure} { - list [catch {clipboard clear -displayof foo} msg] $msg -} {1 {bad window path name "foo"}} - -test clipboard-7.14 {Tk_ClipboardCmd procedure} { - list [catch {clipboard error} msg] $msg -} {1 {bad option "error": must be append, clear, or get}} - -test clipboard-7.15 {Tk_ClipboardCmd procedure} { - clipboard clear - list [catch {clipboard append -displayof} msg] $msg \ - [selection get -selection CLIPBOARD] -} {0 {} -displayof} -test clipboard-7.16 {Tk_ClipboardCmd procedure} { - clipboard clear - list [catch {clipboard append -type} msg] $msg \ - [selection get -selection CLIPBOARD] -} {0 {} -type} +test clipboard-7.1 {Tk_ClipboardCmd procedure} -body { + clipboard +} -returnCodes error -result {wrong # args: should be "clipboard option ?arg ...?"} +test clipboard-7.2 {Tk_ClipboardCmd procedure} -setup { + clipboard clear +} -body { + clipboard append -- +} -cleanup { + clipboard clear +} -returnCodes ok -result {} +test clipboard-7.3 {Tk_ClipboardCmd procedure} -setup { + clipboard clear +} -body { + clipboard append -- + selection get -selection CLIPBOARD +} -cleanup { + clipboard clear +} -result {--} +test clipboard-7.4 {Tk_ClipboardCmd procedure} -setup { + clipboard clear +} -body { + clipboard append -- information + selection get -selection CLIPBOARD +} -cleanup { + clipboard clear +} -result {information} +test clipboard-7.5 {Tk_ClipboardCmd procedure} -body { + clipboard append --x a b +} -returnCodes error -result {bad option "--x": must be -displayof, -format, or -type} +test clipboard-7.6 {Tk_ClipboardCmd procedure} -body { + clipboard append -- a b +} -returnCodes error -result {wrong # args: should be "clipboard append ?-option value ...? data"} +test clipboard-7.7 {Tk_ClipboardCmd procedure} -setup { + clipboard clear +} -body { + clipboard append -format +} -returnCodes ok -result {} +test clipboard-7.8 {Tk_ClipboardCmd procedure} -setup { + clipboard clear +} -body { + clipboard append -format + selection get -selection CLIPBOARD +} -cleanup { + clipboard clear +} -result {-format} +test clipboard-7.9 {Tk_ClipboardCmd procedure} -body { + clipboard append -displayofoo f +} -returnCodes error -result {bad option "-displayofoo": must be -displayof, -format, or -type} +test clipboard-7.10 {Tk_ClipboardCmd procedure} -body { + clipboard append -type TEST +} -returnCodes error -result {wrong # args: should be "clipboard append ?-option value ...? data"} +test clipboard-7.11 {Tk_ClipboardCmd procedure} -body { + clipboard append -displayof foo "test" +} -returnCodes error -result {bad window path name "foo"} + +test clipboard-7.12 {Tk_ClipboardCmd procedure} -body { + clipboard clear -displayof +} -returnCodes error -result {wrong # args: should be "clipboard clear ?-displayof window?"} +test clipboard-7.13 {Tk_ClipboardCmd procedure} -body { + clipboard clear -displayofoo f +} -returnCodes error -result {bad option "-displayofoo": must be -displayof} +test clipboard-7.14 {Tk_ClipboardCmd procedure} -body { + clipboard clear foo +} -returnCodes error -result {wrong # args: should be "clipboard clear ?-displayof window?"} +test clipboard-7.15 {Tk_ClipboardCmd procedure} -body { + clipboard clear -displayof foo +} -returnCodes error -result {bad window path name "foo"} + +test clipboard-7.16 {Tk_ClipboardCmd procedure} -body { + clipboard error +} -returnCodes error -result {bad option "error": must be append, clear, or get} +test clipboard-7.17 {Tk_ClipboardCmd procedure} -setup { + clipboard clear +} -body { + clipboard append -displayof +} -cleanup { + clipboard clear +} -returnCodes ok -result {} +test clipboard-7.18 {Tk_ClipboardCmd procedure} -setup { + clipboard clear +} -body { + clipboard append -displayof + selection get -selection CLIPBOARD +} -cleanup { + clipboard clear +} -result {-displayof} +test clipboard-7.19 {Tk_ClipboardCmd procedure} -setup { + clipboard clear +} -body { + clipboard append -type +} -cleanup { + clipboard clear +} -returnCodes ok -result {} +test clipboard-7.20 {Tk_ClipboardCmd procedure} -setup { + clipboard clear +} -body { + clipboard append -type + selection get -selection CLIPBOARD +} -cleanup { + clipboard clear +} -result {-type} # cleanup cleanupTests return + + + + diff --git a/tests/embed.test b/tests/embed.test index 6cf4854..db486f0 100644 --- a/tests/embed.test +++ b/tests/embed.test @@ -4,69 +4,87 @@ # Copyright (c) 1998-1999 by Scriptics Corporation. # All rights reserved. # -# RCS: @(#) $Id: embed.test,v 1.4 2005/02/15 03:22:10 chengyemao Exp $ +# RCS: @(#) $Id: embed.test,v 1.5 2008/08/12 22:52:23 aniap Exp $ -package require tcltest 2.1 +package require tcltest 2.2 +namespace import ::tcltest::* eval tcltest::configure $argv tcltest::loadTestedCommands -global tcl_platform -test embed-1.1 {TkpUseWindow procedure, bad window identifier} { +test embed-1.1 {TkpUseWindow procedure, bad window identifier} -setup { deleteWindows - list [catch {toplevel .t -use xyz} msg] $msg -} {1 {expected integer but got "xyz"}} +} -body { + toplevel .t -use xyz +} -cleanup { + deleteWindows +} -returnCodes error -result {expected integer but got "xyz"} -test embed-1.2 {CreateFrame procedure, bad window identifier} { +test embed-1.2 {CreateFrame procedure, bad window identifier} -setup { + deleteWindows +} -body { + toplevel .t -container xyz +} -cleanup { deleteWindows - list [catch {toplevel .t -container xyz} msg] $msg -} {1 {expected boolean value but got "xyz"}} +} -returnCodes error -result {expected boolean value but got "xyz"} -test embed-1.3 {CreateFrame procedure, both -use and - -container is invalid } { +test embed-1.3 {CreateFrame procedure, both -use and -container is invalid} -setup { deleteWindows +} -body { toplevel .container -container 1 - list [catch {toplevel .t -use [winfo id .container] \ - -container 1} msg] $msg -} {1 {A window cannot have both the -use and the -container option set.}} - -if {$tcl_platform(platform) == "windows"} { - -# testing window embedding for Windows platform + toplevel .t -use [winfo id .container] -container 1 +} -cleanup { + deleteWindows +} -returnCodes error -result {A window cannot have both the -use and the -container option set.} -test embed-1.4 {TkpUseWindow procedure, -container must be set} { +# testing window embedding for win platforms +test embed-1.4 {TkpUseWindow procedure, -container must be set} -constraints { + win +} -setup { deleteWindows +} -body { toplevel .container - list [catch {toplevel .embd -use [winfo id .container]} err] $err -} {1 {the window to use is not a Tk container}} - -test embed-1.5 {TkpUseWindow procedure, -container must be set} { + toplevel .embd -use [winfo id .container] +} -cleanup { deleteWindows +} -returnCodes error -result {the window to use is not a Tk container} +# testing window embedding for win platforms +test embed-1.5 {TkpUseWindow procedure, -container must be set} -constraints { + win +} -setup { + deleteWindows +} -body { frame .container - list [catch {toplevel .embd -use [winfo id .container]} err] $err -} {1 {the window to use is not a Tk container}} - -} else { - -# testing window embedding for other platforms + toplevel .embd -use [winfo id .container] +} -cleanup { + deleteWindows +} -returnCodes error -result {the window to use is not a Tk container} -test embed-1.4 {TkpUseWindow procedure, -container must be set} { +# testing window embedding for other than win platforms +test embed-1.5 {TkpUseWindow procedure, -container must be set} -constraints { + nonwin +} -setup { deleteWindows +} -body { toplevel .container - list [catch {toplevel .embd -use [winfo id .container]} err] $err -} {1 {window ".container" doesn't have -container option set}} - -test embed-1.5 {TkpUseWindow procedure, -container must be set} { + toplevel .embd -use [winfo id .container] +} -cleanup { + deleteWindows +} -returnCodes error -result {window ".container" doesn't have -container option set} +# testing window embedding for other than win platforms +test embed-1.6 {TkpUseWindow procedure, -container must be set} -constraints { + nonwin +} -setup { deleteWindows +} -body { frame .container - list [catch {toplevel .embd -use [winfo id .container]} err] $err -} {1 {window ".container" doesn't have -container option set}} - -} + toplevel .embd -use [winfo id .container] +} -cleanup { + deleteWindows +} -returnCodes error -result {window ".container" doesn't have -container option set} -# FIXME: test cases common to unixEmbed.test and macEmbed.test should -# be moved here. cleanupTests return + diff --git a/tests/main.test b/tests/main.test index ede20f3..b7418e1 100644 --- a/tests/main.test +++ b/tests/main.test @@ -8,61 +8,57 @@ # Copyright (c) 1998-1999 by Scriptics Corporation. # All rights reserved. # -# RCS: @(#) $Id: main.test,v 1.11 2008/04/07 23:14:39 hobbs Exp $ +# RCS: @(#) $Id: main.test,v 1.12 2008/08/12 22:52:23 aniap Exp $ -package require tcltest 2.1 +package require tcltest 2.2 +namespace import ::tcltest::* eval tcltest::configure $argv tcltest::loadTestedCommands test main-1.1 {StdinProc} -constraints stdio -setup { - set script [makeFile { - close stdin; exit - } script] + set script [makeFile {close stdin; exit} script] } -body { - list [catch {exec [interpreter] <$script} msg] $msg + exec [interpreter] <$script } -cleanup { removeFile script -} -result {0 {}} +} -returnCodes ok -test main-2.1 {Tk_MainEx: -encoding option} -constraints { - stdio - } -setup { - set script [makeFile {} script] - file delete $script - set f [open $script w] - fconfigure $f -encoding utf-8 - puts $f {puts [list $argv0 $argv $tcl_interactive]} - puts -nonewline $f {puts [string equal \u20ac } - puts $f "\u20ac]; exit" - close $f - catch {set f [open "|[list [interpreter] -encoding utf-8 script]" r]} - } -body { - read $f - } -cleanup { - close $f - removeFile script - } -result [list script {} 0]\n1\n +test main-2.1 {Tk_MainEx: -encoding option} -constraints stdio -setup { + set script [makeFile {} script] + file delete $script + set f [open $script w] + fconfigure $f -encoding utf-8 + puts $f {puts [list $argv0 $argv $tcl_interactive]} + puts -nonewline $f {puts [string equal \u20ac } + puts $f "\u20ac]; exit" + close $f + catch {set f [open "|[list [interpreter] -encoding utf-8 script]" r]} +} -body { + read $f +} -cleanup { + close $f + removeFile script +} -result "script {} 0\n1\n" -test main-2.2 {Tk_MainEx: -encoding option} -constraints { - stdio - } -setup { - set script [makeFile {} script] - file delete $script - set f [open $script w] - fconfigure $f -encoding utf-8 - puts $f {puts [list $argv0 $argv $tcl_interactive]} - puts -nonewline $f {puts [string equal \u20ac } - puts $f "\u20ac]; exit" - close $f - catch {set f [open "|[list [interpreter] -encoding ascii script]" r]} - } -body { - read $f - } -cleanup { - close $f - removeFile script - } -result [list script {} 0]\n0\n +test main-2.2 {Tk_MainEx: -encoding option} -constraints stdio -setup { + set script [makeFile {} script] + file delete $script + set f [open $script w] + fconfigure $f -encoding utf-8 + puts $f {puts [list $argv0 $argv $tcl_interactive]} + puts -nonewline $f {puts [string equal \u20ac } + puts $f "\u20ac]; exit" + close $f + catch {set f [open "|[list [interpreter] -encoding ascii script]" r]} +} -body { + read $f +} -cleanup { + close $f + removeFile script +} -result "script {} 0\n0\n" - # Procedure to simulate interactive typing of commands, line by line + # Procedure to simulate interactive typing of commands, line by line, + # for test 2.3 proc type {chan script} { foreach line [split $script \n] { if {[catch { @@ -76,52 +72,50 @@ test main-2.2 {Tk_MainEx: -encoding option} -constraints { } } -test main-2.3 {Tk_MainEx: -encoding option} -constraints { - stdio - } -setup { - set script [makeFile {} script] - file delete $script - set f [open $script w] - fconfigure $f -encoding utf-8 - puts $f {puts [list $argv0 $argv $tcl_interactive]} - puts -nonewline $f {puts [string equal \u20ac } - puts $f "\u20ac]" - close $f - catch {set f [open "|[list [interpreter] -enc utf-8 script]" r+]} - } -body { - type $f { - puts $argv - exit - } - list [catch {gets $f} line] $line - } -cleanup { - close $f - removeFile script - } -result {0 {-enc utf-8 script}} +test main-2.3 {Tk_MainEx: -encoding option} -constraints stdio -setup { + set script [makeFile {} script] + file delete $script + set f [open $script w] + fconfigure $f -encoding utf-8 + puts $f {puts [list $argv0 $argv $tcl_interactive]} + puts -nonewline $f {puts [string equal \u20ac } + puts $f "\u20ac]" + close $f + catch {set f [open "|[list [interpreter] -enc utf-8 script]" r+]} +} -body { + type $f { + puts $argv + exit + } + gets $f +} -cleanup { + close $f + removeFile script +} -returnCodes ok -result {-enc utf-8 script} test main-3.1 {Tk_ParseArgv: -help option} -constraints unix -body { # Run only on unix as Win32 pops up native dialog - list [catch {exec [interpreter] -help} msg] $msg -} -match glob -result {1 {% Application initialization failed: Command-specific options:*}} + exec [interpreter] -help +} -returnCodes error -match glob -result {% Application initialization failed: Command-specific options:*} test main-3.2 {Tk_ParseArgv: -help option} -setup { set maininterp [interp create] } -body { $maininterp eval { set argc 1 ; set argv -help } - list [catch {load {} Tk $maininterp} msg] $msg + load {} Tk $maininterp } -cleanup { interp delete $maininterp -} -match glob -result {1 {Command-specific options:*}} +} -returnCodes error -match glob -result {Command-specific options:*} test main-3.3 {Tk_ParseArgv: -help option} -setup { set maininterp [interp create] } -body { # Repeat of 3.2 to catch cleanup, eg Bug 1927135 $maininterp eval { set argc 1 ; set argv -help } - list [catch {load {} Tk $maininterp} msg] $msg + load {} Tk $maininterp } -cleanup { interp delete $maininterp -} -match glob -result {1 {Command-specific options:*}} +} -returnCodes error -match glob -result {Command-specific options:*} # cleanup cleanupTests |