diff options
Diffstat (limited to 'tests')
| -rw-r--r-- | tests/button.test | 7 | ||||
| -rw-r--r-- | tests/canvas.test | 14 | ||||
| -rw-r--r-- | tests/focus.test | 3 | ||||
| -rw-r--r-- | tests/menu.test | 29 | ||||
| -rw-r--r-- | tests/text.test | 57 |
5 files changed, 85 insertions, 25 deletions
diff --git a/tests/button.test b/tests/button.test index 58932bb..8ee8860 100644 --- a/tests/button.test +++ b/tests/button.test @@ -7,7 +7,7 @@ # Copyright (c) 1998-1999 by Scriptics Corporation. # All rights reserved. # -# RCS: @(#) $Id: button.test,v 1.5 2000/03/08 03:19:31 ericm Exp $ +# RCS: @(#) $Id: button.test,v 1.5.2.1 2000/08/05 23:53:13 hobbs Exp $ if {[lsearch [namespace children] ::tcltest] == -1} { source [file join [pwd] [file dirname [info script]] defs.tcl] @@ -51,9 +51,9 @@ update set i 1 foreach test { {-activebackground #012345 #012345 non-existent - {unknown color name "non-existent"} {0 1 1 1}} + {unknown color name "non-existent"} {1 1 1 1}} {-activeforeground #ff0000 #ff0000 non-existent - {unknown color name "non-existent"} {0 1 1 1}} + {unknown color name "non-existent"} {1 1 1 1}} {-anchor nw nw bogus {bad anchor "bogus": must be n, ne, e, se, s, sw, w, nw, or center} {1 1 1 1}} {-background #ff0000 #ff0000 non-existent {unknown color name "non-existent"} {1 1 1 1}} @@ -126,7 +126,6 @@ foreach test { test button-1.$i {configuration options} { .c configure -selectcolor {} } {} -incr i test button-3.1 {ButtonCreate - not enough cd ../unix } { diff --git a/tests/canvas.test b/tests/canvas.test index 86da456..df4d524 100644 --- a/tests/canvas.test +++ b/tests/canvas.test @@ -3,10 +3,10 @@ # standard fashion for Tcl tests. # # Copyright (c) 1995-1996 Sun Microsystems, Inc. -# Copyright (c) 1998-1999 by Scriptics Corporation. +# Copyright (c) 1998-2000 Ajuba Solutions. # All rights reserved. # -# RCS: @(#) $Id: canvas.test,v 1.8 2000/03/29 00:09:06 ericm Exp $ +# RCS: @(#) $Id: canvas.test,v 1.8.2.1 2000/08/05 23:53:14 hobbs Exp $ if {[lsearch [namespace children] ::tcltest] == -1} { source [file join [pwd] [file dirname [info script]] defs.tcl] @@ -319,7 +319,7 @@ test canvas-10.7 {check errors from tag expressions} { canvas .c .c create oval 20 20 40 40 -fill red -tag [list a b c d] .c create oval 20 260 40 280 -fill bisque -tag [list d "tag with spaces"] - catch {.c find withtag {d&&"tag with spaces}} err + catch {.c find withtag "d&&\"tag with spaces"} err set err } {Missing endquote in tag search expression} test canvas-10.8 {check errors from tag expressions} { @@ -359,6 +359,14 @@ test canvas-10.12 {multple events bound to same tag expr} { .c bind {a && b} <Leave> {puts Leave} } {} +test canvas-11.1 {canvas poly fill check, bug 5783} { + # This would crash in 8.3.0 and 8.3.1 + destroy .c + pack [canvas .c] + .c create polygon 0 0 100 100 200 50 \ + -fill {} -stipple gray50 -outline black +} 1 + # cleanup ::tcltest::cleanupTests return diff --git a/tests/focus.test b/tests/focus.test index e8f850a..de6eda3 100644 --- a/tests/focus.test +++ b/tests/focus.test @@ -6,7 +6,7 @@ # Copyright (c) 1998-1999 by Scriptics Corporation. # All rights reserved. # -# RCS: @(#) $Id: focus.test,v 1.5 1999/04/16 01:51:37 stanton Exp $ +# RCS: @(#) $Id: focus.test,v 1.5.12.1 2000/08/05 23:53:14 hobbs Exp $ if {[lsearch [namespace children] ::tcltest] == -1} { source [file join [pwd] [file dirname [info script]] defs.tcl] @@ -33,7 +33,6 @@ proc focusSetupAlt {} { global env catch {destroy .alt} toplevel .alt -screen $env(TK_ALT_DISPLAY) - wm withdraw .alt foreach i {a b c d} { button .alt.$i -text .alt.$i -relief raised -bd 2 pack .alt.$i diff --git a/tests/menu.test b/tests/menu.test index 7b8ba02..e04ef3e 100644 --- a/tests/menu.test +++ b/tests/menu.test @@ -5,7 +5,7 @@ # Copyright (c) 1998-1999 by Scriptics Corporation. # All rights reserved. # -# RCS: @(#) $Id: menu.test,v 1.3 1999/04/16 01:51:39 stanton Exp $ +# RCS: @(#) $Id: menu.test,v 1.3.12.1 2000/08/05 23:53:14 hobbs Exp $ if {[lsearch [namespace children] ::tcltest] == -1} { source [file join [pwd] [file dirname [info script]] defs.tcl] @@ -2438,20 +2438,21 @@ test menu-33.1 {menu vs command hiding} { # menu-34 MenuInit only called at boot time +# creating menus on two different screens then deleting the +# menu from the first screen crashes Tk8.3.1 +# +test menu-35.1 {menus on multiple screens - crashes tk8.3.1, Bug 5454} { + if {[info exists ::env(TK_ALT_DISPLAY)]} { + toplevel .one + menu .one.m + toplevel .two -screen $::env(TK_ALT_DISPLAY) + menu .two.m + destroy .one + destroy .two + } +} {} + # cleanup deleteWindows ::tcltest::cleanupTests return - - - - - - - - - - - - - diff --git a/tests/text.test b/tests/text.test index 651e7d8..e23b67e 100644 --- a/tests/text.test +++ b/tests/text.test @@ -6,7 +6,7 @@ # Copyright (c) 1998-1999 by Scriptics Corporation. # All rights reserved. # -# RCS: @(#) $Id: text.test,v 1.10 2000/02/03 17:29:58 ericm Exp $ +# RCS: @(#) $Id: text.test,v 1.10.2.1 2000/08/05 23:53:15 hobbs Exp $ if {[lsearch [namespace children] ::tcltest] == -1} { source [file join [pwd] [file dirname [info script]] defs.tcl] @@ -1110,7 +1110,60 @@ test text-20.65 {TextSearchCmd, unicode with non-text segments} { set result } {1.3 3} - +test text-20.66 {TextSearchCmd, hidden text does not affect match index} { + eval destroy [winfo child .] + pack [text .t2] + .t2 insert end "12345H7890" + .t2 search 7 1.0 +} 1.6 +test text-20.67 {TextSearchCmd, hidden text does not affect match index} { + eval destroy [winfo child .] + pack [text .t2] + .t2 insert end "12345H7890" + .t2 tag configure hidden -elide true + .t2 tag add hidden 1.5 + .t2 search 7 1.0 +} 1.6 +test text-20.68 {TextSearchCmd, hidden text does not affect match index} { + eval destroy [winfo child .] + pack [text .t2] + .t2 insert end "foobar\nbarbaz\nbazboo" + .t2 search boo 1.0 +} 3.3 +test text-20.69 {TextSearchCmd, hidden text does not affect match index} { + eval destroy [winfo child .] + pack [text .t2] + .t2 insert end "foobar\nbarbaz\nbazboo" + .t2 tag configure hidden -elide true + .t2 tag add hidden 2.0 3.0 + .t2 search boo 1.0 +} 3.3 + +test text-20.70 {TextSearchCmd, -regexp -nocase searches} { + catch {destroy .t} + pack [text .t] + .t insert end "word1 word2" + set res [.t search -nocase -regexp {\mword.} 1.0 end] + destroy .t + set res +} 1.0 +test text-20.71 {TextSearchCmd, -regexp -nocase searches} { + catch {destroy .t} + pack [text .t] + .t insert end "word1 word2" + set res [.t search -nocase -regexp {word.\M} 1.0 end] + destroy .t + set res +} 1.0 +test text-20.72 {TextSearchCmd, -regexp -nocase searches} { + catch {destroy .t} + pack [text .t] + .t insert end "word1 word2" + set res [.t search -nocase -regexp {word.\W} 1.0 end] + destroy .t + set res +} 1.0 + eval destroy [winfo child .] text .t2 -highlightthickness 0 -bd 0 -relief flat -padx 0 -width 100 pack .t2 |