summaryrefslogtreecommitdiffstats
path: root/tests
diff options
context:
space:
mode:
Diffstat (limited to 'tests')
-rw-r--r--tests/safe.test6
-rw-r--r--tests/text.test10
-rw-r--r--tests/textWind.test12
-rw-r--r--tests/winDialog.test17
-rw-r--r--tests/winWm.test42
5 files changed, 48 insertions, 39 deletions
diff --git a/tests/safe.test b/tests/safe.test
index fded018..bbfd095 100644
--- a/tests/safe.test
+++ b/tests/safe.test
@@ -6,7 +6,7 @@
# Copyright (c) 1998-1999 by Scriptics Corporation.
# All rights reserved.
#
-# RCS: @(#) $Id: safe.test,v 1.15 2004/12/06 22:54:12 dgp Exp $
+# RCS: @(#) $Id: safe.test,v 1.16 2006/10/17 10:21:50 patthoyts Exp $
package require tcltest 2.1
eval tcltest::configure $argv
@@ -34,8 +34,8 @@ tcltest::loadTestedCommands
# The set of hidden commands is platform dependent:
-if {"$tcl_platform(platform)" == "windows"} {
- set hidden_cmds {bell cd clipboard encoding exec exit fconfigure file glob grab load menu open pwd selection send socket source tk_chooseColor tk_chooseDirectory tk_getOpenFile tk_getSaveFile tk_messageBox toplevel wm}
+if {[string equal $tcl_platform(platform) "windows"]} {
+ set hidden_cmds {bell cd clipboard encoding exec exit fconfigure file glob grab load menu open pwd selection socket source tk_chooseColor tk_chooseDirectory tk_getOpenFile tk_getSaveFile tk_messageBox toplevel wm}
} else {
set hidden_cmds {bell cd clipboard encoding exec exit fconfigure file glob grab load menu open pwd selection send socket source toplevel wm}
}
diff --git a/tests/text.test b/tests/text.test
index b4e3954..e115d43 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.45 2006/08/18 10:49:34 dkf Exp $
+# RCS: @(#) $Id: text.test,v 1.46 2006/10/17 10:21:50 patthoyts Exp $
package require tcltest 2.1
eval tcltest::configure $argv
@@ -3068,10 +3068,12 @@ test text-25.13 {-maxundo configuration option} {
test text-25.15 {bug fix 1536735 - undo with empty text} {
catch {destroy .t}
text .t -undo 1
+ set r [.t edit modified]
.t delete 1.0
- .t edit undo
- .t edit modified
-} {0}
+ lappend r [.t edit modified]
+ lappend r [catch {.t edit undo}]
+ lappend r [.t edit modified]
+} {0 0 1 0}
test text-26.1 {bug fix - 624372, ControlUtfProc long lines} {
destroy .t
diff --git a/tests/textWind.test b/tests/textWind.test
index 1044cfe..b6739c2 100644
--- a/tests/textWind.test
+++ b/tests/textWind.test
@@ -6,7 +6,7 @@
# Copyright (c) 1998-1999 by Scriptics Corporation.
# All rights reserved.
#
-# RCS: @(#) $Id: textWind.test,v 1.21 2006/04/05 20:57:08 hobbs Exp $
+# RCS: @(#) $Id: textWind.test,v 1.22 2006/10/17 10:21:50 patthoyts Exp $
package require tcltest 2.1
eval tcltest::configure $argv
@@ -446,11 +446,13 @@ test textWind-10.4 {EmbWinLayoutProc procedure, error in creating window} {textf
.t delete 1.0 end
.t insert 1.0 "Some sample text"
catch {destroy .t.f}
- .t window create 1.5 -create {
- frame .t.f
- frame .t.f.f -width 10 -height 20 -bg $color
- }
set msg {}
+ after idle {
+ .t window create 1.5 -create {
+ frame .t.f
+ frame .t.f.f -width 10 -height 20 -bg $color
+ }
+ }
set count 0
while {([llength $msg] < 2) && ($count < 100)} {
update ; incr count; .t bbox 1.5 ; after 10
diff --git a/tests/winDialog.test b/tests/winDialog.test
index c89ff27..38f125b 100644
--- a/tests/winDialog.test
+++ b/tests/winDialog.test
@@ -6,7 +6,7 @@
# Copyright (c) 1998-1999 by Scriptics Corporation.
# Copyright (c) 1998-1999 ActiveState Corporation.
#
-# RCS: @(#) $Id: winDialog.test,v 1.12 2004/12/20 10:34:20 vincentdarley Exp $
+# RCS: @(#) $Id: winDialog.test,v 1.13 2006/10/17 10:21:50 patthoyts Exp $
package require tcltest 2.1
eval tcltest::configure $argv
@@ -171,18 +171,17 @@ test winDialog-5.15 {GetFileName: initial file: Tcl_TranslateFileName()} {nt} {
# if (Tcl_TranslateFileName(interp, string, &ds) == NULL)
list [catch {tk_getOpenFile -initialfile ~12x/455} msg] $msg
} {1 {user "12x" doesn't exist}}
-set a aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa
-append a $a
-append a $a
-append a $a
-append a $a
test winDialog-5.16 {GetFileName: initial file: long name} {nt testwinevent} {
- start {set x [tk_getSaveFile -initialfile $a -title Long]}
+ start {
+ set dialogresult [catch {
+ tk_getSaveFile -initialfile [string repeat a 1024] -title Long
+ } x]
+ }
then {
Click 1
}
- string totitle $x
-} [string totitle [string range [file join [pwd] $a] 0 257]]
+ list $dialogresult [string match "invalid filename *" $x]
+} {1 1}
test winDialog-5.17 {GetFileName: parent} {nt} {
# case FILE_PARENT:
diff --git a/tests/winWm.test b/tests/winWm.test
index 95b71cb..e3b0d84 100644
--- a/tests/winWm.test
+++ b/tests/winWm.test
@@ -9,7 +9,7 @@
# Copyright (c) 1998-1999 by Scriptics Corporation.
# All rights reserved.
#
-# RCS: @(#) $Id: winWm.test,v 1.16 2005/02/17 00:06:08 mdejong Exp $
+# RCS: @(#) $Id: winWm.test,v 1.17 2006/10/17 10:21:50 patthoyts Exp $
package require tcltest 2.1
eval tcltest::configure $argv
@@ -22,14 +22,14 @@ frame .t.f -width 100 -height 50
pack .t.f
menu .t.m
.t.m add command -label "thisisreallylong"
-.t conf -menu .t.m
-wm geom .t -0-0
+.t configure -menu .t.m
+wm geometry .t -0-0
update
set menuheight [winfo y .t]
.t.m add command -label "thisisreallylong"
-wm geom .t -0-0
+wm geometry .t -0-0
update
-set menuheight [expr $menuheight - [winfo y .t]]
+set menuheight [expr {$menuheight - [winfo y .t]}]
destroy .t
test winWm-1.1 {TkWmMapWindow} win {
@@ -58,7 +58,7 @@ test winWm-1.3 {TkWmMapWindow} win {
update
toplevel .t2
update
- set result [expr [winfo x .t] != [winfo x .t2]]
+ set result [expr {[winfo x .t] != [winfo x .t2]}]
destroy .t .t2
set result
} 1
@@ -163,7 +163,7 @@ test winWm-3.1 {ConfigureTopLevel: window geometry propagation} win {
update
pack .t.b
update
- set x [expr $x == [winfo x .t.b]]
+ set x [expr {$x == [winfo x .t.b]}]
destroy .t
set x
} 1
@@ -171,30 +171,35 @@ test winWm-3.1 {ConfigureTopLevel: window geometry propagation} win {
test winWm-4.1 {ConfigureTopLevel: menu resizing} win {
set result {}
toplevel .t
- frame .t.f -width 150 -height 50 -bg red
+ frame .t.f -width 150 -height 50 -background red
pack .t.f
wm geometry .t -0-0
update
set y [winfo y .t]
menu .t.m
.t.m add command -label foo
- .t conf -menu .t.m
+ .t configure -menu .t.m
update
- set result [expr $y - [winfo y .t]]
+ set result [expr {$y - [winfo y .t]}]
destroy .t
set result
-} [expr $menuheight + 1]
+} [expr {$menuheight + 1}]
+# This test works on 8.0p2 but has not worked on anything since 8.2.
+# It would be very strange to have a windows application increase the size
+# of the clientarea when a menu wraps so I believe this test to be wrong.
+# Original result was {50 50 50} new result may depend on the default menu
+# font
test winWm-5.1 {UpdateGeometryInfo: menu resizing} win {
set result {}
toplevel .t
- frame .t.f -width 150 -height 50 -bg red
+ frame .t.f -width 150 -height 50 -background red
pack .t.f
update
set result [winfo height .t]
menu .t.m
.t.m add command -label foo
- .t conf -menu .t.m
+ .t configure -menu .t.m
update
lappend result [winfo height .t]
.t.m add command -label "thisisreallylong"
@@ -202,25 +207,26 @@ test winWm-5.1 {UpdateGeometryInfo: menu resizing} win {
update
lappend result [winfo height .t]
destroy .t
+
set result
-} {50 50 50}
+} {50 50 31}
test winWm-5.2 {UpdateGeometryInfo: menu resizing} win {
set result {}
toplevel .t
- frame .t.f -width 150 -height 50 -bg red
+ frame .t.f -width 150 -height 50 -background red
pack .t.f
- wm geom .t -0-0
+ wm geometry .t -0-0
update
set y [winfo rooty .t]
lappend result [winfo height .t]
menu .t.m
- .t conf -menu .t.m
+ .t configure -menu .t.m
.t.m add command -label foo
.t.m add command -label "thisisreallylong"
.t.m add command -label "thisisreallylong"
update
lappend result [winfo height .t]
- lappend result [expr $y - [winfo rooty .t]]
+ lappend result [expr {$y - [winfo rooty .t]}]
destroy .t
set result
} {50 50 0}