diff options
author | ericm <ericm> | 2000-08-08 19:21:18 (GMT) |
---|---|---|
committer | ericm <ericm> | 2000-08-08 19:21:18 (GMT) |
commit | 33dfdb962c35a1f9a9c1b61e10ab8bd93b1704b6 (patch) | |
tree | 2a6d14dee1938780ae6220656dce380c37b42e99 /tests | |
parent | d6e970588203e0065e68d0d64c1bf8ebadc8397c (diff) | |
download | tk-33dfdb962c35a1f9a9c1b61e10ab8bd93b1704b6.zip tk-33dfdb962c35a1f9a9c1b61e10ab8bd93b1704b6.tar.gz tk-33dfdb962c35a1f9a9c1b61e10ab8bd93b1704b6.tar.bz2 |
* tests/place.test: Extended test suite to test error returns from
[place].
* generic/tkInt.h: Replaced Tk_PlaceCmd prototype with
Tk_PlaceObjCmd prototype.
* generic/tkWindow.c: Updated [place] command entry to use new
Tcl_Obj interface.
* generic/tkPlace.c (Tk_PlaceObjCmd): Tcl_Obj'ified [place] command.
Diffstat (limited to 'tests')
-rw-r--r-- | tests/place.test | 95 |
1 files changed, 81 insertions, 14 deletions
diff --git a/tests/place.test b/tests/place.test index ea4014b..86f663d 100644 --- a/tests/place.test +++ b/tests/place.test @@ -5,7 +5,7 @@ # Copyright (c) 1998-1999 by Scriptics Corporation. # All rights reserved. # -# RCS: @(#) $Id: place.test,v 1.3 1999/04/16 01:51:40 stanton Exp $ +# RCS: @(#) $Id: place.test,v 1.4 2000/08/08 19:21:20 ericm Exp $ if {[lsearch [namespace children] ::tcltest] == -1} { source [file join [pwd] [file dirname [info script]] defs.tcl] @@ -216,21 +216,88 @@ test place-8.2 {MasterStructureProc, mapping and unmapping slaves} { lappend result [winfo ismapped .t.f2] } {1 0 42 32 0 1} +test place-9.1 {PlaceObjCmd} { + list [catch {place} msg] $msg +} [list 1 "wrong # args: should be \"place option|pathName args\""] +test place-9.2 {PlaceObjCmd} { + list [catch {place foo} msg] $msg +} [list 1 "wrong # args: should be \"place option|pathName args\""] +test place-9.3 {PlaceObjCmd} { + catch {destroy .foo} + list [catch {place .foo bar} msg] $msg +} [list 1 "bad window path name \".foo\""] +test place-9.4 {PlaceObjCmd} { + catch {destroy .foo} + list [catch {place bar .foo} msg] $msg +} [list 1 "bad window path name \".foo\""] +test place-9.5 {PlaceObjCmd} { + catch {destroy .foo} + frame .foo + set res [list [catch {place badopt .foo} msg] $msg] + destroy .foo + set res +} [list 1 "bad option \"badopt\": must be configure, forget, info, or slaves"] +test place-9.6 {PlaceObjCmd, configure errors} { + catch {destroy .foo} + frame .foo + set res [list [catch {place configure .foo} msg] $msg] + destroy .foo + set res +} [list 1 "wrong # args: should be \"place configure pathName option value ?option value ...?\""] +test place-9.7 {PlaceObjCmd, configure errors} { + catch {destroy .foo} + frame .foo + set res [list [catch {place configure .foo bar} msg] $msg] + destroy .foo + set res +} [list 1 "wrong # args: should be \"place configure pathName option value ?option value ...?\""] +test place-9.8 {PlaceObjCmd, forget errors} { + catch {destroy .foo} + frame .foo + set res [list [catch {place forget .foo bar} msg] $msg] + destroy .foo + set res +} [list 1 "wrong # args: should be \"place forget pathName\""] +test place-9.9 {PlaceObjCmd, info errors} { + catch {destroy .foo} + frame .foo + set res [list [catch {place info .foo bar} msg] $msg] + destroy .foo + set res +} [list 1 "wrong # args: should be \"place info pathName\""] +test place-9.10 {PlaceObjCmd, slaves errors} { + catch {destroy .foo} + frame .foo + set res [list [catch {place slaves .foo bar} msg] $msg] + destroy .foo + set res +} [list 1 "wrong # args: should be \"place slaves pathName\""] + +test place-10.1 {ConfigureSlave} { + catch {destroy .foo} + frame .foo + set res [list [catch {place .foo -badopt} msg] $msg] + destroy .foo + set res +} [list 1 "bad option \"-badopt\": must be -anchor, -bordermode, -height, -in, -relheight, -relwidth, -relx, -rely, -width, -x, or -y"] +test place-10.2 {ConfigureSlave} { + catch {destroy .foo} + frame .foo + set res [list [catch {place .foo -anchor} msg] $msg] + destroy .foo + set res +} [list 1 "value missing for option \"-anchor\""] +test place-10.3 {ConfigureSlave} { + catch {destroy .foo} + frame .foo + set res [list [catch {place .foo -bordermode j} msg] $msg] + destroy .foo + set res +} [list 1 "bad border mode \"j\": must be ignore, inside, or outside"] + + catch {destroy .t} # cleanup ::tcltest::cleanupTests return - - - - - - - - - - - - - |