head	1.17;
access;
symbols
	core-8-5-9:1.15
	core-8-5-8:1.15
	macosx-cocoa-merge:1.17
	macosx-cocoa-premerge:1.17
	macosx-carbon-freeze:1.17
	core-8-5-7:1.15
	core-8-5-6:1.15
	core-8-6-b1:1.17
	core-8-6-a3:1.17
	core-8-5-5:1.15
	core-8-6-a2:1.16
	core-8-5-4:1.15
	core-8-5-3:1.15
	core-8-6-a1:1.15
	core-8-4-19:1.12.2.1
	core-8-5-branch:1.15.0.4
	core-8-5-2:1.15
	core-8-4-18:1.12.2.1
	core-8-5-1:1.15
	core-8-4-17:1.12.2.1
	core-8-5-0:1.15
	core-8-5-b3:1.15
	core-8-5-b2:1.15
	core-8-4-16:1.12.2.1
	core-8-5-b1:1.15
	core-stablilizer-merge:1.15
	core-stabilizer-branch:1.15.0.2
	core-stabilizer-merge:1.15
	core-8-4-15:1.12.2.1
	core-8-5-a6:1.15
	core-8-5-a5:1.15
	core-8-4-14:1.12.2.1
	core-8-5-a4:1.15
	core-8-4-13:1.12.2.1
	core-8-4-12:1.12.2.1
	core-8-4-11:1.12.2.1
	core-8-5-a3:1.15
	core-8-4-10:1.12.2.1
	core-8-4-9-branch:1.12.2.1.0.2
	core-8-5-a2:1.15
	core-8-4-9:1.12.2.1
	core-8-4-8:1.12.2.1
	core-8-4-7:1.12.2.1
	core-8-5-a1:1.14
	core-8-4-6:1.12.2.1
	core-8-4-5:1.12.2.1
	mistachkin-dev-branch:1.14.0.2
	core-8-4-4:1.12
	core-8-4-3:1.12
	core-8-4-branch:1.12.0.2
	core-8-4-2:1.12
	core-8-4-1:1.12
	core-8-3-5:1.10
	core-8-4-0:1.12
	macosx-8-4-merge-2002-08-31-trunk:1.12
	macosx-8-4-premerge-2002-08-31-branch:1.10.8.1
	macosx-8-4-premerge-2002-08-31-trunk:1.12
	macosx-8-4-merge-2002-08-30-branch:1.10.8.1
	macosx-8-4-merge-2002-08-30-trunk:1.12
	macosx-8-4-merge-2002-08-20-branch:1.10.8.1
	macosx-8-4-merge-2002-08-20-trunk:1.12
	core-8-4-b2:1.12
	core-8-4-b1:1.10
	macosx-premerge-6-9-02:1.10
	core-8-4-a4:1.10
	core-8-3-4:1.10
	macosx-8-4-branch:1.10.0.8
	macosx-8-4-branchpoint:1.10
	core-8-4-a3:1.10
	core-8-3-3:1.10
	dgp-privates-into-namespace:1.10.0.6
	tclpro-1-5-0:1.10
	core-8-4-win-speedup:1.10.0.4
	core-8-4-a2:1.10
	tclpro-1-4-1:1.10
	tclpro-1-4-0:1.10
	core-8-3-2:1.10
	ajuba-ajuba2-2-1-base:1.10
	ajuba-ajuba2-2-0:1.10
	core-8-4-a1:1.10
	core-8-3-1-branch:1.10.0.2
	core-8-3-1:1.10
	scriptics-sc-2-0-b5:1.9
	scriptics-sc-2-0-fixed:1.9
	scriptics-sc-2-0-b2:1.9
	scriptics-sc-2-0-b1:1.9
	core-8-3-0:1.9
	core-8-3-b2:1.9
	core-8-3-b1:1.9
	scriptics-sc-1-1:1.7
	scriptics-sc-1-1-b1:1.7
	core-8-2-3:1.7
	scriptics-sc-1-1-branch:1.7.0.10
	scriptics-sc-1-1-base:1.7
	scriptics-sc-1-0:1.7
	scriptics-sc-1-0-branch:1.7.0.8
	scriptics-sc-1-0-base:1.7
	core-8-2-2:1.7
	core-8-2-1:1.7
	scriptics-bc-1-0-b1:1.7
	core-8-2-1-branch:1.7.0.6
	scriptics-tclpro-1-3-0:1.7
	core-8-2-0:1.7
	core-8-2-b3-branch:1.7.0.2
	core-8-2-b3-base:1.7
	scriptics-tclpro-1-3-b4:1.7
	core-8-2-b2:1.7
	scriptics-tclpro-1-3-b3:1.7
	core-8-2-b1:1.7
	scriptics-tclpro-1-3-b2:1.7
	merge-to-mainline-5/21/99:1.7
	scriptics-tclpro-1-3-b2-branch:1.7.0.4
	core-8-1-1:1.7
	scriptics-tclpro-1-3-b1:1.7
	core-8-1-1-base:1.7
	core-8-1-0:1.7
	merge-to-mainline-4-29-99:1.7
	merge-to-mainline-4-23-99:1.7
	core-8-1-branch-old:1.1.0.4
	core-8-0-6-branch:1.3.0.6
	core-8-0-6-base:1.3
	core-8-0-5:1.3
	core-8-1-b3:1.1.4.7
	core-8-1-b2:1.1.4.5
	dev-8-1-stubs-branch:1.1.4.4.0.2
	dev-stubs-branch:1.3.0.4
	scriptics-tclpro-1-2:1.3
	scriptics-tclpro-1-2-b2:1.3
	core-8-1-merge-2/10/99:1.3
	core-8-0-5-branch:1.3.0.2
	core-8-0-5-base:1.3
	scriptics-tclpro-1-2-b1:1.3
	scriptics-tclpro-1-2-a1:1.3
	core-8-1-b1:1.1.4.3
	core-8-0-4:1.3
	core-8-1-a2:1.1.4.1
	core-8-0-2:1.1
	core-8-0-3:1.2;
locks; strict;
comment	@# @;


1.17
date	2008.08.28.08.52.05;	author aniap;	state Exp;
branches;
next	1.16;

1.16
date	2008.07.23.23.24.24;	author nijtmans;	state Exp;
branches;
next	1.15;

1.15
date	2004.05.23.17.34.49;	author dkf;	state Exp;
branches;
next	1.14;

1.14
date	2003.08.13.10.28.21;	author patthoyts;	state Exp;
branches;
next	1.13;

1.13
date	2003.04.01.21.06.50;	author dgp;	state Exp;
branches;
next	1.12;

1.12
date	2002.07.13.20.28.35;	author dgp;	state Exp;
branches
	1.12.2.1;
next	1.11;

1.11
date	2002.07.13.00.30.25;	author dgp;	state Exp;
branches;
next	1.10;

1.10
date	2000.04.14.08.34.28;	author hobbs;	state Exp;
branches
	1.10.8.1;
next	1.9;

1.9
date	99.12.21.23.55.55;	author hobbs;	state Exp;
branches;
next	1.8;

1.8
date	99.12.14.06.53.14;	author hobbs;	state Exp;
branches;
next	1.7;

1.7
date	99.04.21.21.53.30;	author rjohnson;	state Exp;
branches;
next	1.6;

1.6
date	99.04.20.01.04.04;	author rjohnson;	state Exp;
branches;
next	1.5;

1.5
date	99.04.19.23.54.57;	author hershey;	state Exp;
branches;
next	1.4;

1.4
date	99.04.16.01.51.40;	author stanton;	state Exp;
branches
	1.4.2.1;
next	1.3;

1.3
date	98.11.03.02.06.43;	author stanton;	state Exp;
branches;
next	1.2;

1.2
date	98.09.14.18.23.49;	author stanton;	state Exp;
branches;
next	1.1;

1.1
date	98.04.01.09.58.15;	author rjohnson;	state Exp;
branches
	1.1.4.1;
next	;

1.1.4.1
date	98.09.29.00.25.52;	author stanton;	state Exp;
branches;
next	1.1.4.2;

1.1.4.2
date	98.09.30.02.18.53;	author stanton;	state Exp;
branches;
next	1.1.4.3;

1.1.4.3
date	98.11.25.21.16.40;	author stanton;	state Exp;
branches;
next	1.1.4.4;

1.1.4.4
date	99.02.16.11.39.35;	author lfb;	state Exp;
branches;
next	1.1.4.5;

1.1.4.5
date	99.03.11.18.51.06;	author hershey;	state Exp;
branches;
next	1.1.4.6;

1.1.4.6
date	99.03.24.01.17.03;	author hershey;	state Exp;
branches;
next	1.1.4.7;

1.1.4.7
date	99.03.24.02.54.58;	author hershey;	state Exp;
branches;
next	;

1.4.2.1
date	99.04.21.02.31.09;	author rjohnson;	state Exp;
branches;
next	;

1.10.8.1
date	2002.08.20.20.27.15;	author das;	state Exp;
branches;
next	;

1.12.2.1
date	2003.08.13.10.59.33;	author patthoyts;	state Exp;
branches;
next	;


desc
@@


1.17
log
@Update to tcltest2
@
text
@# This file is a Tcl script to test out the "scale" command
# of Tk.  It is organized in the standard fashion for Tcl tests.
#
# Copyright (c) 1994 The Regents of the University of California.
# Copyright (c) 1994-1996 Sun Microsystems, Inc.
# Copyright (c) 1998-1999 by Scriptics Corporation.
# All rights reserved.
#
# RCS: @@(#) $Id: scale.test,v 1.16 2008/07/23 23:24:24 nijtmans Exp $

package require tcltest 2.2
namespace import ::tcltest::*
eval tcltest::configure $argv
tcltest::loadTestedCommands

# Create entries in the option database to be sure that geometry options
# like border width have predictable values.

option add *Scale.borderWidth 2
option add *Scale.highlightThickness 2
option add *Scale.font {Helvetica -12 bold}

# Widget used in 1.* tests
scale .s -from 100 -to 300
pack .s
update

test scale-1.1 {configuration options} -body {
    .s configure -activebackground #ff0000
    .s cget -activebackground
} -cleanup {
    .s configure -activebackground [lindex [.s configure -activebackground] 3]
} -result {#ff0000}
test scale-1.2 {configuration options} -body {
        .s configure -activebackground non-existent
} -returnCodes error -result {unknown color name "non-existent"}
test scale-1.3 {configuration options} -body {
    .s configure -background #ff0000
    .s cget -background
} -cleanup {
    .s configure -background [lindex [.s configure -background] 3]
} -result {#ff0000}
test scale-1.4 {configuration options} -body {
        .s configure -background non-existent
} -returnCodes error -result {unknown color name "non-existent"}
test scale-1.5 {configuration options} -body {
    .s configure -bd 4
    .s cget -bd
} -cleanup {
    .s configure -bd [lindex [.s configure -bd] 3]
} -result {4}
test scale-1.6 {configuration options} -body {
        .s configure -bd badValue
} -returnCodes error -result {bad screen distance "badValue"}
test scale-1.7 {configuration options} -body {
    .s configure -bigincrement 12.5
    .s cget -bigincrement
} -cleanup {
    .s configure -bigincrement [lindex [.s configure -bigincrement] 3]
} -result {12.5}
test scale-1.8 {configuration options} -body {
        .s configure -bigincrement badValue
} -returnCodes error -result {expected floating-point number but got "badValue"}
test scale-1.9 {configuration options} -body {
    .s configure -bg #ff0000
    .s cget -bg
} -cleanup {
    .s configure -bg [lindex [.s configure -bg] 3]
} -result {#ff0000}
test scale-1.10 {configuration options} -body {
        .s configure -bg non-existent
} -returnCodes error -result {unknown color name "non-existent"}
test scale-1.11 {configuration options} -body {
    .s configure -borderwidth 1.3
    .s cget -borderwidth
} -cleanup {
    .s configure -borderwidth [lindex [.s configure -borderwidth] 3]
} -result {1}
test scale-1.12 {configuration options} -body {
        .s configure -borderwidth badValue
} -returnCodes error -result {bad screen distance "badValue"}
test scale-1.13 {configuration options} -body {
    .s configure -command {set x}
    .s cget -command
} -cleanup {
    .s configure -command [lindex [.s configure -command] 3]
} -result {set x}
test scale-1.15 {configuration options} -body {
    .s configure -cursor arrow
    .s cget -cursor
} -cleanup {
    .s configure -cursor [lindex [.s configure -cursor] 3]
} -result {arrow}
test scale-1.16 {configuration options} -body {
        .s configure -cursor badValue
} -returnCodes error -result {bad cursor spec "badValue"}
test scale-1.17 {configuration options} -body {
    .s configure -digits 5
    .s cget -digits
} -cleanup {
    .s configure -digits [lindex [.s configure -digits] 3]
} -result {5}
test scale-1.18 {configuration options} -body {
        .s configure -digits badValue
} -returnCodes error -result {expected integer but got "badValue"}
test scale-1.19 {configuration options} -body {
    .s configure -fg #00ff00
    .s cget -fg
} -cleanup {
    .s configure -fg [lindex [.s configure -fg] 3]
} -result {#00ff00}
test scale-1.20 {configuration options} -body {
        .s configure -fg badValue
} -returnCodes error -result {unknown color name "badValue"}
test scale-1.21 {configuration options} -body {
    .s configure -font fixed
    .s cget -font
} -cleanup {
    .s configure -font [lindex [.s configure -font] 3]
} -result {fixed}
test scale-1.23 {configuration options} -body {
    .s configure -foreground green
    .s cget -foreground
} -cleanup {
    .s configure -foreground [lindex [.s configure -foreground] 3]
} -result {green}
test scale-1.24 {configuration options} -body {
        .s configure -foreground badValue
} -returnCodes error -result {unknown color name "badValue"}
test scale-1.25 {configuration options} -body {
    .s configure -from -15.0
    .s cget -from
} -cleanup {
    .s configure -from [lindex [.s configure -from] 3]
} -result {-15.0}
test scale-1.26 {configuration options} -body {
        .s configure -from badValue
} -returnCodes error -result {expected floating-point number but got "badValue"}
test scale-1.27 {configuration options} -body {
    .s configure -highlightbackground #112233
    .s cget -highlightbackground
} -cleanup {
    .s configure -highlightbackground [lindex [.s configure -highlightbackground] 3]
} -result {#112233}
test scale-1.28 {configuration options} -body {
        .s configure -highlightbackground ugly
} -returnCodes error -result {unknown color name "ugly"}
test scale-1.29 {configuration options} -body {
    .s configure -highlightcolor #123456
    .s cget -highlightcolor
} -cleanup {
    .s configure -highlightcolor [lindex [.s configure -highlightcolor] 3]
} -result {#123456}
test scale-1.30 {configuration options} -body {
        .s configure -highlightcolor non-existent
} -returnCodes error -result {unknown color name "non-existent"}
test scale-1.31 {configuration options} -body {
    .s configure -highlightthickness 2
    .s cget -highlightthickness
} -cleanup {
    .s configure -highlightthickness [lindex [.s configure -highlightthickness] 3]
} -result {2}
test scale-1.32 {configuration options} -body {
        .s configure -highlightthickness badValue
} -returnCodes error -result {bad screen distance "badValue"}
test scale-1.33 {configuration options} -body {
    .s configure -label {Some text}
    .s cget -label
} -cleanup {
    .s configure -label [lindex [.s configure -label] 3]
} -result {Some text}
test scale-1.35 {configuration options} -body {
    .s configure -length 130
    .s cget -length
} -cleanup {
    .s configure -length [lindex [.s configure -length] 3]
} -result {130}
test scale-1.36 {configuration options} -body {
        .s configure -length badValue
} -returnCodes error -result {bad screen distance "badValue"}
test scale-1.37 {configuration options} -body {
    .s configure -orient horizontal
    .s cget -orient
} -cleanup {
    .s configure -orient [lindex [.s configure -orient] 3]
} -result {horizontal}
test scale-1.38 {configuration options} -body {
        .s configure -orient badValue
} -returnCodes error -result {bad orient "badValue": must be horizontal or vertical}
test scale-1.39 {configuration options} -body {
    .s configure -orient horizontal
    .s cget -orient
} -cleanup {
    .s configure -orient [lindex [.s configure -orient] 3]
} -result {horizontal}
test scale-1.41 {configuration options} -body {
    .s configure -relief ridge
    .s cget -relief
} -cleanup {
    .s configure -relief [lindex [.s configure -relief] 3]
} -result {ridge}
test scale-1.42 {configuration options} -body {
        .s configure -relief badValue
} -returnCodes error -result {bad relief "badValue": must be flat, groove, raised, ridge, solid, or sunken}
test scale-1.43 {configuration options} -body {
    .s configure -repeatdelay 14
    .s cget -repeatdelay
} -cleanup {
    .s configure -repeatdelay [lindex [.s configure -repeatdelay] 3]
} -result {14}
test scale-1.44 {configuration options} -body {
        .s configure -repeatdelay bogus
} -returnCodes error -result {expected integer but got "bogus"}
test scale-1.45 {configuration options} -body {
    .s configure -repeatinterval 14
    .s cget -repeatinterval
} -cleanup {
    .s configure -repeatinterval [lindex [.s configure -repeatinterval] 3]
} -result {14}
test scale-1.46 {configuration options} -body {
        .s configure -repeatinterval bogus
} -returnCodes error -result {expected integer but got "bogus"}
test scale-1.47 {configuration options} -body {
    .s configure -resolution 2.0
    .s cget -resolution
} -cleanup {
    .s configure -resolution [lindex [.s configure -resolution] 3]
} -result {2.0}
test scale-1.48 {configuration options} -body {
        .s configure -resolution badValue
} -returnCodes error -result {expected floating-point number but got "badValue"}
test scale-1.49 {configuration options} -body {
    .s configure -showvalue 0
    .s cget -showvalue
} -cleanup {
    .s configure -showvalue [lindex [.s configure -showvalue] 3]
} -result {0}
test scale-1.50 {configuration options} -body {
        .s configure -showvalue badValue
} -returnCodes error -result {expected boolean value but got "badValue"}
test scale-1.51 {configuration options} -body {
    .s configure -sliderlength 86
    .s cget -sliderlength
} -cleanup {
    .s configure -sliderlength [lindex [.s configure -sliderlength] 3]
} -result {86}
test scale-1.52 {configuration options} -body {
        .s configure -sliderlength badValue
} -returnCodes error -result {bad screen distance "badValue"}
test scale-1.53 {configuration options} -body {
    .s configure -sliderrelief raised
    .s cget -sliderrelief
} -cleanup {
    .s configure -sliderrelief [lindex [.s configure -sliderrelief] 3]
} -result {raised}
test scale-1.54 {configuration options} -body {
        .s configure -sliderrelief badValue
} -returnCodes error -result {bad relief "badValue": must be flat, groove, raised, ridge, solid, or sunken}
test scale-1.55 {configuration options} -body {
    .s configure -state d
    .s cget -state
} -cleanup {
    .s configure -state [lindex [.s configure -state] 3]
} -result {disabled}
test scale-1.56 {configuration options} -body {
        .s configure -state badValue
} -returnCodes error -result {bad state "badValue": must be active, disabled, or normal}
test scale-1.57 {configuration options} -body {
    .s configure -state n
    .s cget -state
} -cleanup {
    .s configure -state [lindex [.s configure -state] 3]
} -result {normal}
test scale-1.59 {configuration options} -body {
    .s configure -takefocus {any string}
    .s cget -takefocus
} -cleanup {
    .s configure -takefocus [lindex [.s configure -takefocus] 3]
} -result {any string}
test scale-1.61 {configuration options} -body {
    .s configure -tickinterval 4.3
    .s cget -tickinterval
} -cleanup {
    .s configure -tickinterval [lindex [.s configure -tickinterval] 3]
} -result {4.0}
test scale-1.62 {configuration options} -body {
        .s configure -tickinterval badValue
} -returnCodes error -result {expected floating-point number but got "badValue"}
test scale-1.63 {configuration options} -body {
    .s configure -to 14.9
    .s cget -to
} -cleanup {
    .s configure -to [lindex [.s configure -to] 3]
} -result {15.0}
test scale-1.64 {configuration options} -body {
        .s configure -to badValue
} -returnCodes error -result {expected floating-point number but got "badValue"}
test scale-1.65 {configuration options} -body {
    .s configure -troughcolor #ff0000
    .s cget -troughcolor
} -cleanup {
    .s configure -troughcolor [lindex [.s configure -troughcolor] 3]
} -result {#ff0000}
test scale-1.66 {configuration options} -body {
        .s configure -troughcolor non-existent
} -returnCodes error -result {unknown color name "non-existent"}
test scale-1.67 {configuration options} -body {
    .s configure -variable x
    .s cget -variable
} -cleanup {
    .s configure -variable [lindex [.s configure -variable] 3]
} -result {x}
test scale-1.69 {configuration options} -body {
    .s configure -width 32
    .s cget -width
} -cleanup {
    .s configure -width [lindex [.s configure -width] 3]
} -result {32}
test scale-1.70 {configuration options} -body {
        .s configure -width badValue
} -returnCodes error -result {bad screen distance "badValue"}
destroy .s


test scale-2.1 {Tk_ScaleCmd procedure} -body {
    scale
} -returnCodes error -result {wrong # args: should be "scale pathName ?-option value ...?"}
test scale-2.2 {Tk_ScaleCmd procedure} -body {
    scale foo 
} -returnCodes error -result {bad window path name "foo"}
test scale-2.3 {Tk_ScaleCmd procedure} -body {
    catch {scale foo}
    winfo child .
} -result {}
test scale-2.4 {Tk_ScaleCmd procedure} -body {
    scale .s -gorp dumb
} -returnCodes error -result {unknown option "-gorp"}
test scale-2.5 {Tk_ScaleCmd procedure} -body {
    catch {scale .s -gorp dumb}
    winfo child .
} -result {}


# Widget used in 3.* tests
destroy .s
scale .s -from 100 -to 200
pack .s
update idletasks
test scale-3.1 {ScaleWidgetCmd procedure} -body {
    .s
} -returnCodes error -result {wrong # args: should be ".s option ?arg ...?"}
test scale-3.2 {ScaleWidgetCmd procedure, cget option} -body {
    .s cget
} -returnCodes error -result {wrong # args: should be ".s cget option"}
test scale-3.3 {ScaleWidgetCmd procedure, cget option} -body {
    .s cget a b
} -returnCodes error -result {wrong # args: should be ".s cget option"}
test scale-3.4 {ScaleWidgetCmd procedure, cget option} -body {
    .s cget -gorp
} -returnCodes error -result {unknown option "-gorp"}
test scale-3.5 {ScaleWidgetCmd procedure, cget option} -body {
    .s configure -highlightthickness 2
    .s cget -highlightthickness
} -result {2}
test scale-3.6 {ScaleWidgetCmd procedure, configure option} -body {
    list [llength [.s configure]] [lindex [.s configure] 6]
} -result {33 {-command command Command {} {}}}
test scale-3.7 {ScaleWidgetCmd procedure, configure option} -body {
    .s configure -foo
} -returnCodes error -result {unknown option "-foo"}
test scale-3.8 {ScaleWidgetCmd procedure, configure option} -body {
    .s configure -borderwidth 2 -bg
} -returnCodes error -result {value for "-bg" missing}
test scale-3.9 {ScaleWidgetCmd procedure, coords option} -body {
    .s coords a b
} -returnCodes error -result {wrong # args: should be ".s coords ?value?"}
test scale-3.10 {ScaleWidgetCmd procedure, coords option} -body {
    .s coords bad
} -returnCodes error -result {expected floating-point number but got "bad"}
test scale-3.11 {ScaleWidgetCmd procedure} -constraints {
	fonts
} -body {
    .s configure -from 100 -to 200
    update idletasks
    .s set 120
    .s coords
} -result {38 34}
test scale-3.12 {ScaleWidgetCmd procedure, coords option} -constraints {
	fonts
} -body {
    .s configure -from 100 -to 200 -orient horizontal
    update idletasks
    .s set 120
    .s coords
} -result {34 31}
test scale-3.13 {ScaleWidgetCmd procedure, get option} -body {
    .s configure -orient vertical
    update
    .s get a
} -returnCodes error -result {wrong # args: should be ".s get ?x y?"}
test scale-3.14 {ScaleWidgetCmd procedure, get option} -body {
    .s configure -orient vertical
    update
    .s get a b c
} -returnCodes error -result {wrong # args: should be ".s get ?x y?"}
test scale-3.15 {ScaleWidgetCmd procedure, get option} -body {
    .s configure -orient vertical
    update
    .s get a 11
} -returnCodes error -result {expected integer but got "a"}
test scale-3.16 {ScaleWidgetCmd procedure, get option} -body {
    .s configure -orient vertical
    update
    .s get 12 b
} -returnCodes error -result {expected integer but got "b"}
test scale-3.17 {ScaleWidgetCmd procedure, get option} -body {
    .s configure -orient vertical
    update
    .s set 133
    .s get
} -result 133
test scale-3.18 {ScaleWidgetCmd procedure, get option} -body {
    .s configure -orient vertical -resolution 0.5
    update
    .s set 150
    .s get 37 34
} -result {119.5}
.s configure -resolution 1
test scale-3.19 {ScaleWidgetCmd procedure, identify option} -body {
    .s identify
} -returnCodes error -result {wrong # args: should be ".s identify x y"}
test scale-3.20 {ScaleWidgetCmd procedure, identify option} -body {
    .s identify 1 2 3
} -returnCodes error -result {wrong # args: should be ".s identify x y"}
test scale-3.21 {ScaleWidgetCmd procedure, identify option} -body {
    .s identify boo 16
} -returnCodes error -result {expected integer but got "boo"}
test scale-3.22 {ScaleWidgetCmd procedure, identify option} -body {
    .s identify 17 bad
} -returnCodes error -result {expected integer but got "bad"}
test scale-3.23 {ScaleWidgetCmd procedure, identify option} -constraints {
	fonts
} -body {
    .s configure -from 100 -to 200 -orient vertical -resolution 1
    update
    .s set 120
    list [.s identify 35 10] [.s identify 35 30] [.s identify 35 80] [.s identify 5 80]
} -result {trough1 slider trough2 {}}
test scale-3.24 {ScaleWidgetCmd procedure, set option} -body {
    .s set
} -returnCodes error -result {wrong # args: should be ".s set value"}
test scale-3.25 {ScaleWidgetCmd procedure, set option} -body {
    .s set a b
} -returnCodes error -result {wrong # args: should be ".s set value"}
test scale-3.26 {ScaleWidgetCmd procedure, set option} -body {
    .s set bad
} -returnCodes error -result {expected floating-point number but got "bad"}
test scale-3.27 {ScaleWidgetCmd procedure, set option} -body {
    .s configure -from 100 -to 200 -orient vertical -resolution 0.5
    update
    .s set 142
} -result {}
test scale-3.28 {ScaleWidgetCmd procedure, set option} -body {
    .s configure -from 100 -to 200 -orient vertical -resolution 1
    update
    .s set 118
    .s configure -state disabled
    .s set 181
    .s configure -state normal
    .s get
} -result {118}
test scale-3.29 {ScaleWidgetCmd procedure} -body {
    .s dumb
} -returnCodes error -result {bad option "dumb": must be cget, configure, coords, get, identify, or set}
test scale-3.30 {ScaleWidgetCmd procedure} -body {
    .s c
} -returnCodes error -result {ambiguous option "c": must be cget, configure, coords, get, identify, or set}
test scale-3.31 {ScaleWidgetCmd procedure} -body {
    .s co
} -returnCodes error -result {ambiguous option "co": must be cget, configure, coords, get, identify, or set}
destroy .s

test scale-3.32 {ScaleWidgetCmd procedure, Tk_Preserve} -setup {
    destroy .s
} -body {
    proc kill args {
	    destroy .s
    }
    scale .s -variable x -from 0 -to 100 -orient horizontal
    pack .s
    update
    .s configure -command kill
    .s set 55
} -cleanup {
    destroy .s
} -result {}


test scale-4.1 {DestroyScale procedure} -setup {
    deleteWindows
} -body {
    set x 50
    scale .s -variable x -from 0 -to 100 -orient horizontal
    pack .s
    update
    destroy .s
    list [catch {set x foo} msg] $msg $x
} -result {0 foo foo}


test scale-5.1 {ConfigureScale procedure} -setup {
    deleteWindows
} -body {
    set x 66
    set y 77
    scale .s -variable x -from 0 -to 100
    pack .s
    update
    .s configure -variable y
    list [catch {set x foo} msg] $msg $x [.s get]
} -cleanup {
    deleteWindows
} -result {0 foo foo 77}
test scale-5.2 {ConfigureScale procedure} -setup {
    deleteWindows
} -body {
    scale .s -from 0 -to 100
    .s configure -foo bar
} -cleanup {
    deleteWindows
} -returnCodes error -result {unknown option "-foo"}
test scale-5.3 {ConfigureScale procedure} -setup {
    deleteWindows
} -body {
    catch {unset x}
    scale .s -from 0 -to 100 -variable x
    set result $x
    lappend result [.s get]
    set x 92
    lappend result [.s get]
    .s set 3
    lappend result $x
    unset x
    lappend result [set x]
} -cleanup {
    deleteWindows
} -result {0 0 92 3 3}
test scale-5.4 {ConfigureScale procedure} -setup {
    deleteWindows
} -body {
    scale .s -from 0 -to 100
    .s configure -orient dumb
} -cleanup {
    deleteWindows
} -returnCodes error -result {bad orient "dumb": must be horizontal or vertical}
test scale-5.5 {ConfigureScale procedure} -setup {
    deleteWindows
} -body {
    scale .s -from 1.11 -to 1.89 -resolution .1 -tickinterval .76
    list [format %.1f [.s cget -from]] [format %.1f [.s cget -to]] \
        [format %.1f [.s cget -tickinterval]]
} -cleanup {
    deleteWindows
} -result {1.1 1.9 0.8}
test scale-5.6 {ConfigureScale procedure} -setup {
    deleteWindows
} -body {
    scale .s -from 1 -to 10 -tickinterval -2
    pack .s
    set result [lindex [.s configure -tickinterval] 4]
    .s configure -from 10 -to 1 -tickinterval 2
    lappend result [lindex [.s configure -tickinterval] 4]
} -cleanup {
    deleteWindows
} -result {2.0 -2.0}
test scale-5.7 {ConfigureScale procedure} -setup {
    deleteWindows
} -body {
    scale .s -from 0 -to 100 -state bogus
} -cleanup {
    deleteWindows
} -returnCodes error -result {bad state "bogus": must be active, disabled, or normal}


# Widget used in 6.* tests
destroy .s
scale .s -orient horizontal -length 200
pack .s
test scale-6.1 {ComputeFormat procedure} -body {
    .s configure -from 10 -to 100 -resolution 10
    .s set 49.3
    .s get
} -result {50}
test scale-6.2 {ComputeFormat procedure} -body {
    .s configure -from 100 -to 1000 -resolution 100
    .s set 493
    .s get
} -result {500}
test scale-6.3 {ComputeFormat procedure} -body {
    .s configure -from 1000 -to 10000 -resolution 1000
    .s set 4930
    .s get
} -result {5000}
test scale-6.4 {ComputeFormat procedure} -body {
    .s configure -from 10000 -to 100000 -resolution 10000
    .s set 49000
    .s get
} -result {50000}
test scale-6.5 {ComputeFormat procedure} -body {
    .s configure -from 100000 -to 1000000 -resolution 100000
    .s set 493000
    .s get
} -result {500000}
test scale-6.6 {ComputeFormat procedure} -constraints {
	nonPortable
} -body {
    # This test is non-portable because some platforms format the
    # result as 5e+06.
    .s configure -from 1000000 -to 10000000 -resolution 1000000
    .s set 4930000
    .s get
} -result {5000000}
test scale-6.7 {ComputeFormat procedure} -body {
    .s configure -from 1000000000 -to 10000000000 -resolution 1000000000
    .s set 4930000000
    expr {[.s get] == 5.0e+09}
} -result 1
test scale-6.8 {ComputeFormat procedure} -body {
    .s configure -from .1 -to 1 -resolution .1
    .s set .6
    .s get
} -result {0.6}
test scale-6.9 {ComputeFormat procedure} -body {
    .s configure -from .01 -to .1 -resolution .01
    .s set .06
    .s get
} -result {0.06}
test scale-6.10 {ComputeFormat procedure} -body {
    .s configure -from .001 -to .01 -resolution .001
    .s set .006
    .s get
} -result {0.006}
test scale-6.11 {ComputeFormat procedure} -body {
    .s configure -from .0001 -to .001 -resolution .0001
    .s set .0006
    .s get
} -result {0.0006}
test scale-6.12 {ComputeFormat procedure} -body {
    .s configure -from .00001 -to .0001 -resolution .00001
    .s set .00006
    .s get
} -result {0.00006}
test scale-6.13 {ComputeFormat procedure} -body {
    .s configure -from .000001 -to .00001 -resolution .000001
    .s set .000006
    expr {[.s get] == 6.0e-06}
} -result {1}
test scale-6.14 {ComputeFormat procedure} -body {
    .s configure -to .00001 -from .0001 -resolution .00001
    .s set .00006
    .s get
} -result {0.00006}
test scale-6.15 {ComputeFormat procedure} -body {
    .s configure -to .000001 -from .00001 -resolution .000001
    .s set .000006
    expr {[.s get] == 6.0e-06}
} -result {1}
test scale-6.16 {ComputeFormat procedure} -body {
    .s configure -from .00001 -to .0001 -resolution .00001 -digits 1
    .s set .00006
    expr {[.s get] == 6e-05}
} -result {1}
test scale-6.17 {ComputeFormat procedure} -body {
    .s configure -from 10000000 -to 100000000 -resolution 10000000 -digits 3
    .s set 49300000
    .s get
} -result {50000000}
test scale-6.18 {ComputeFormat procedure} -body {
    .s configure -length 200 -from 0 -to 10 -resolution 0 -digits 0
    .s set .111111111
    .s get
} -result {0.11}
test scale-6.19 {ComputeFormat procedure} -body {
    .s configure -length 200 -from 1000 -to 1002 -resolution 0 -digits 0
    .s set 1001.23456789
    .s get
} -result {1001.23}
test scale-6.20 {ComputeFormat procedure} -body {
    .s configure -length 200 -from 1000 -to 1001.8 -resolution 0 -digits 0
    .s set 1001.23456789
    .s get
} -result {1001.235}
destroy .s


test scale-7.1 {ComputeScaleGeometry procedure} -constraints {
    nonPortable fonts
} -setup {
    deleteWindows
} -body {
    scale .s -from 0 -to 10 -label "Short" -orient vertical -length 5i
    pack .s
    update
    list [winfo reqwidth .s] [winfo reqheight .s]
} -cleanup {
    deleteWindows
} -result {88 458}
test scale-7.2 {ComputeScaleGeometry procedure} -constraints {
    fonts
} -setup {
    deleteWindows
} -body {
    scale .s -from 0 -to 1000 -label "Long string" -orient vertical -tick 200
    pack .s
    update
    list [winfo reqwidth .s] [winfo reqheight .s]
} -cleanup {
    deleteWindows
} -result {168 108}
test scale-7.3 {ComputeScaleGeometry procedure} -constraints {
    fonts
} -setup {
    deleteWindows
} -body {
    scale .s -from 0 -to 1000 -orient vertical -showvalue 0 -width 10 \
        -sliderlength 10
    pack .s
    update
    list [winfo reqwidth .s] [winfo reqheight .s]
} -cleanup {
    deleteWindows
} -result {22 108}
test scale-7.4 {ComputeScaleGeometry procedure} -constraints {
    fonts
} -setup {
    deleteWindows
} -body {
    scale .s -from 0 -to 1000 -orient vertical -showvalue 0 -bd 5 \
        -relief sunken
    pack .s
    update
    list [winfo reqwidth .s] [winfo reqheight .s]
} -cleanup {
    deleteWindows
} -result {39 114}
test scale-7.5 {ComputeScaleGeometry procedure} -constraints {
    nonPortable fonts
} -setup {
    deleteWindows
} -body {
    scale .s -from 0 -to 10 -label "Short" -orient horizontal -length 5i
    pack .s
    update
    list [winfo reqwidth .s] [winfo reqheight .s]
} -cleanup {
    deleteWindows
} -result {458 61}
test scale-7.6 {ComputeScaleGeometry procedure} -constraints {
    fonts
} -setup {
    deleteWindows
} -body {
    scale .s -from 0 -to 1000 -label "Long string" -orient horizontal \
        -tick 500
    pack .s
    update
    list [winfo reqwidth .s] [winfo reqheight .s]
} -cleanup {
    deleteWindows
} -result {108 79}
test scale-7.7 {ComputeScaleGeometry procedure} -constraints {
    fonts
} -setup {
    deleteWindows
} -body {
    scale .s -from 0 -to 1000 -orient horizontal -showvalue 0
    pack .s
    update
    list [winfo reqwidth .s] [winfo reqheight .s]
} -cleanup {
    deleteWindows
} -result {108 27}
test scale-7.8 {ComputeScaleGeometry procedure} -setup {
    deleteWindows
} -body {
    scale .s -from 0 -to 1000 -orient horizontal -showvalue 0 -bd 5 \
        -relief raised -highlightthickness 2
    pack .s
    update
    list [winfo reqwidth .s] [winfo reqheight .s]
} -cleanup {
    deleteWindows
} -result {114 39}


test scale-8.1 {ScaleElement procedure} -constraints {
    fonts
} -setup {
    deleteWindows
} -body {
    scale .s -from 0 -to 100 -orient vertical -bd 1 -tick 20 -length 300
    pack .s
    .s set 30
    update
    list [.s identify 53 52] [.s identify 54 52] [.s identify 70 52] \
        [.s identify 71 52]
} -cleanup {
    deleteWindows
} -result {{} trough1 trough1 {}}
test scale-8.2 {ScaleElement procedure} -constraints {
    fonts
} -setup {
    deleteWindows
} -body {
    scale .s -from 0 -to 100 -orient vertical -bd 1 -tick 20 -length 300
    pack .s
    .s set 30
    update
    list [.s identify 60 2] [.s identify 60 3] [.s identify 60 302] \
        [.s identify 60 303]
} -cleanup {
    deleteWindows
} -result {{} trough1 trough2 {}}
test scale-8.3 {ScaleElement procedure} -constraints {
    fonts
} -setup {
    deleteWindows
} -body {
    scale .s -from 0 -to 100 -orient vertical -bd 1 -tick 20 -length 300
    pack .s
    .s set 30
    update
    list [.s identify 60 83] [.s identify 60 84] [.s identify 60 113] \
        [.s identify 60 114] \
} -cleanup {
    deleteWindows
} -result {trough1 slider slider trough2}
test scale-8.4 {ScaleElement procedure} -setup {
    deleteWindows
} -body {
    scale .s -from 0 -to 100 -orient vertical -bd 4 -width 10 \
        -highlightthickness 1 -length 300 -showvalue 0
    pack .s
    .s set 30
    update
    list [.s identify 4 40] [.s identify 5 40] [.s identify 22 40] \
        [.s identify 23 40] \
} -cleanup {
    deleteWindows
} -result {{} trough1 trough1 {}}
test scale-8.5 {ScaleElement procedure} -constraints {
    fonts
} -setup {
    deleteWindows
} -body {
    scale .s -from 0 -to 100 -orient horizontal -bd 1 \
        -highlightthickness 2 -tick 20 -sliderlength 20 \
        -length 200 -label Test
    pack .s
    .s set 30
    update
    list [.s identify 150 36] [.s identify 150 37] [.s identify 150 53] \
        [.s identify 150 54]
} -cleanup {
    deleteWindows
} -result {{} trough2 trough2 {}}
test scale-8.6 {ScaleElement procedure} -constraints {
    fonts
} -setup {
    deleteWindows
} -body {
    scale .s -from 0 -to 100 -orient horizontal -bd 2 \
        -highlightthickness 1 -tick 20 -length 200
    pack .s
    .s set 30
    update
    list [.s identify 150 20] [.s identify 150 21] [.s identify 150 39] \
        [.s identify 150 40]
} -cleanup {
    deleteWindows
} -result {{} trough2 trough2 {}}
test scale-8.7 {ScaleElement procedure} -setup {
    deleteWindows
} -body {
    scale .s -from 0 -to 100 -orient horizontal -bd 4 -highlightthickness 2 \
        -length 200 -width 10 -showvalue 0
    pack .s
    .s set 30
    update
    list [.s identify 30 5] [.s identify 30 6] [.s identify 30 23] \
        [.s identify 30 24]
} -cleanup {
    deleteWindows
} -result {{} trough1 trough1 {}}
test scale-8.8 {ScaleElement procedure} -setup {
    deleteWindows
} -body {
    scale .s -from 0 -to 100 -orient horizontal -bd 1 -highlightthickness 2 \
        -tick 20 -sliderlength 20 -length 200 -label Test -showvalue 0
    pack .s
    .s set 30
    update
    list [.s identify 2 28] [.s identify 3 28] [.s identify 202 28] \
        [.s identify 203 28]
} -cleanup {
    deleteWindows
} -result {{} trough1 trough2 {}}
test scale-8.9 {ScaleElement procedure} -setup {
    deleteWindows
} -body {
    scale .s -from 0 -to 100 -orient horizontal -bd 1 -highlightthickness 2 \
        -tick 20 -sliderlength 20 -length 200 -label Test -showvalue 0
    pack .s
    .s set 80
    update
    list [.s identify 145 28] [.s identify 146 28] [.s identify 165 28] \
        [.s identify 166 28]
} -cleanup {
    deleteWindows
} -result {trough1 slider slider trough2}


#widget used in 9.* tests
destroy .s
pack [scale .s]
test scale-9.1 {PixelToValue procedure} -body {
    .s configure -from 0 -to 100 -sliderlength 10 -length 114 -bd 2
    update
    .s get 46 0
} -result 0
test scale-9.2 {PixelToValue procedure} -body {
    .s configure -from 0 -to 100 -sliderlength 10 -length 114 -bd 2
    update
    .s get -10 9
} -result 0
test scale-9.3 {PixelToValue procedure} -body {
    .s configure -from 0 -to 100 -sliderlength 10 -length 114 -bd 2
    update
    .s get -10 12
} -result 1
test scale-9.4 {PixelToValue procedure} -body {
    .s configure -from 0 -to 100 -sliderlength 10 -length 114 -bd 2
    update
    .s get -10 46
} -result 35
test scale-9.5 {PixelToValue procedure} -body {
    .s configure -from 0 -to 100 -sliderlength 10 -length 114 -bd 2
    update
    .s get -10 110
} -result 99
test scale-9.6 {PixelToValue procedure} -body {
    .s configure -from 0 -to 100 -sliderlength 10 -length 114 -bd 2
    update
    .s get -10 111
} -result 100
test scale-9.7 {PixelToValue procedure} -body {
    .s configure -from 0 -to 100 -sliderlength 10 -length 114 -bd 2
    update
    .s get -10 112
} -result 100
test scale-9.8 {PixelToValue procedure} -body {
    .s configure -from 0 -to 100 -sliderlength 10 -length 114 -bd 2
    update
    .s get -10 154
} -result 100
test scale-9.9 {PixelToValue procedure} -body {
    .s configure -from 0 -to 100 -sliderlength 10 -length 114 -bd 2 \
        -orient horizontal
    update
    .s get 76 152
} -result 65
destroy .s


test scale-10.1 {ValueToPixel procedure} -constraints {
    fonts
} -setup {
    deleteWindows
} -body {
    scale .s -from 0 -to 100 -sliderlength 20 -length 124 -bd 2 \
        -orient horizontal -label Test -tick 20
    pack .s
    update
    list [.s coords -10] [.s coords 40] [.s coords 1000]
} -cleanup {
    deleteWindows
} -result {{16 47} {56 47} {116 47}}
test scale-10.2 {ValueToPixel procedure} -constraints {
    fonts
} -setup {
    deleteWindows
} -body {
    scale .s -from 100 -to 0 -sliderlength 20 -length 122 -bd 1 \
        -orient vertical -label Test -tick 20
    pack .s
    update
    list [.s coords -10] [.s coords 40] [.s coords 1000]
} -cleanup {
    deleteWindows
} -result {{62 114} {62 74} {62 14}}


test scale-11.1 {ScaleEventProc procedure} -setup {
    deleteWindows
} -body {
    proc killScale value {
        global x
        if {$value > 30} {
            destroy .s1
            lappend x [winfo exists .s1] [info commands .s1]
        }
    }
    set x initial
    scale .s1 -from 0 -to 100 -command killScale
    .s1 set 20
    pack .s1
    update idletasks
    lappend x [winfo exists .s1]
    .s1 set 40
    update idletasks
    return $x
} -cleanup {
    rename killScale {}
    deleteWindows
} -result {initial 1 0 {}}
test scale-11.2 {ScaleEventProc procedure} -setup {
    deleteWindows
    set x {}
} -body {
    scale .s1 -bg #543210
    rename .s1 .s2
    lappend x [winfo children .]
    lappend x [.s2 cget -bg]
    destroy .s1
    lappend x [info command .s*] [winfo children .]
} -cleanup {
    deleteWindows
} -result {.s1 #543210 {} {}}

test scale-12.1 {ScaleCmdDeletedProc procedure} -setup {
    deleteWindows
} -body {
    scale .s1
    rename .s1 {}
    list [info command .s*] [winfo children .]
} -cleanup {
    deleteWindows
} -result {{} {}}


# Widget used in 13.* tests
destroy .s
pack [scale .s]
update
test scale-13.1 {SetScaleValue procedure} -body {
    .s configure -from 0 -to 100 -command {set x} -variable y
    update
    set x xyzzy
    .s set 44
    set result [list $x $y]
    update
    lappend result $x $y
} -result {xyzzy 44 44 44}
test scale-13.2 {SetScaleValue procedure} -body {
    .s set -3
    .s get
} -result 0
test scale-13.3 {SetScaleValue procedure} -body {
    .s set 105
    .s get
} -result 100
.s configure -from 100 -to 0
test scale-13.4 {SetScaleValue procedure} -body {
    .s set -3
    .s get
} -result 0
test scale-13.5 {SetScaleValue procedure} -body {
    .s set 105
    .s get
} -result 100
test scale-13.6 {SetScaleValue procedure} -body {
    proc varTrace args {
        global traceInfo
        set traceInfo $args
    }
    .s configure -from 0 -to 100 -command {set x} -variable y
    update

    .s set 50
    update
    trace variable y w varTrace
    set traceInfo empty
    set x untouched
    .s set 50
    update
    list $x $traceInfo
} -result {untouched empty}


# Widget used in 14.* tests
destroy .s
pack [scale .s]
update
test scale-14.1 {RoundToResolution procedure} -body {
    .s configure -from 0 -to 100 -sliderlength 10 -length 114 -bd 2 \
        -orient horizontal -resolution 4.0
    update
    .s get 84 152
} -result 72
test scale-14.2 {RoundToResolution procedure} -body {
    .s configure -from 0 -to 100 -sliderlength 10 -length 114 -bd 2 \
        -orient horizontal -resolution 4.0
    update
    .s get 86 152
} -result 76

test scale-14.3 {RoundToResolution procedure} -body {
    .s configure -from 100 -to 0 -sliderlength 10 -length 114 -bd 2 \
        -orient horizontal -resolution 4.0
    update
    .s get 84 152
} -result 28
test scale-14.4 {RoundToResolution procedure} -body {
    .s configure -from 100 -to 0 -sliderlength 10 -length 114 -bd 2 \
        -orient horizontal -resolution 4.0
    update
    .s get 86 152
} -result 24

test scale-14.5 {RoundToResolution procedure} -body {
    .s configure -from -100 -to 0 -sliderlength 10 -length 114 -bd 2 \
        -orient horizontal -resolution 4.0
    update
    .s get 84 152
} -result {-28}
test scale-14.6 {RoundToResolution procedure} -body {
    .s configure -from -100 -to 0 -sliderlength 10 -length 114 -bd 2 \
        -orient horizontal -resolution 4.0
    update
    .s get 86 152
} -result {-24}

test scale-14.7 {RoundToResolution procedure} -body {
    .s configure -from 0 -to -100 -sliderlength 10 -length 114 -bd 2 \
        -orient horizontal -resolution 4.0
    update
    .s get 84 152
} -result {-72}
test scale-14.8 {RoundToResolution procedure} -body {
    .s configure -from 0 -to -100 -sliderlength 10 -length 114 -bd 2 \
        -orient horizontal -resolution 4.0
    update
    .s get 86 152
} -result {-76}

test scale-14.9 {RoundToResolution procedure} -body {
    .s configure -from 0 -to 2.25  -sliderlength 10 -length 114 -bd 2 \
        -orient horizontal -resolution 0
    update
    .s get 84 152
} -result {1.64}
test scale-14.10 {RoundToResolution procedure} -body {
    .s configure -from 0 -to 2.25  -sliderlength 10 -length 114 -bd 2 \
        -orient horizontal -resolution 0
    update
    .s get 86 152
} -result {1.69}

test scale-14.11 {RoundToResolution procedure} -body {
    .s configure -from 0 -to 225 -sliderlength 10 -length 114 -bd 2 \
        -orient horizontal -resolution 0 -digits 5
    update
    .s get 84 152
} -result {164.25}
test scale-14.12 {RoundToResolution procedure} -body {
    .s configure -from 0 -to 225 -sliderlength 10 -length 114 -bd 2 \
        -orient horizontal -resolution 0 -digits 5
    update
    .s get 86 152
} -result {168.75}
destroy .s


test scale-15.1 {ScaleVarProc procedure} -setup {
    deleteWindows
} -body {
    set y -130
    scale .s -from 0 -to -200 -variable y -orient horizontal -length 150
    pack .s
    return $y
} -result {-130}
test scale-15.2 {ScaleVarProc procedure} -setup {
    deleteWindows
} -body {
    set y -130
    scale .s -from -200 -to 0 -variable y -orient horizontal -length 150
    pack .s
    set y -87
    .s get
} -result {-87}
test scale-15.3 {ScaleVarProc procedure} -setup {
    deleteWindows
} -body {
    set y -130
    scale .s -from -200 -to 0 -variable y -orient horizontal -length 150
    pack .s
    set y 40q
} -cleanup {
    deleteWindows
} -returnCodes error -result {can't set "y": can't assign non-numeric value to scale variable}
test scale-15.4 {ScaleVarProc procedure} -setup {
    deleteWindows
} -body {
    set y -130
    scale .s -from -200 -to 0 -variable y -orient horizontal -length 150
    pack .s
    catch {set y 40q}
    .s get
} -cleanup {
    deleteWindows
} -result {-130}
test scale-15.5 {ScaleVarProc procedure} -setup {
    deleteWindows
} -body {
    set y 1
    scale .s -from 1 -to 0 -variable y -orient horizontal -length 150
    pack .s
    set y x
} -cleanup {
    deleteWindows
} -returnCodes error -result {can't set "y": can't assign non-numeric value to scale variable}
test scale-15.6 {ScaleVarProc procedure} -setup {
    deleteWindows
} -body {
    set y 1
    scale .s -from 1 -to 0 -variable y -orient horizontal -length 150
    pack .s
    catch {set y x}
    .s get
} -cleanup {
    deleteWindows
} -result 1
test scale-15.7 {ScaleVarProc procedure, variable deleted} -setup {
    deleteWindows
} -body {
    set y 6
    scale .s -from 10 -to 0 -variable y -orient horizontal -length 150 \
        -command "set x"
    pack .s
    update
    set x untouched
    unset y
    update
    list [catch {set y} msg] $msg [.s get] $x
} -cleanup {
    deleteWindows
} -result {0 6 6 untouched}
test scale-15.8 {ScaleVarProc procedure, don't call -command} -setup {
    deleteWindows
} -body {
    set y 6
    scale .s -from 0 -to 100 -variable y -orient horizontal -length 150 \
        -command "set x"
    pack .s
    update
    set x untouched
    set y 60
    update
    list $x [.s get]
} -cleanup {
    deleteWindows
} -result {untouched 60}


test scale-16.1 {scale widget vs hidden commands} -body {
    set l [interp hidden]
    deleteWindows
    scale .s
    interp hide {} .s
    destroy .s
    set res1 [list [winfo children .] [interp hidden]]
    set res2 [list {} $l]
    expr {$res1 eq $res2}
} -cleanup {
    deleteWindows
} -result 1


test scale-17.1 {bug fix 1786} -setup {
    deleteWindows
} -body {
    # Perhaps x is set to {}, depending on what other tests have run.
    # If x is unset, or set to something not convertable to a double,
    # then the scale try to initialize its value with the contents
    # of uninitialized memory.  Sometimes that causes an FPE.

    set x {}
    scale .s -from 100 -to 300
    pack .s
    update
    .s configure -variable x   ;# CRASH! -> Floating point exception

    # Bug 4833 changed the result to realize that x should pick up
    # a value from the scale.  In an FPE occurs, it is due to the
    # lack of errno being set to 0 by some libc's. (see bug 4942)
    return $x
} -cleanup {
    deleteWindows
} -result {100}


test scale-18.1 {DestroyScale, -cursor option [Bug: 3897]} -setup {
    deleteWindows
} -body {
    scale .s -cursor trek
    destroy .s
} -result {}

test scale-18.2 {Scale button 1 events [Bug 787065]} -setup {
    destroy .s
    set ::error {}
    proc bgerror {args} {set ::error $args}
} -body {
    set y 5
    scale .s -from 0 -to 10 -variable y -orient horizontal -length 150
    pack .s
    tkwait visibility .s
    list [catch {
        event generate .s <1> -x 0 -y 0
        event generate .s <ButtonRelease-1> -x 0 -y 0
        update
        set ::error
    } msg] $msg
} -cleanup {
    unset ::error
    rename bgerror {}
    destroy .s
} -result {0 {}}

test scale-18.3 {Scale button 2 events [Bug 787065]} -setup {
    destroy .s
    set ::error {}
    proc bgerror {args} {set ::error $args}
} -body {
    set y 5
    scale .s -from 0 -to 10 -variable y -orient horizontal -length 150
    pack .s
    tkwait visibility .s
    list [catch {
        event generate .s <2> -x 0 -y 0
        event generate .s <ButtonRelease-2> -x 0 -y 0
        update
        set ::error
    } msg] $msg
} -cleanup {
    unset ::error
    rename bgerror {}
    destroy .s
} -result {0 {}}


option clear

# cleanup
cleanupTests
return@


1.16
log
@fix [2021443] inconsistant "wrong # args" messages (for Tk)
@
text
@d9 1
a9 1
# RCS: @@(#) $Id: scale.test,v 1.15 2004/05/23 17:34:49 dkf Exp $
d11 2
a12 1
package require tcltest 2.1
d23 1
d27 295
a321 64
set i 1
foreach test {
    {-activebackground #ff0000 #ff0000 non-existent
	    {unknown color name "non-existent"}}
    {-background #ff0000 #ff0000 non-existent
	    {unknown color name "non-existent"}}
    {-bd 4 4 badValue {bad screen distance "badValue"}}
    {-bigincrement 12.5 12.5 badValue
	    {expected floating-point number but got "badValue"}}
    {-bg #ff0000 #ff0000 non-existent
	    {unknown color name "non-existent"}}
    {-borderwidth 1.3 1 badValue {bad screen distance "badValue"}}
    {-command "set x" {set x} {} {}}
    {-cursor arrow arrow badValue {bad cursor spec "badValue"}}
    {-digits 5 5 badValue {expected integer but got "badValue"}}
    {-fg #00ff00 #00ff00 badValue {unknown color name "badValue"}}
    {-font fixed fixed {} {font "" doesn't exist}}
    {-foreground green green badValue {unknown color name "badValue"}}
    {-from -15.0 -15.0 badValue
	    {expected floating-point number but got "badValue"}}
    {-highlightbackground #112233 #112233 ugly {unknown color name "ugly"}}
    {-highlightcolor #123456 #123456 non-existent
	    {unknown color name "non-existent"}}
    {-highlightthickness 2 2 badValue {bad screen distance "badValue"}}
    {-label "Some text" {Some text} {} {}}
    {-length 130 130 badValue {bad screen distance "badValue"}}
    {-orient horizontal horizontal badValue
	    {bad orient "badValue": must be horizontal or vertical}}
    {-orient horizontal horizontal {} {}}
    {-relief ridge ridge badValue {bad relief "badValue": must be flat, groove, raised, ridge, solid, or sunken}}
    {-repeatdelay 14 14 bogus {expected integer but got "bogus"}}
    {-repeatinterval 14 14 bogus {expected integer but got "bogus"}}
    {-resolution 2.0 2.0 badValue
	    {expected floating-point number but got "badValue"}}
    {-showvalue 0 0 badValue {expected boolean value but got "badValue"}}
    {-sliderlength 86 86 badValue {bad screen distance "badValue"}}
    {-sliderrelief raised raised badValue {bad relief "badValue": must be flat, groove, raised, ridge, solid, or sunken}}
    {-state d disabled badValue
	    {bad state "badValue": must be active, disabled, or normal}}
    {-state n normal {} {}}
    {-takefocus "any string" "any string" {} {}}
    {-tickinterval 4.3 4.0 badValue
	    {expected floating-point number but got "badValue"}}
    {-to 14.9 15.0 badValue
	    {expected floating-point number but got "badValue"}}
    {-troughcolor #ff0000 #ff0000 non-existent
	    {unknown color name "non-existent"}}
    {-variable x x {} {}}
    {-width 32 32 badValue {bad screen distance "badValue"}}
} {
    set name [lindex $test 0]
    test scale-1.$i {configuration options} {
	.s configure $name [lindex $test 1]
	lindex [.s configure $name] 4
    } [lindex $test 2]
    incr i
    if {[lindex $test 3] ne ""} {
	test scale-1.$i {configuration options} {
	    list [catch {.s configure $name [lindex $test 3]} msg] $msg
	} [list 1 [lindex $test 4]]
    }
    .s configure $name [lindex [.s configure $name] 3]
    incr i
}
a323 9
test scale-2.1 {Tk_ScaleCmd procedure} {
    list [catch {scale} msg] $msg
} {1 {wrong # args: should be "scale pathName ?-option value ...?"}}
test scale-2.2 {Tk_ScaleCmd procedure} {
    list [catch {scale foo} msg] $msg [winfo child .]
} {1 {bad window path name "foo"} {}}
test scale-2.3 {Tk_ScaleCmd procedure} {
    list [catch {scale .s -gorp dumb} msg] $msg [winfo child .]
} {1 {unknown option "-gorp"} {}}
d325 21
d349 14
a362 13
test scale-3.1 {ScaleWidgetCmd procedure} {
    list [catch {.s} msg] $msg
} {1 {wrong # args: should be ".s option ?arg ...?"}}
test scale-3.2 {ScaleWidgetCmd procedure, cget option} {
    list [catch {.s cget} msg] $msg
} {1 {wrong # args: should be ".s cget option"}}
test scale-3.3 {ScaleWidgetCmd procedure, cget option} {
    list [catch {.s cget a b} msg] $msg
} {1 {wrong # args: should be ".s cget option"}}
test scale-3.4 {ScaleWidgetCmd procedure, cget option} {
    list [catch {.s cget -gorp} msg] $msg
} {1 {unknown option "-gorp"}}
test scale-3.5 {ScaleWidgetCmd procedure, cget option} {
d364 2
a365 2
} {2}
test scale-3.6 {ScaleWidgetCmd procedure, configure option} {
d367 18
a384 14
} {33 {-command command Command {} {}}}
test scale-3.7 {ScaleWidgetCmd procedure, configure option} {
    list [catch {.s configure -foo} msg] $msg
} {1 {unknown option "-foo"}}
test scale-3.8 {ScaleWidgetCmd procedure, configure option} {
    list [catch {.s configure -borderwidth 2 -bg} msg] $msg
} {1 {value for "-bg" missing}}
test scale-3.9 {ScaleWidgetCmd procedure, coords option} {
    list [catch {.s coords a b} msg] $msg
} {1 {wrong # args: should be ".s coords ?value?"}}
test scale-3.10 {ScaleWidgetCmd procedure, coords option} {
    list [catch {.s coords bad} msg] $msg
} {1 {expected floating-point number but got "bad"}}
test scale-3.11 {ScaleWidgetCmd procedure} {fonts} {
d387 6
a392 4
} {38 34}
test scale-3.12 {ScaleWidgetCmd procedure, coords option} {fonts} {
    .s configure -orient horizontal
    update
d395 24
a418 16
} {34 31}
.s configure -orient vertical
update
test scale-3.13 {ScaleWidgetCmd procedure, get option} {
    list [catch {.s get a} msg] $msg
} {1 {wrong # args: should be ".s get ?x y?"}}
test scale-3.14 {ScaleWidgetCmd procedure, get option} {
    list [catch {.s get a b c} msg] $msg
} {1 {wrong # args: should be ".s get ?x y?"}}
test scale-3.15 {ScaleWidgetCmd procedure, get option} {
    list [catch {.s get a 11} msg] $msg
} {1 {expected integer but got "a"}}
test scale-3.16 {ScaleWidgetCmd procedure, get option} {
    list [catch {.s get 12 b} msg] $msg
} {1 {expected integer but got "b"}}
test scale-3.17 {ScaleWidgetCmd procedure, get option} {
d421 4
a424 3
} 133
test scale-3.18 {ScaleWidgetCmd procedure, get option} {
    .s configure -resolution 0.5
d427 1
a427 1
} 119.5
d429 17
a445 13
test scale-3.19 {ScaleWidgetCmd procedure, identify option} {
    list [catch {.s identify} msg] $msg
} {1 {wrong # args: should be ".s identify x y"}}
test scale-3.20 {ScaleWidgetCmd procedure, identify option} {
    list [catch {.s identify 1 2 3} msg] $msg
} {1 {wrong # args: should be ".s identify x y"}}
test scale-3.21 {ScaleWidgetCmd procedure, identify option} {
    list [catch {.s identify boo 16} msg] $msg
} {1 {expected integer but got "boo"}}
test scale-3.22 {ScaleWidgetCmd procedure, identify option} {
    list [catch {.s identify 17 bad} msg] $msg
} {1 {expected integer but got "bad"}}
test scale-3.23 {ScaleWidgetCmd procedure, identify option} {fonts} {
d448 13
a460 11
} {trough1 slider trough2 {}}
test scale-3.24 {ScaleWidgetCmd procedure, set option} {
    list [catch {.s set} msg] $msg
} {1 {wrong # args: should be ".s set value"}}
test scale-3.25 {ScaleWidgetCmd procedure, set option} {
    list [catch {.s set a b} msg] $msg
} {1 {wrong # args: should be ".s set value"}}
test scale-3.26 {ScaleWidgetCmd procedure, set option} {
    list [catch {.s set bad} msg] $msg
} {1 {expected floating-point number but got "bad"}}
test scale-3.27 {ScaleWidgetCmd procedure, set option} {
d462 4
a465 2
} {}
test scale-3.28 {ScaleWidgetCmd procedure, set option} {
d471 15
a485 11
} {118}
test scale-3.29 {ScaleWidgetCmd procedure} {
    list [catch {.s dumb} msg] $msg
} {1 {bad option "dumb": must be cget, configure, coords, get, identify, or set}}
test scale-3.30 {ScaleWidgetCmd procedure} {
    list [catch {.s c} msg] $msg
} {1 {ambiguous option "c": must be cget, configure, coords, get, identify, or set}}
test scale-3.31 {ScaleWidgetCmd procedure} {
    list [catch {.s co} msg] $msg
} {1 {ambiguous option "co": must be cget, configure, coords, get, identify, or set}}
test scale-3.32 {ScaleWidgetCmd procedure, Tk_Preserve} {
d487 1
a487 1
	destroy .s
a488 1
    catch {destroy .s}
d494 4
a497 1
} {}
d499 3
a501 2
test scale-4.1 {DestroyScale procedure} {
    catch {destroy .s}
d508 2
a509 1
} {0 foo foo}
d511 3
a513 2
test scale-5.1 {ConfigureScale procedure} {
    catch {destroy .s}
d521 6
a526 3
} {0 foo foo 77}
test scale-5.2 {ConfigureScale procedure} {
    catch {destroy .s}
d528 7
a534 4
    list [catch {.s configure -foo bar} msg] $msg
} {1 {unknown option "-foo"}}
test scale-5.3 {ConfigureScale procedure} {
    catch {destroy .s}
d544 7
a550 4
    lappend result [catch {set x} msg] $msg
} {0 0 92 3 0 3}
test scale-5.4 {ConfigureScale procedure} {
    catch {destroy .s}
d552 7
a558 4
    list [catch {.s configure -orient dumb} msg] $msg
} {1 {bad orient "dumb": must be horizontal or vertical}}
test scale-5.5 {ConfigureScale procedure} {
    catch {destroy .s}
d561 7
a567 4
	    [format %.1f [.s cget -tickinterval]]
} {1.1 1.9 0.8}
test scale-5.6 {ConfigureScale procedure} {
    catch {destroy .s}
d573 11
a583 5
} {2.0 -2.0}
test scale-5.7 {ConfigureScale procedure} {
    catch {destroy .s}
    list [catch {scale .s -from 0 -to 100 -state bogus} msg] $msg
} {1 {bad state "bogus": must be active, disabled, or normal}}
d585 2
a586 1
catch {destroy .s}
d589 1
a589 1
test scale-6.1 {ComputeFormat procedure} {
d593 2
a594 2
} {50}
test scale-6.2 {ComputeFormat procedure} {
d598 2
a599 2
} {500}
test scale-6.3 {ComputeFormat procedure} {
d603 2
a604 2
} {5000}
test scale-6.4 {ComputeFormat procedure} {
d608 2
a609 2
} {50000}
test scale-6.5 {ComputeFormat procedure} {
d613 4
a616 2
} {500000}
test scale-6.6 {ComputeFormat procedure} {nonPortable} {
a618 1

d622 2
a623 2
} {5000000}
test scale-6.7 {ComputeFormat procedure} {
d627 2
a628 2
} 1
test scale-6.8 {ComputeFormat procedure} {
d632 2
a633 2
} {0.6}
test scale-6.9 {ComputeFormat procedure} {
d637 2
a638 2
} {0.06}
test scale-6.10 {ComputeFormat procedure} {
d642 2
a643 2
} {0.006}
test scale-6.11 {ComputeFormat procedure} {
d647 2
a648 2
} {0.0006}
test scale-6.12 {ComputeFormat procedure} {
d652 2
a653 2
} {0.00006}
test scale-6.13 {ComputeFormat procedure} {
d657 2
a658 2
} {1}
test scale-6.14 {ComputeFormat procedure} {
d662 2
a663 2
} {0.00006}
test scale-6.15 {ComputeFormat procedure} {
d667 2
a668 2
} {1}
test scale-6.16 {ComputeFormat procedure} {
d672 2
a673 2
} {1}
test scale-6.17 {ComputeFormat procedure} {
d677 2
a678 2
} {50000000}
test scale-6.18 {ComputeFormat procedure} {
d682 2
a683 2
} {0.11}
test scale-6.19 {ComputeFormat procedure} {
d687 2
a688 2
} {1001.23}
test scale-6.20 {ComputeFormat procedure} {
d692 2
a693 1
} {1001.235}
d695 6
a700 2
test scale-7.1 {ComputeScaleGeometry procedure} {nonPortable fonts} {
    catch {destroy .s}
d705 8
a712 3
} {88 458}
test scale-7.2 {ComputeScaleGeometry procedure} {fonts} {
    catch {destroy .s}
d717 8
a724 3
} {168 108}
test scale-7.3 {ComputeScaleGeometry procedure} {fonts} {
    catch {destroy .s}
d726 1
a726 1
	    -sliderlength 10
d730 8
a737 3
} {22 108}
test scale-7.4 {ComputeScaleGeometry procedure} {fonts} {
    catch {destroy .s}
d739 1
a739 1
	    -relief sunken
d743 8
a750 3
} {39 114}
test scale-7.5 {ComputeScaleGeometry procedure} {nonPortable fonts} {
    catch {destroy .s}
d755 8
a762 3
} {458 61}
test scale-7.6 {ComputeScaleGeometry procedure} {fonts} {
    catch {destroy .s}
d764 1
a764 1
	    -tick 500
d768 8
a775 3
} {108 79}
test scale-7.7 {ComputeScaleGeometry procedure} {fonts} {
    catch {destroy .s}
d780 6
a785 3
} {108 27}
test scale-7.8 {ComputeScaleGeometry procedure} {
    catch {destroy .s}
d787 1
a787 1
	    -relief raised -highlightthickness 2
d791 4
a794 1
} {114 39}
d796 5
a800 2
test scale-8.1 {ScaleElement procedure} {fonts} {
    catch {destroy .s}
d806 9
a814 4
	    [.s identify 71 52]
} {{} trough1 trough1 {}}
test scale-8.2 {ScaleElement procedure} {fonts} {
    catch {destroy .s}
d820 9
a828 4
	    [.s identify 60 303]
} {{} trough1 trough2 {}}
test scale-8.3 {ScaleElement procedure} {fonts} {
    catch {destroy .s}
d834 7
a840 4
	    [.s identify 60 114] \
} {trough1 slider slider trough2}
test scale-8.4 {ScaleElement procedure} {
    catch {destroy .s}
d842 1
a842 1
	    -highlightthickness 1 -length 300 -showvalue 0
d847 9
a855 4
	    [.s identify 23 40] \
} {{} trough1 trough1 {}}
test scale-8.5 {ScaleElement procedure} {fonts} {
    catch {destroy .s}
d857 2
a858 2
	    -highlightthickness 2 -tick 20 -sliderlength 20 \
	    -length 200 -label Test
d863 9
a871 4
	    [.s identify 150 54]
} {{} trough2 trough2 {}}
test scale-8.6 {ScaleElement procedure} {fonts} {
    catch {destroy .s}
d873 1
a873 1
	    -highlightthickness 1 -tick 20 -length 200
d878 7
a884 4
	    [.s identify 150 40]
} {{} trough2 trough2 {}}
test scale-8.7 {ScaleElement procedure} {
    catch {destroy .s}
d886 1
a886 1
	    -length 200 -width 10 -showvalue 0
d891 7
a897 4
	    [.s identify 30 24]
} {{} trough1 trough1 {}}
test scale-8.8 {ScaleElement procedure} {
    catch {destroy .s}
d899 1
a899 1
	    -tick 20 -sliderlength 20 -length 200 -label Test -showvalue 0
d904 7
a910 4
	    [.s identify 203 28]
} {{} trough1 trough2 {}}
test scale-8.9 {ScaleElement procedure} {
    catch {destroy .s}
d912 1
a912 1
	    -tick 20 -sliderlength 20 -length 200 -label Test -showvalue 0
d917 5
a921 2
	    [.s identify 166 28]
} {trough1 slider slider trough2}
d923 6
a928 5
catch {destroy .s}
scale .s -from 0 -to 100 -sliderlength 10 -length 114 -bd 2
pack .s
update
test scale-9.1 {PixelToValue procedure} {
d930 4
a933 2
} 0
test scale-9.2 {PixelToValue procedure} {
d935 4
a938 2
} 0
test scale-9.3 {PixelToValue procedure} {
d940 4
a943 2
} 1
test scale-9.4 {PixelToValue procedure} {
d945 4
a948 2
} 35
test scale-9.5 {PixelToValue procedure} {
d950 4
a953 2
} 99
test scale-9.6 {PixelToValue procedure} {
d955 4
a958 2
} 100
test scale-9.7 {PixelToValue procedure} {
d960 4
a963 2
} 100
test scale-9.8 {PixelToValue procedure} {
d965 5
a969 4
} 100
.s configure -orient horizontal
update
test scale-9.9 {PixelToValue procedure} {
d971 3
a973 1
} 65
d975 5
a979 2
test scale-10.1 {ValueToPixel procedure} {fonts} {
    catch {destroy .s}
d981 1
a981 1
	    -orient horizontal -label Test -tick 20
d985 8
a992 3
} {{16 47} {56 47} {116 47}}
test scale-10.2 {ValueToPixel procedure} {fonts} {
    catch {destroy .s}
d994 1
a994 1
	    -orient vertical -label Test -tick 20
d998 4
a1001 1
} {{62 114} {62 74} {62 14}}
d1003 3
a1005 1
test scale-11.1 {ScaleEventProc procedure} {
d1007 5
a1011 5
	global x
	if {$value > 30} {
	    destroy .s1
	    lappend x [winfo exists .s1] [info commands .s1]
	}
a1012 1
    catch {destroy .s1}
d1021 2
a1023 3
    set x
} {initial 1 0 {}}
test scale-11.2 {ScaleEventProc procedure} {
d1025 5
a1031 1
    set x {}
d1036 3
a1038 1
} {.s1 #543210 {} {}}
d1040 1
a1040 1
test scale-12.1 {ScaleCmdDeletedProc procedure} {
d1042 1
d1046 3
a1048 1
} {{} {}}
d1050 4
a1053 3
catch {destroy .s}
scale .s -from 0 -to 100 -command {set x} -variable y
pack .s
d1055 3
a1057 5
proc varTrace args {
    global traceInfo
    set traceInfo $args
}
test scale-13.1 {SetScaleValue procedure} {
d1063 2
a1064 2
} {xyzzy 44 44 44}
test scale-13.2 {SetScaleValue procedure} {
d1067 2
a1068 2
} 0
test scale-13.3 {SetScaleValue procedure} {
d1071 1
a1071 1
} 100
d1073 1
a1073 1
test scale-13.4 {SetScaleValue procedure} {
d1076 2
a1077 2
} 0
test scale-13.5 {SetScaleValue procedure} {
d1080 9
a1088 2
} 100
test scale-13.6 {SetScaleValue procedure} {
d1097 2
a1098 1
} {untouched empty}
d1100 3
a1102 3
catch {destroy .s}
scale .s -from 0 -to 100 -sliderlength 10 -length 114 -bd 2 -orient horizontal
pack .s
d1104 4
a1107 3
.s configure -resolution 4.0
update
test scale-14.1 {RoundToResolution procedure} {
d1109 5
a1113 2
} 72
test scale-14.2 {RoundToResolution procedure} {
d1115 6
a1120 4
} 76
.s configure -from 100 -to 0
update
test scale-14.3 {RoundToResolution procedure} {
d1122 5
a1126 2
} 28
test scale-14.4 {RoundToResolution procedure} {
d1128 6
a1133 4
} 24
.s configure -from -100 -to 0
update
test scale-14.5 {RoundToResolution procedure} {
d1135 5
a1139 2
} -28
test scale-14.6 {RoundToResolution procedure} {
d1141 6
a1146 4
} -24
.s configure -from 0 -to -100
update
test scale-14.7 {RoundToResolution procedure} {
d1148 5
a1152 2
} -72
test scale-14.8 {RoundToResolution procedure} {
d1154 6
a1159 4
} -76
.s configure -from 0 -to 2.25 -resolution 0
update
test scale-14.9 {RoundToResolution procedure} {
d1161 5
a1165 2
} 1.64
test scale-14.10 {RoundToResolution procedure} {
d1167 6
a1172 4
} 1.69
.s configure -from 0 -to 225 -resolution 0  -digits 5
update
test scale-14.11 {RoundToResolution procedure} {
d1174 5
a1178 2
} 164.25
test scale-14.12 {RoundToResolution procedure} {
d1180 3
a1182 1
} 168.75
d1184 3
a1186 2
test scale-15.1 {ScaleVarProc procedure} {
    catch {destroy .s}
d1190 5
a1194 4
    set y
} -130
test scale-15.2 {ScaleVarProc procedure} {
    catch {destroy .s}
d1200 14
a1213 3
} -87
test scale-15.3 {ScaleVarProc procedure} {
    catch {destroy .s}
d1217 18
a1234 4
    list [catch {set y 40q} msg] $msg [.s get]
} {1 {can't set "y": can't assign non-numeric value to scale variable} -130}
test scale-15.4 {ScaleVarProc procedure} {
    catch {destroy .s}
d1238 8
a1245 4
    list [catch {set y x} msg] $msg [.s get]
} {1 {can't set "y": can't assign non-numeric value to scale variable} 1}
test scale-15.5 {ScaleVarProc procedure, variable deleted} {
    catch {destroy .s}
d1248 1
a1248 1
	    -command "set x"
d1255 6
a1260 3
} {0 6 6 untouched}
test scale-15.6 {ScaleVarProc procedure, don't call -command} {
    catch {destroy .s}
d1263 1
a1263 1
	    -command "set x"
d1270 3
a1272 1
} {untouched 60}
a1273 2
set l [interp hidden]
deleteWindows
d1275 3
a1277 2
test scale-16.1 {scale widget vs hidden commands} {
    catch {destroy .s}
d1281 6
a1286 2
    list [winfo children .] [interp hidden]
} [list {} $l]
d1288 4
a1291 1
test scale-17.1 {bug fix 1786} {
d1306 4
a1309 2
    set x
} {100}
d1311 4
a1314 2
test scale-18.1 {DestroyScale, -cursor option [Bug: 3897]} {
    catch {destroy .s}
d1317 43
a1359 1
} {}
a1360 49
test scale-18.2 {Scale button 1 events [Bug 787065]} \
    -setup {
        catch {destroy .s}
        set y 5
        scale .s -from 0 -to 10 -variable y -orient horizontal -length 150
        pack .s
        tkwait visibility .s
        set ::error {}
        proc bgerror {args} {set ::error $args}
    } \
    -body {
        list [catch {
            event generate .s <1> -x 0 -y 0
            event generate .s <ButtonRelease-1> -x 0 -y 0
            update
            set ::error
        } msg] $msg
    } \
    -cleanup {
        unset ::error
        rename bgerror {}
        catch {destroy .s}
    } \
    -result {0 {}}

test scale-18.3 {Scale button 2 events [Bug 787065]} \
    -setup {
        catch {destroy .s}
        set y 5
        scale .s -from 0 -to 10 -variable y -orient horizontal -length 150
        pack .s
        tkwait visibility .s
        set ::error {}
        proc bgerror {args} {set ::error $args}
    } \
    -body {
        list [catch {
            event generate .s <2> -x 0 -y 0
            event generate .s <ButtonRelease-2> -x 0 -y 0
            update
            set ::error
        } msg] $msg
    } \
    -cleanup {
        unset ::error
        rename bgerror {}
        catch {destroy .s}
    } \
    -result {0 {}}
a1361 1
catch {destroy .s}
d1366 1
a1366 1
return
@


1.15
log
@First step towards improving test style.  Also start using Tcl 8.5 features.
@
text
@d9 1
a9 1
# RCS: @@(#) $Id: scale.test,v 1.14 2003/08/13 10:28:21 patthoyts Exp $
d93 1
a93 1
} {1 {wrong # args: should be "scale pathName ?options?"}}
d106 1
a106 1
} {1 {wrong # args: should be ".s option ?arg arg ...?"}}
@


1.14
log
@	* library/scale.tcl: Fix for bug #787065 for Button-2 press.
	* tests/scale.test: Added test for this bug.
@
text
@d9 1
a9 1
# RCS: @@(#) $Id: scale.test,v 1.13 2003/04/01 21:06:50 dgp Exp $
d81 1
a81 1
    if {[lindex $test 3] != ""} {
@


1.13
log
@        * tests/all.tcl:                Made better use of a common
        * tests/constraints.tcl:        -loadfile to hold definitions
        * tests/*.test:                 common to all test files.
@
text
@d9 1
a9 1
# RCS: @@(#) $Id: scale.test,v 1.12 2002/07/13 20:28:35 dgp Exp $
d816 50
@


1.12
log
@	* Converted more files to tcltest and factored out common code.
@
text
@d9 1
a9 1
# RCS: @@(#) $Id: scale.test,v 1.11 2002/07/13 00:30:25 dgp Exp $
d12 1
a12 4
namespace import -force tcltest::configure
namespace import -force tcltest::testsDirectory
configure -testdir [file join [pwd] [file dirname [info script]]]
configure -loadfile [file join [testsDirectory] constraints.tcl]
d821 1
a821 1
::tcltest::cleanupTests
@


1.12.2.1
log
@	* library/scale.tcl: Fix for bug #787065 for Button-2 press.
	* tests/scale.test:  Added test for this bug.
@
text
@d9 1
a9 1
# RCS: @@(#) $Id: scale.test,v 1.12 2002/07/13 20:28:35 dgp Exp $
a818 50

test scale-18.2 {Scale button 1 events [Bug 787065]} \
    -setup {
        catch {destroy .s}
        set y 5
        scale .s -from 0 -to 10 -variable y -orient horizontal -length 150
        pack .s
        tkwait visibility .s
        set ::error {}
        proc bgerror {args} {set ::error $args}
    } \
    -body {
        list [catch {
            event generate .s <1> -x 0 -y 0
            event generate .s <ButtonRelease-1> -x 0 -y 0
            update
            set ::error
        } msg] $msg
    } \
    -cleanup {
        unset ::error
        rename bgerror {}
        catch {destroy .s}
    } \
    -result {0 {}}

test scale-18.3 {Scale button 2 events [Bug 787065]} \
    -setup {
        catch {destroy .s}
        set y 5
        scale .s -from 0 -to 10 -variable y -orient horizontal -length 150
        pack .s
        tkwait visibility .s
        set ::error {}
        proc bgerror {args} {set ::error $args}
    } \
    -body {
        list [catch {
            event generate .s <2> -x 0 -y 0
            event generate .s <ButtonRelease-2> -x 0 -y 0
            update
            set ::error
        } msg] $msg
    } \
    -cleanup {
        unset ::error
        rename bgerror {}
        catch {destroy .s}
    } \
    -result {0 {}}
@


1.11
log
@	* Converted several files in the test suite for testing by
	tcltest 2.1.
@
text
@d9 1
a9 1
# RCS: @@(#) $Id: scale.test,v 1.10 2000/04/14 08:34:28 hobbs Exp $
d12 1
a12 1
namespace import -force tcltest::test
a13 1
namespace import -force tcltest::configure
a16 7
eval configure $argv

foreach i [winfo children .] {
    destroy $i
}
wm geometry . {}
raise .
d618 1
a618 1
    eval destroy [winfo children .]
d629 1
a629 1
    eval destroy [winfo children .]
d786 1
a786 1
eval destroy [winfo children .]
@


1.10
log
@	* tests/winDialog.test: tk_chooseDirectory seems to get a noop
	from GetOpenFileName in the static build, hanging some tests.
	The tests were fixed to timeout (noop cause unknown).

	* tests/scale.test: correct 17.1 WRT bug 4833
@
text
@d9 1
a9 1
# RCS: @@(#) $Id: scale.test,v 1.9 1999/12/21 23:55:55 hobbs Exp $
d11 8
a18 3
if {[lsearch [namespace children] ::tcltest] == -1} {
    source [file join [pwd] [file dirname [info script]] defs.tcl]
}
@


1.10.8.1
log
@merged with trunk at tag macosx-8-4-merge-2002-08-20-trunk
@
text
@d9 1
a9 1
# RCS: @@(#) $Id$
d11 9
a19 6
package require tcltest 2.1
namespace import -force tcltest::configure
namespace import -force tcltest::testsDirectory
configure -testdir [file join [pwd] [file dirname [info script]]]
configure -loadfile [file join [testsDirectory] constraints.tcl]
tcltest::loadTestedCommands
d621 1
a621 1
    deleteWindows
d632 1
a632 1
    deleteWindows
d789 1
a789 1
deleteWindows
@


1.9
log
@	* scale.test:
	* generic/tkScale.c:
	* generic/tkScale.h: fixed possible core when freeing options
	(cursor) associated with scale widget [Bug: 3897]
@
text
@d9 1
a9 1
# RCS: @@(#) $Id: scale.test,v 1.8 1999/12/14 06:53:14 hobbs Exp $
d810 4
d815 1
a815 1
} {}
@


1.8
log
@	* tests/bind.test:
	* tests/canvImg.test:
	* tests/canvPsArc.tcl:
	* tests/canvPsImg.tcl: (new file)
	* tests/canvRect.test:
	* tests/canvText.test:
	* tests/canvas.test:
	* tests/defs.tcl:
	* tests/entry.test:
	* tests/event.test:
	* tests/font.test:
	* tests/frame.test:
	* tests/imgPhoto.test:
	* tests/safe.test:
	* tests/scale.test:
	* tests/scrollbar.test:
	* tests/select.test:
	* tests/text.test:
	* tests/textDisp.test:
	* tests/textTag.test:
	* tests/unixFont.test:
	* tests/unixWm.test:
	* tests/visual_bb.test:
	* tests/winClipboard.test: tests for the dash patch changes
@
text
@d9 1
a9 1
# RCS: @@(#) $Id: scale.test,v 1.7 1999/04/21 21:53:30 rjohnson Exp $
d813 6
a824 13













@


1.7
log
@
Merged 8-1-0 into mainline.
@
text
@d9 1
a9 1
# RCS: @@(#) $Id: scale.test,v 1.6 1999/04/20 01:04:04 rjohnson Exp $
d68 1
a68 1
    {-state disabled disabled badValue
d70 1
a70 1
    {-state normal normal {} {}}
d126 2
a127 2
    list [llength [.s configure]] [lindex [.s configure] 5]
} {33 {-borderwidth borderWidth BorderWidth 2 2}}
@


1.6
log
@
Added new tests to scale and text.
Fixed core dump in text serach code: Bug 1642
@
text
@d9 1
a9 1
# RCS: @@(#) $Id: scale.test,v 1.5 1999/04/19 23:54:57 hershey Exp $
@


1.5
log
@changed tests--marked some nonPortable; added new constraints to fix bug 1770
@
text
@d9 1
a9 1
# RCS: @@(#) $Id: scale.test,v 1.4 1999/04/16 01:51:40 stanton Exp $
d95 1
a96 1
destroy .s
d798 14
@


1.4
log
@* Merged 8.1 branch into the main trunk
@
text
@d9 1
a9 1
# RCS: @@(#) $Id$
d399 1
a399 1
test scale-7.1 {ComputeScaleGeometry procedure} {fonts} {
d429 1
a429 1
test scale-7.5 {ComputeScaleGeometry procedure} {fonts} {
@


1.4.2.1
log
@
Merged with mainline.
@
text
@d9 1
a9 1
# RCS: @@(#) $Id: scale.test,v 1.6 1999/04/20 01:04:04 rjohnson Exp $
d95 1
a96 1

d399 1
a399 1
test scale-7.1 {ComputeScaleGeometry procedure} {nonPortable fonts} {
d429 1
a429 1
test scale-7.5 {ComputeScaleGeometry procedure} {nonPortable fonts} {
a797 14

test scale-17.1 {bug fix 1786} {
    # Perhaps x is set to {}, depending on what other tests have run.
    # If x is unset, or set to something not convertable to a double,
    # then the scale try to initialize its value with the contents
    # of uninitialized memory.  Sometimes that causes an FPE.

    set x {}
    scale .s -from 100 -to 300
    pack .s
    update
    .s configure -variable x   ;# CRASH! -> Floating point exception
    set x
} {}
@


1.3
log
@fixed broken tests
@
text
@d6 2
d9 1
a9 4
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
#
# RCS: @@(#) $Id: scale.test,v 1.2 1998/09/14 18:23:49 stanton Exp $
d11 2
a12 2
if {[info procs test] != "test"} {
    source defs
d58 1
a58 1
	    {bad orientation "badValue": must be vertical or horizontal}}
d60 1
a60 1
    {-relief ridge ridge badValue {bad relief type "badValue": must be flat, groove, raised, ridge, solid, or sunken}}
d67 1
a67 1
    {-sliderrelief raised raised badValue {bad relief type "badValue": must be flat, groove, raised, ridge, solid, or sunken}}
d69 1
a69 1
	    {bad state value "badValue": must be normal, active, or disabled}}
d214 1
a214 1
} {1 {bad option "c": must be cget, configure, coords, get, identify, or set}}
d217 1
a217 1
} {1 {bad option "co": must be cget, configure, coords, get, identify, or set}}
d272 1
a272 1
} {1 {bad orientation "dumb": must be vertical or horizontal}}
d290 1
a290 1
} {1 {bad state value "bogus": must be normal, active, or disabled}}
d362 1
a362 1
} 1
d372 1
a372 1
} 1
d377 1
a377 1
} 1
d801 17
@


1.2
log
@Replaced SCCS strings, fixed binary files
@
text
@d10 1
a10 1
# RCS: @@(#) $Id$
d332 2
a333 2
    .s get
} {5.0e+09}
d362 2
a363 2
    .s get
} {6.0e-06}
d372 2
a373 2
    .s get
} {6.0e-06}
d377 2
a378 2
    .s get
} {6e-05}
@


1.1
log
@Initial revision
@
text
@d10 1
a10 1
# SCCS: @@(#) scale.test 1.28 97/07/31 10:20:43
@


1.1.4.1
log
@initial tk8.1a2 version
@
text
@d10 1
a10 1
# SCCS: @@(#) scale.test 1.29 98/01/02 17:43:57
d332 2
a333 2
    expr {[.s get] == 5.0e+09}
} {1}
d362 2
a363 2
    expr {[.s get] == 6.0e-06}
} {1}
d372 2
a373 2
    expr {[.s get] == 6.0e-06}
} {1}
d377 2
a378 2
    expr {[.s get] == 6e-05}
} {1}
@


1.1.4.2
log
@Merged 8.0.3 changes into 8.1
@
text
@d10 1
a10 1
# RCS: @@(#) $Id: scale.test,v 1.2 1998/09/14 18:23:49 stanton Exp $
@


1.1.4.3
log
@* integrated tk8.0.4 changes.

* generic/tkBind.c: fixed deletion order bug where a crash would
result if a binding deleted "."
@
text
@d10 1
a10 1
# RCS: @@(#) $Id: scale.test,v 1.1.4.2 1998/09/30 02:18:53 stanton Exp $
d333 1
a333 1
} 1
@


1.1.4.4
log
@Eliminated last stronghold of static data in the Tk core...until the next one.
@
text
@d10 1
a10 1
# RCS: @@(#) $Id: scale.test,v 1.1.4.3 1998/11/25 21:16:40 stanton Exp $
d59 1
a59 1
	    {bad orient "badValue": must be horizontal or vertical}}
d61 1
a61 1
    {-relief ridge ridge badValue {bad relief "badValue": must be flat, groove, raised, ridge, solid, or sunken}}
d68 1
a68 1
    {-sliderrelief raised raised badValue {bad relief "badValue": must be flat, groove, raised, ridge, solid, or sunken}}
d70 1
a70 1
	    {bad state "badValue": must be active, disabled, or normal}}
d215 1
a215 1
} {1 {ambiguous option "c": must be cget, configure, coords, get, identify, or set}}
d218 1
a218 1
} {1 {ambiguous option "co": must be cget, configure, coords, get, identify, or set}}
d273 1
a273 1
} {1 {bad orient "dumb": must be horizontal or vertical}}
d291 1
a291 1
} {1 {bad state "bogus": must be active, disabled, or normal}}
@


1.1.4.5
log
@Updated the testsuite to use "test" namespace and commandline args
to control verbose  level and which tests get run.  Tests now work from
any working dir.
@
text
@a5 2
# Copyright (c) 1998-1999 by Scriptics Corporation.
# All rights reserved.
d7 4
a10 1
# RCS: @@(#) $Id: scale.test,v 1.1.4.4 1999/02/16 11:39:35 lfb Exp $
d12 2
a13 2
if {[lsearch [namespace children] ::test] == -1} {
    source [file join [pwd] [file dirname [info script]] defs.tcl]
a801 4

# cleanup
::test::cleanupTests
return
@


1.1.4.6
log
@- changed ::test to ::tcltest
- made many tests more atomic (still more work to do here)
- defs.tcl is now identicle for tcl and tk
@
text
@d9 1
a9 1
# RCS: @@(#) $Id: scale.test,v 1.1.4.5 1999/03/11 18:51:06 hershey Exp $
d11 1
a11 1
if {[lsearch [namespace children] ::tcltest] == -1} {
d803 1
a803 1
::tcltest::cleanupTests
a804 12












@


1.1.4.7
log
@lint:  changed a tcltest namespace variable name from tmpDir to
       workingDir.
changes:  made more tests atomic.
README is now updated to match new test suite features.
@
text
@d9 1
a9 1
# RCS: @@(#) $Id: scale.test,v 1.1.4.6 1999/03/24 01:17:03 hershey Exp $
a804 1

@


