summaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authorhobbs <hobbs>1999-12-21 23:55:54 (GMT)
committerhobbs <hobbs>1999-12-21 23:55:54 (GMT)
commitfdba0d6552ccb3b13cdb2b5f6ba531ebff096158 (patch)
treee0dc08286acce565bfa08ed69a213e879e5ed938
parentc825211c4960e2bda75e66a19f82c29cf2920e76 (diff)
downloadtk-fdba0d6552ccb3b13cdb2b5f6ba531ebff096158.zip
tk-fdba0d6552ccb3b13cdb2b5f6ba531ebff096158.tar.gz
tk-fdba0d6552ccb3b13cdb2b5f6ba531ebff096158.tar.bz2
* scale.test:
* generic/tkScale.c: * generic/tkScale.h: fixed possible core when freeing options (cursor) associated with scale widget [Bug: 3897]
-rw-r--r--tests/entry.test22
-rw-r--r--tests/scale.test21
2 files changed, 11 insertions, 32 deletions
diff --git a/tests/entry.test b/tests/entry.test
index 387a69d..bb0c19c 100644
--- a/tests/entry.test
+++ b/tests/entry.test
@@ -6,7 +6,7 @@
# Copyright (c) 1998-1999 by Scriptics Corporation.
# All rights reserved.
#
-# RCS: @(#) $Id: entry.test,v 1.4 1999/12/14 06:53:13 hobbs Exp $
+# RCS: @(#) $Id: entry.test,v 1.5 1999/12/21 23:55:54 hobbs Exp $
if {[lsearch [namespace children] ::tcltest] == -1} {
source [file join [pwd] [file dirname [info script]] defs.tcl]
@@ -1330,19 +1330,18 @@ test entry-17.3 {EntryUpdateScrollbar procedure} {
} {0.315789 0.842105}
test entry-17.4 {EntryUpdateScrollbar procedure} {
catch {destroy .e}
- catch {rename bogus {}}
proc bgerror msg {
global x
set x $msg
}
- entry .e -width 5 -xscrollcommand bogus
+ entry .e -width 5 -xscrollcommand thisisnotacommand
pack .e
update
rename bgerror {}
list $x $errorInfo
-} {{invalid command name "bogus"} {invalid command name "bogus"
+} {{invalid command name "thisisnotacommand"} {invalid command name "thisisnotacommand"
while executing
-"bogus 0 1"
+"thisisnotacommand 0 1"
(horizontal scrolling command executed by entry)}}
set l [interp hidden]
@@ -1364,16 +1363,3 @@ option clear
# cleanup
::tcltest::cleanupTests
return
-
-
-
-
-
-
-
-
-
-
-
-
-
diff --git a/tests/scale.test b/tests/scale.test
index 6926a9b..8db85ac 100644
--- a/tests/scale.test
+++ b/tests/scale.test
@@ -6,7 +6,7 @@
# Copyright (c) 1998-1999 by Scriptics Corporation.
# All rights reserved.
#
-# RCS: @(#) $Id: scale.test,v 1.8 1999/12/14 06:53:14 hobbs Exp $
+# RCS: @(#) $Id: scale.test,v 1.9 1999/12/21 23:55:55 hobbs Exp $
if {[lsearch [namespace children] ::tcltest] == -1} {
source [file join [pwd] [file dirname [info script]] defs.tcl]
@@ -810,22 +810,15 @@ test scale-17.1 {bug fix 1786} {
set x
} {}
+test scale-18.1 {DestroyScale, -cursor option [Bug: 3897]} {
+ catch {destroy .s}
+ scale .s -cursor trek
+ destroy .s
+} {}
+
catch {destroy .s}
option clear
# cleanup
::tcltest::cleanupTests
return
-
-
-
-
-
-
-
-
-
-
-
-
-