From fdba0d6552ccb3b13cdb2b5f6ba531ebff096158 Mon Sep 17 00:00:00 2001
From: hobbs <hobbs>
Date: Tue, 21 Dec 1999 23:55:54 +0000
Subject: 	* scale.test: 	* generic/tkScale.c: 	* generic/tkScale.h:
 fixed possible core when freeing options 	(cursor) associated with scale
 widget [Bug: 3897]

---
 tests/entry.test | 22 ++++------------------
 tests/scale.test | 21 +++++++--------------
 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
-
-
-
-
-
-
-
-
-
-
-
-
-
-- 
cgit v0.12