head	1.8;
access;
symbols
	core-8-5-9:1.8
	core-8-5-8:1.8
	macosx-cocoa-merge:1.8
	macosx-cocoa-premerge:1.8
	macosx-carbon-freeze:1.8
	core-8-5-7:1.8
	core-8-5-6:1.8
	core-8-6-b1:1.8
	core-8-6-a3:1.8
	core-8-5-5:1.8
	core-8-6-a2:1.8
	core-8-5-4:1.8
	core-8-5-3:1.8
	core-8-6-a1:1.8
	core-8-4-19:1.6
	core-8-5-branch:1.8.0.4
	core-8-5-2:1.8
	core-8-4-18:1.6
	core-8-5-1:1.8
	core-8-4-17:1.6
	core-8-5-0:1.8
	core-8-5-b3:1.8
	core-8-5-b2:1.8
	core-8-4-16:1.6
	core-8-5-b1:1.8
	core-stablilizer-merge:1.8
	core-stabilizer-branch:1.8.0.2
	core-stabilizer-merge:1.8
	core-8-4-15:1.6
	core-8-5-a6:1.8
	core-8-5-a5:1.8
	core-8-4-14:1.6
	core-8-5-a4:1.8
	core-8-4-13:1.6
	core-8-4-12:1.6
	core-8-4-11:1.6
	core-8-5-a3:1.8
	core-8-4-10:1.6
	core-8-4-9-branch:1.6.0.4
	core-8-5-a2:1.8
	core-8-4-9:1.6
	core-8-4-8:1.6
	core-8-4-7:1.6
	core-8-5-a1:1.7
	core-8-4-6:1.6
	core-8-4-5:1.6
	mistachkin-dev-branch:1.7.0.2
	core-8-4-4:1.6
	core-8-4-3:1.6
	core-8-4-branch:1.6.0.2
	core-8-4-2:1.6
	core-8-4-1:1.6
	core-8-3-5:1.4.2.1
	core-8-4-0:1.6
	macosx-8-4-merge-2002-08-31-trunk:1.6
	macosx-8-4-premerge-2002-08-31-branch:1.5.6.1
	macosx-8-4-premerge-2002-08-31-trunk:1.6
	macosx-8-4-merge-2002-08-30-branch:1.5.6.1
	macosx-8-4-merge-2002-08-30-trunk:1.6
	macosx-8-4-merge-2002-08-20-branch:1.5.6.1
	macosx-8-4-merge-2002-08-20-trunk:1.6
	core-8-4-b2:1.6
	core-8-4-b1:1.5
	macosx-premerge-6-9-02:1.5
	core-8-4-a4:1.5
	core-8-3-4:1.4.2.1
	macosx-8-4-branch:1.5.0.6
	macosx-8-4-branchpoint:1.5
	core-8-4-a3:1.5
	core-8-3-3:1.4.2.1
	dgp-privates-into-namespace:1.5.0.4
	tclpro-1-5-0:1.4
	core-8-4-win-speedup:1.5.0.2
	core-8-4-a2:1.5
	tclpro-1-4-1:1.4
	tclpro-1-4-0:1.4
	core-8-3-2:1.4
	ajuba-ajuba2-2-1-base:1.4
	ajuba-ajuba2-2-0:1.4
	core-8-4-a1:1.4
	core-8-3-1-branch:1.4.0.2
	core-8-3-1:1.4
	scriptics-sc-2-0-b5:1.4
	scriptics-sc-2-0-fixed:1.4
	scriptics-sc-2-0-b2:1.4
	scriptics-sc-2-0-b1:1.4
	core-8-3-0:1.3
	core-8-3-b2:1.3
	core-8-3-b1:1.3
	scriptics-sc-1-1:1.3
	scriptics-sc-1-1-b1:1.3
	core-8-2-3:1.3
	scriptics-sc-1-1-branch:1.3.0.10
	scriptics-sc-1-1-base:1.3
	scriptics-sc-1-0:1.3
	scriptics-sc-1-0-branch:1.3.0.8
	scriptics-sc-1-0-base:1.3
	core-8-2-2:1.3
	core-8-2-1:1.3
	scriptics-bc-1-0-b1:1.3
	core-8-2-1-branch:1.3.0.6
	scriptics-tclpro-1-3-0:1.3
	core-8-2-0:1.3
	core-8-2-b3-branch:1.3.0.4
	core-8-2-b3-base:1.3
	scriptics-tclpro-1-3-b4:1.3
	core-8-2-b2:1.3
	scriptics-tclpro-1-3-b3:1.3
	core-8-2-b1:1.3
	scriptics-tclpro-1-3-b2:1.3
	merge-to-mainline-5/21/99:1.3
	scriptics-tclpro-1-3-b2-branch:1.3.0.2
	core-8-1-1:1.3
	scriptics-tclpro-1-3-b1:1.3
	core-8-1-1-base:1.3
	core-8-1-0:1.3
	merge-to-mainline-4-29-99:1.3
	merge-to-mainline-4-23-99:1.3
	core-8-1-branch-old:1.1.0.4
	core-8-0-6-branch:1.2.0.6
	core-8-0-6-base:1.2
	core-8-0-5:1.2
	core-8-1-b3:1.1.4.7
	core-8-1-b2:1.1.4.3
	dev-8-1-stubs-branch:1.1.4.2.0.2
	dev-stubs-branch:1.2.0.4
	scriptics-tclpro-1-2:1.2
	scriptics-tclpro-1-2-b2:1.2
	core-8-1-merge-2/10/99:1.2
	core-8-0-5-branch:1.2.0.2
	core-8-0-5-base:1.2
	scriptics-tclpro-1-2-b1:1.2
	scriptics-tclpro-1-2-a1:1.2
	core-8-1-b1:1.1.4.2
	core-8-0-4:1.2
	core-8-1-a2:1.1.4.1
	core-8-0-2:1.1
	core-8-0-3:1.2;
locks; strict;
comment	@# @;


1.8
date	2004.06.17.22.38.57;	author dkf;	state Exp;
branches;
next	1.7;

1.7
date	2003.04.01.21.06.20;	author dgp;	state Exp;
branches;
next	1.6;

1.6
date	2002.07.14.05.48.46;	author dgp;	state Exp;
branches;
next	1.5;

1.5
date	2000.11.02.01.18.35;	author hobbs;	state Exp;
branches
	1.5.6.1;
next	1.4;

1.4
date	2000.03.02.23.52.55;	author hobbs;	state Exp;
branches
	1.4.2.1;
next	1.3;

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

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

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

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

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

1.1.4.3
date	99.03.11.18.50.44;	author hershey;	state Exp;
branches;
next	1.1.4.4;

1.1.4.4
date	99.03.24.01.16.41;	author hershey;	state Exp;
branches;
next	1.1.4.5;

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

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

1.1.4.7
date	99.04.06.05.20.12;	author rjohnson;	state Exp;
branches;
next	;

1.4.2.1
date	2001.04.04.07.57.17;	author hobbs;	state Exp;
branches;
next	;

1.5.6.1
date	2002.08.20.20.27.13;	author das;	state Exp;
branches;
next	;


desc
@@


1.8
log
@Steps towards systematization of test constraints in Tk test suite
@
text
@# This file is a Tcl script to test out the procedures in the file
# tkColor.c.  It is organized in the standard fashion for Tcl tests.
#
# Copyright (c) 1995-1998 Sun Microsystems, Inc.
# Copyright (c) 1998-1999 by Scriptics Corporation.
# All rights reserved.
#
# RCS: @@(#) $Id: color.test,v 1.7 2003/04/01 21:06:20 dgp Exp $

package require tcltest 2.1
eval tcltest::configure $argv
tcltest::loadTestedCommands

# cname --
# Returns a proper name for a color, given its intensities.
#
# Arguments:
# r, g, b -	Intensities on a 0-255 scale.

proc cname {r g b} {
    format #%02x%02x%02x $r $g $b
}
proc cname4 {r g b} {
    format #%04x%04x%04x $r $g $b
}

# mkColors --
# Creates a canvas and fills it with a 2-D array of squares, each of a
# different color.
#
# Arguments:
# c -		Name of canvas window to create.
# width -	Number of squares in each row.
# height -	Number of squares in each column.
# r, g, b -	Initial value for red, green, and blue intensities.
# rx, gx, bx -	Change in intensities between adjacent elements in row.
# ry, gy, by -	Change in intensities between adjacent elements in column.

proc mkColors {c width height r g b rx gx bx ry gy by} {
    catch {destroy $c}
    canvas $c -width 400 -height 200 -bd 0
    for {set y 0} {$y < $height} {incr y} {
	for {set x 0} {$x < $width} {incr x} {
	    set color [format #%02x%02x%02x [expr $r + $y*$ry + $x*$rx] \
		    [expr $g + $y*$gy + $x*$gx] [expr $b + $y*$by + $x*$bx]]
	    $c create rectangle [expr 10*$x] [expr 20*$y] \
		    [expr 10*$x + 10] [expr 20*$y + 20] -outline {} \
		    -fill $color
	}
    }
}

# closest -
# Given intensities between 0 and 255, return the closest intensities
# that the server can provide.
#
# Arguments:
# w -		Window in which to lookup color
# r, g, b -	Desired intensities, between 0 and 255.

proc closest {w r g b} {
    set vals [winfo rgb $w [cname $r $g $b]]
    list [expr [lindex $vals 0]/256] [expr [lindex $vals 1]/256] \
	    [expr [lindex $vals 2]/256]
}

# c255  -
# Given a list of red, green, and blue intensities, scale them
# down to a 0-255 range.
#
# Arguments:
# vals -	List of intensities.

proc c255 {vals} {
    list [expr [lindex $vals 0]/256] [expr [lindex $vals 1]/256] \
	    [expr [lindex $vals 2]/256]
}

# colorsFree --
#
# Returns 1 if there appear to be free colormap entries in a window,
# 0 otherwise.
#
# Arguments:
# w -			Name of window in which to check.
# red, green, blue -	Intensities to use in a trial color allocation
#			to see if there are colormap entries free.

proc colorsFree {w {red 31} {green 245} {blue 192}} {
    set vals [winfo rgb $w [format #%02x%02x%02x $red $green $blue]]
    expr ([lindex $vals 0]/256 == $red) && ([lindex $vals 1]/256 == $green) \
	    && ([lindex $vals 2]/256 == $blue)
}

if {[testConstraint psuedocolor8]} {
    toplevel .t -visual {pseudocolor 8} -colormap new
    wm geom .t +0+0
    mkColors .t.c 40 6 0 0 0 0 6 0 0 0 40
    pack .t.c
    update

    testConstraint colorsFree [colorsFree .t.c 101 233 17]

    if {[testConstraint colorsFree]} {
	mkColors .t.c2 20 1 250 0 0 -10 0 0 0 0 0
	pack .t.c2
	testConstraint colorsFree [expr {![colorsFree .t.c]}]
    }
    destroy .t.c .t.c2
}

test color-1.1 {Tk_AllocColorFromObj - converting internal reps} colorsFree {
    set x green
    lindex $x 0
    destroy .b1
    button .b1 -foreground $x -text .b1
    lindex $x 0
    testcolor green
} {{1 0}}
test color-1.2 {Tk_AllocColorFromObj - discard stale color} colorsFree {
    set x green
    destroy .b1 .b2
    button .b1 -foreground $x -text First
    destroy .b1
    set result {}
    lappend result [testcolor green]
    button .b2 -foreground $x -text Second
    lappend result [testcolor green]
} {{} {{1 1}}}
test color-1.3 {Tk_AllocColorFromObj - reuse existing color} colorsFree {
    set x green
    destroy .b1 .b2
    button .b1 -foreground $x -text First
    set result {}
    lappend result [testcolor green]
    button .b2 -foreground $x -text Second
    pack .b1 .b2 -side top
    lappend result [testcolor green]
} {{{1 1}} {{2 1}}}
test color-1.4 {Tk_AllocColorFromObj - try other colors in list} colorsFree {
    set x purple
    destroy .b1 .b2 .t.b
    button .b1 -foreground $x -text First
    pack .b1 -side top
    set result {}
    lappend result [testcolor purple]
    button .t.b -foreground $x -text Second
    pack .t.b -side top
    lappend result [testcolor purple]
    button .b2 -foreground $x -text Third
    pack .b2 -side top
    lappend result [testcolor purple]
} {{{1 1}} {{1 1} {1 0}} {{1 0} {2 1}}}

test color-2.1 {Tk_GetColor procedure} colorsFree {
    c255 [winfo rgb .t #FF0000]
} {255 0 0}
test color-2.2 {Tk_GetColor procedure} colorsFree {
    list [catch {winfo rgb .t noname} msg] $msg
} {1 {unknown color name "noname"}}
test color-2.3 {Tk_GetColor procedure} colorsFree {
    c255 [winfo rgb .t #123456]
} {18 52 86}
test color-2.4 {Tk_GetColor procedure} colorsFree {
    list [catch {winfo rgb .t #xyz} msg] $msg
} {1 {invalid color name "#xyz"}}
test color-2.5 {Tk_GetColor procedure} colorsFree {
    winfo rgb .t #00FF00
} {0 65535 0}
test color-2.6 {Tk_GetColor procedure} {colorsFree nonPortable} {
    # Red doesn't always map to *pure* red
    winfo rgb .t red
} {65535 0 0}
test color-2.7 {Tk_GetColor procedure} colorsFree {
    winfo rgb .t #ff0000
} {65535 0 0}

test color-3.1 {Tk_FreeColor procedure, reference counting} colorsFree {
    eval destroy [winfo child .t]
    mkColors .t.c 40 6 0 240 240 0 -6 0 0 0 -40
    pack .t.c
    mkColors .t.c2 20 1 250 0 0 -10 0 0 0 0 0
    pack .t.c2
    update
    set last [.t.c2 create rectangle 50 50 70 60 -outline {} \
	    -fill [cname 0 240 240]]
    .t.c delete 1
    set result [colorsFree .t]
    .t.c2 delete $last
    lappend result [colorsFree .t]
} {0 1}
test color-3.2 {Tk_FreeColor procedure, flushing stressed cmap information} colorsFree {
    eval destroy [winfo child .t]
    mkColors .t.c 40 6 0 240 240 0 -6 0 0 0 -40
    pack .t.c
    mkColors .t.c2 20 1 250 0 0 -10 0 0 0 0 0
    mkColors .t.c2 20 1 250 250 0 -10 -10 0 0 0 0
    pack .t.c2
    update
    closest .t 241 241 1
} {240 240 0}
test color-3.3 {Tk_FreeColorFromObj - reference counts} colorsFree {
    set x purple
    destroy .b1 .b2 .t.b
    button .b1 -foreground $x -text First
    pack .b1 -side top
    button .t.b -foreground $x -text Second
    pack .t.b -side top
    button .b2 -foreground $x -text Third
    pack .b2 -side top
    set result {}
    lappend result [testcolor purple]
    destroy .b1
    lappend result [testcolor purple]
    destroy .b2
    lappend result [testcolor purple]
    destroy .t.b
    lappend result [testcolor purple]
} {{{1 0} {2 1}} {{1 0} {1 1}} {{1 0}} {}}
test color-3.4 {Tk_FreeColorFromObj - unlinking from list} colorsFree {
    destroy .b .t.b .t2 .t3
    toplevel .t2 -visual {pseudocolor 8} -colormap new
    toplevel .t3 -visual {pseudocolor 8} -colormap new
    set x purple
    button .b -foreground $x -text .b1
    button .t.b1 -foreground $x -text .t.b1
    button .t.b2 -foreground $x -text .t.b2
    button .t2.b1 -foreground $x -text .t2.b1
    button .t2.b2 -foreground $x -text .t2.b2
    button .t2.b3 -foreground $x -text .t2.b3
    button .t3.b1 -foreground $x -text .t3.b1
    button .t3.b2 -foreground $x -text .t3.b2
    button .t3.b3 -foreground $x -text .t3.b3
    button .t3.b4 -foreground $x -text .t3.b4
    set result {}
    lappend result [testcolor purple]
    destroy .t2
    lappend result [testcolor purple]
    destroy .b
    lappend result [testcolor purple]
    destroy .t3
    lappend result [testcolor purple]
    destroy .t
    lappend result [testcolor purple]
} {{{4 1} {3 0} {2 0} {1 0}} {{4 1} {2 0} {1 0}} {{4 1} {2 0}} {{2 0}} {}}

test color-4.1 {FreeColorObjProc} colorsFree {
    destroy .b
    set x [format purple]
    button .b -foreground $x -text .b1
    set y [format purple]
    .b configure -foreground $y
    set z [format purple]
    .b configure -foreground $z
    set result {}
    lappend result [testcolor purple]
    set x red
    lappend result [testcolor purple]
    set z 32
    lappend result [testcolor purple]
    destroy .b
    lappend result [testcolor purple]
    set y bogus
    set result
} {{{1 3}} {{1 2}} {{1 1}} {}}

destroy .t

# cleanup
cleanupTests
return
@


1.7
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
@d8 1
a8 1
# RCS: @@(#) $Id: color.test,v 1.6 2002/07/14 05:48:46 dgp Exp $
a13 2
testConstraint testcolor [llength [info commands testcolor]]

@


1.6
log
@	* Completed conversion of Tk test suite to use tcltest.
@
text
@d8 1
a8 1
# RCS: @@(#) $Id: color.test,v 1.5 2000/11/02 01:18:35 hobbs Exp $
d11 1
a11 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]
d272 1
a272 1
::tcltest::cleanupTests
@


1.5
log
@	* tests/color.test: marked color-2.6 nonPortable as we can't
	reliably assume what 'red' maps to.
@
text
@d8 1
a8 1
# RCS: @@(#) $Id: color.test,v 1.4 2000/03/02 23:52:55 hobbs Exp $
d10 6
a15 9
if {[lsearch [namespace children] ::tcltest] == -1} {
    source [file join [pwd] [file dirname [info script]] defs.tcl]
}

if {[info commands testcolor] != "testcolor"} {
    puts "testcolor command not available; skipping tests"
    ::tcltest::cleanupTests
    return
}
d17 1
a17 3
eval destroy [winfo children .]
wm geometry . {}
raise .
d100 15
a114 29
# Create a top-level with its own colormap (so we can test under
# controlled conditions), then check to make sure that the visual
# is color-mapped with 256 colors.  If not, just skip this whole
# test file.

if [catch {toplevel .t -visual {pseudocolor 8} -colormap new}] {
    ::tcltest::cleanupTests
    return
}
wm geom .t +0+0
if {[winfo depth .t] != 8} {
    destroy .t
    ::tcltest::cleanupTests
    return
}
mkColors .t.c 40 6 0 0 0 0 6 0 0 0 40
pack .t.c
update
if ![colorsFree .t.c 101 233 17] {
    destroy .t
    ::tcltest::cleanupTests
    return
}
mkColors .t.c2 20 1 250 0 0 -10 0 0 0 0 0
pack .t.c2
if [colorsFree .t.c] {
    destroy .t
    ::tcltest::cleanupTests
    return
a115 1
destroy .t.c .t.c2
d117 1
a117 1
test color-1.1 {Tk_AllocColorFromObj - converting internal reps} {
d125 1
a125 1
test color-1.2 {Tk_AllocColorFromObj - discard stale color} {
d135 1
a135 1
test color-1.3 {Tk_AllocColorFromObj - reuse existing color} {
d145 1
a145 1
test color-1.4 {Tk_AllocColorFromObj - try other colors in list} {
d160 1
a160 1
test color-2.1 {Tk_GetColor procedure} {
d163 1
a163 1
test color-2.2 {Tk_GetColor procedure} {
d166 1
a166 1
test color-2.3 {Tk_GetColor procedure} {
d169 1
a169 1
test color-2.4 {Tk_GetColor procedure} {
d172 1
a172 1
test color-2.5 {Tk_GetColor procedure} {
d175 1
a175 1
test color-2.6 {Tk_GetColor procedure} {nonPortable} {
d179 1
a179 1
test color-2.7 {Tk_GetColor procedure} {
d183 1
a183 1
test color-3.1 {Tk_FreeColor procedure, reference counting} {
d197 1
a197 1
test color-3.2 {Tk_FreeColor procedure, flushing stressed cmap information} {
d207 1
a207 1
test color-3.3 {Tk_FreeColorFromObj - reference counts} {
d225 1
a225 1
test color-3.4 {Tk_FreeColorFromObj - unlinking from list} {
d252 1
a252 1
test color-4.1 {FreeColorObjProc} {
@


1.5.6.1
log
@merged with trunk at tag macosx-8-4-merge-2002-08-20-trunk
@
text
@d8 1
a8 1
# RCS: @@(#) $Id$
d10 9
a18 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
d20 3
a22 1
testConstraint testcolor [llength [info commands testcolor]]
d105 29
a133 15
if {[testConstraint psuedocolor8]} {
    toplevel .t -visual {pseudocolor 8} -colormap new
    wm geom .t +0+0
    mkColors .t.c 40 6 0 0 0 0 6 0 0 0 40
    pack .t.c
    update

    testConstraint colorsFree [colorsFree .t.c 101 233 17]

    if {[testConstraint colorsFree]} {
	mkColors .t.c2 20 1 250 0 0 -10 0 0 0 0 0
	pack .t.c2
	testConstraint colorsFree [expr {![colorsFree .t.c]}]
    }
    destroy .t.c .t.c2
d135 1
d137 1
a137 1
test color-1.1 {Tk_AllocColorFromObj - converting internal reps} colorsFree {
d145 1
a145 1
test color-1.2 {Tk_AllocColorFromObj - discard stale color} colorsFree {
d155 1
a155 1
test color-1.3 {Tk_AllocColorFromObj - reuse existing color} colorsFree {
d165 1
a165 1
test color-1.4 {Tk_AllocColorFromObj - try other colors in list} colorsFree {
d180 1
a180 1
test color-2.1 {Tk_GetColor procedure} colorsFree {
d183 1
a183 1
test color-2.2 {Tk_GetColor procedure} colorsFree {
d186 1
a186 1
test color-2.3 {Tk_GetColor procedure} colorsFree {
d189 1
a189 1
test color-2.4 {Tk_GetColor procedure} colorsFree {
d192 1
a192 1
test color-2.5 {Tk_GetColor procedure} colorsFree {
d195 1
a195 1
test color-2.6 {Tk_GetColor procedure} {colorsFree nonPortable} {
d199 1
a199 1
test color-2.7 {Tk_GetColor procedure} colorsFree {
d203 1
a203 1
test color-3.1 {Tk_FreeColor procedure, reference counting} colorsFree {
d217 1
a217 1
test color-3.2 {Tk_FreeColor procedure, flushing stressed cmap information} colorsFree {
d227 1
a227 1
test color-3.3 {Tk_FreeColorFromObj - reference counts} colorsFree {
d245 1
a245 1
test color-3.4 {Tk_FreeColorFromObj - unlinking from list} colorsFree {
d272 1
a272 1
test color-4.1 {FreeColorObjProc} colorsFree {
@


1.4
log
@	* tests/color.test:
	* xlib/xcolors.c (XParseColor FindColor):
	* win/tkWinColor.c (XAllocColor): Fixed bit fiddling for colors to
	return "correct" values for color mapping. [Bug: 4282]
@
text
@d8 1
a8 1
# RCS: @@(#) $Id: color.test,v 1.3 1999/04/16 01:51:36 stanton Exp $
d195 2
a196 1
test color-2.6 {Tk_GetColor procedure} {
d198 3
@


1.4.2.1
log
@see ChangeLog for specific file details
@
text
@d8 1
a8 1
# RCS: @@(#) $Id: color.test,v 1.5 2000/11/02 01:18:35 hobbs Exp $
d195 1
a195 2
test color-2.6 {Tk_GetColor procedure} {nonPortable} {
    # Red doesn't always map to *pure* red
a196 3
} {65535 0 0}
test color-2.7 {Tk_GetColor procedure} {
    winfo rgb .t #ff0000
@


1.3
log
@* Merged 8.1 branch into the main trunk
@
text
@d8 1
a8 1
# RCS: @@(#) $Id$
d192 6
a292 13













@


1.2
log
@Replaced SCCS strings, fixed binary files
@
text
@d4 3
a6 4
# Copyright (c) 1995 Sun Microsystems, Inc.
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
d10 8
a17 2
if {[info procs test] != "test"} {
    source defs
d111 1
d117 1
d125 1
d132 1
d137 45
a181 2
test color-1.1 {Tk_GetColor procedure} {
    c255 [winfo rgb .t red]
d183 1
a183 1
test color-1.2 {Tk_GetColor procedure} {
d186 1
a186 2

test color-1.3 {Tk_GetColor procedure} {
d189 1
a189 1
test color-1.4 {Tk_GetColor procedure} {
d193 1
a193 1
test color-2.1 {Tk_FreeColor procedure, reference counting} {
d207 1
a207 1
test color-2.2 {Tk_FreeColor procedure, flushing stressed cmap information} {
d217 64
d283 17
@


1.1
log
@Initial revision
@
text
@d9 1
a9 1
# SCCS: @@(#) color.test 1.5 96/02/16 10:56:05
@


1.1.4.1
log
@initial tk8.1a2 version
@
text
@d4 1
a4 1
# Copyright (c) 1995-1998 Sun Microsystems, Inc.
d9 1
a9 1
# SCCS: @@(#) color.test 1.7 98/01/12 13:23:09
a14 5
if {[info commands testcolor] != "testcolor"} {
    puts "testcolor command not available; skipping tests"
    return
}

d128 1
a128 44
test color-1.1 {Tk_AllocColorFromObj - converting internal reps} {
    set x green
    lindex $x 0
    destroy .b1
    button .b1 -foreground $x -text .b1
    lindex $x 0
    testcolor green
} {{1 0}}
test color-1.2 {Tk_AllocColorFromObj - discard stale color} {
    set x green
    destroy .b1 .b2
    button .b1 -foreground $x -text First
    destroy .b1
    set result {}
    lappend result [testcolor green]
    button .b2 -foreground $x -text Second
    lappend result [testcolor green]
} {{} {{1 1}}}
test color-1.3 {Tk_AllocColorFromObj - reuse existing color} {
    set x green
    destroy .b1 .b2
    button .b1 -foreground $x -text First
    set result {}
    lappend result [testcolor green]
    button .b2 -foreground $x -text Second
    pack .b1 .b2 -side top
    lappend result [testcolor green]
} {{{1 1}} {{2 1}}}
test color-1.4 {Tk_AllocColorFromObj - try other colors in list} {
    set x purple
    destroy .b1 .b2 .t.b
    button .b1 -foreground $x -text First
    pack .b1 -side top
    set result {}
    lappend result [testcolor purple]
    button .t.b -foreground $x -text Second
    pack .t.b -side top
    lappend result [testcolor purple]
    button .b2 -foreground $x -text Third
    pack .b2 -side top
    lappend result [testcolor purple]
} {{{1 1}} {{1 1} {1 0}} {{1 0} {2 1}}}

test color-2.1 {Tk_GetColor procedure} {
d131 1
a131 1
test color-2.2 {Tk_GetColor procedure} {
d134 2
a135 1
test color-2.3 {Tk_GetColor procedure} {
d138 1
a138 1
test color-2.4 {Tk_GetColor procedure} {
d142 1
a142 1
test color-3.1 {Tk_FreeColor procedure, reference counting} {
d156 1
a156 1
test color-3.2 {Tk_FreeColor procedure, flushing stressed cmap information} {
a165 64
test color-3.3 {Tk_FreeColorFromObj - reference counts} {
    set x purple
    destroy .b1 .b2 .t.b
    button .b1 -foreground $x -text First
    pack .b1 -side top
    button .t.b -foreground $x -text Second
    pack .t.b -side top
    button .b2 -foreground $x -text Third
    pack .b2 -side top
    set result {}
    lappend result [testcolor purple]
    destroy .b1
    lappend result [testcolor purple]
    destroy .b2
    lappend result [testcolor purple]
    destroy .t.b
    lappend result [testcolor purple]
} {{{1 0} {2 1}} {{1 0} {1 1}} {{1 0}} {}}
test color-3.4 {Tk_FreeColorFromObj - unlinking from list} {
    destroy .b .t.b .t2 .t3
    toplevel .t2 -visual {pseudocolor 8} -colormap new
    toplevel .t3 -visual {pseudocolor 8} -colormap new
    set x purple
    button .b -foreground $x -text .b1
    button .t.b1 -foreground $x -text .t.b1
    button .t.b2 -foreground $x -text .t.b2
    button .t2.b1 -foreground $x -text .t2.b1
    button .t2.b2 -foreground $x -text .t2.b2
    button .t2.b3 -foreground $x -text .t2.b3
    button .t3.b1 -foreground $x -text .t3.b1
    button .t3.b2 -foreground $x -text .t3.b2
    button .t3.b3 -foreground $x -text .t3.b3
    button .t3.b4 -foreground $x -text .t3.b4
    set result {}
    lappend result [testcolor purple]
    destroy .t2
    lappend result [testcolor purple]
    destroy .b
    lappend result [testcolor purple]
    destroy .t3
    lappend result [testcolor purple]
    destroy .t
    lappend result [testcolor purple]
} {{{4 1} {3 0} {2 0} {1 0}} {{4 1} {2 0} {1 0}} {{4 1} {2 0}} {{2 0}} {}}

test color-4.1 {FreeColorObjProc} {
    destroy .b
    set x [format purple]
    button .b -foreground $x -text .b1
    set y [format purple]
    .b configure -foreground $y
    set z [format purple]
    .b configure -foreground $z
    set result {}
    lappend result [testcolor purple]
    set x red
    lappend result [testcolor purple]
    set z 32
    lappend result [testcolor purple]
    destroy .b
    lappend result [testcolor purple]
    set y bogus
    set result
} {{{1 3}} {{1 2}} {{1 1}} {}}
@


1.1.4.2
log
@Merged 8.0.3 changes into 8.1
@
text
@d9 1
a9 1
# RCS: @@(#) $Id: color.test,v 1.2 1998/09/14 18:23:45 stanton Exp $
@


1.1.4.3
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
@a4 2
# Copyright (c) 1998-1999 by Scriptics Corporation.
# All rights reserved.
d6 8
a13 1
# RCS: @@(#) $Id: color.test,v 1.1.4.2 1998/09/30 02:18:32 stanton Exp $
a19 4
if {[lsearch [namespace children] ::test] == -1} {
    source [file join [pwd] [file dirname [info script]] defs.tcl]
}

a278 4

# cleanup
::test::cleanupTests
return
@


1.1.4.4
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
@d8 1
a8 1
# RCS: @@(#) $Id: color.test,v 1.1.4.3 1999/03/11 18:50:44 hershey Exp $
d15 1
a15 1
if {[lsearch [namespace children] ::tcltest] == -1} {
d280 1
a280 1
::tcltest::cleanupTests
a281 12












@


1.1.4.5
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
@d8 1
a8 1
# RCS: @@(#) $Id: color.test,v 1.1.4.4 1999/03/24 01:16:41 hershey Exp $
a281 1

@


1.1.4.6
log
@Now all test files that skip tests by returning early (which ideally they
shouldn't do) call ::tcltest::cleanupTests before returning.  The defs.tcl
file has one hew constraint:  userInteraction, used by tests that require
user interaction.  The next putback will include an updated version of the
"visual" test file to use this mechanism.
@
text
@d8 1
a8 5
# RCS: @@(#) $Id: color.test,v 1.1.4.5 1999/03/24 02:54:36 hershey Exp $

if {[lsearch [namespace children] ::tcltest] == -1} {
    source [file join [pwd] [file dirname [info script]] defs.tcl]
}
a11 1
    ::tcltest::cleanupTests
d15 4
a109 1
    ::tcltest::cleanupTests
a114 1
    ::tcltest::cleanupTests
a121 1
    ::tcltest::cleanupTests
a127 1
    ::tcltest::cleanupTests
@


1.1.4.7
log
@
Apparently red is not the same as #FF0000 on all platforms!
Fixed test to not rely on that fact.
@
text
@d8 1
a8 1
# RCS: @@(#) $Id: color.test,v 1.1.4.6 1999/03/26 00:07:53 hershey Exp $
d181 1
a181 1
    c255 [winfo rgb .t #FF0000]
@


