tests/bugs.tcl


1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41

# This file is a Tcl script to test out various known bugs that will
# cause Tk to crash.  This file ends with .tcl instead of .test to make
# sure it isn't run when you type "source all".  We currently are not 
# shipping this file with the rest of the source release.
#
# Copyright (c) 1996 Sun Microsystems, Inc.
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.

if {[info procs test] != "test"} {
    source defs
}

test crash-1.0 {imgPhoto} {
    image create photo p1
    image create photo p2
    catch {image create photo p2 -file bogus}
    p1 copy p2
    label .l -image p1
    destroy .l
    set foo ""
} {}

test crash-1.1 {color} {
    . configure -bg rgb:345
    set foo ""
} {}