update to tcl/tk 8.6.7

1 files changed, 0 insertions, 626 deletions

diff --git a/tk8.6/tests/image.test b/tk8.6/tests/image.test
deleted file mode 100644
index 3134ee8..0000000
--- a/tk8.6/tests/image.test
+++ /dev/null
@@ -1,626 +0,0 @@
-# This file is a Tcl script to test out the "image" command and the
-# other procedures in the file tkImage.c.  It is organized in the
-# standard fashion for Tcl tests.
-#
-# Copyright (c) 1994 The Regents of the University of California.
-# Copyright (c) 1994 Sun Microsystems, Inc.
-# Copyright (c) 1998-1999 by Scriptics Corporation.
-# All rights reserved.
-
-package require tcltest 2.2
-namespace import ::tcltest::*
-eval tcltest::configure $argv
-tcltest::loadTestedCommands
-
-imageInit
-
-# Canvas used in some tests in the whole file
-canvas .c -highlightthickness 2
-pack .c
-update
-
-
-test image-1.1 {Tk_ImageCmd procedure, "create" option} -body {
-    image
-} -returnCodes error -result {wrong # args: should be "image option ?args?"}
-test image-1.2 {Tk_ImageCmd procedure, "create" option} -body {
-    image gorp
-} -returnCodes error -result {bad option "gorp": must be create, delete, height, inuse, names, type, types, or width}
-test image-1.3 {Tk_ImageCmd procedure, "create" option} -body {
-    image create
-} -returnCodes error -result {wrong # args: should be "image create type ?name? ?-option value ...?"}
-test image-1.4 {Tk_ImageCmd procedure, "create" option} -body {
-    image c bad_type
-} -returnCodes error -result {image type "bad_type" doesn't exist}
-test image-1.5 {Tk_ImageCmd procedure, "create" option} -constraints {
-    testImageType 
-} -body {
-    list [image create test myimage] [imageNames]
-} -cleanup {
-    imageCleanup
-} -result {myimage myimage}
-test image-1.6 {Tk_ImageCmd procedure, "create" option} -constraints {
-    testImageType 
-} -setup {
-    imageCleanup
-} -body {
-    scan [image create test] image%d first
-    image create test myimage
-    scan [image create test -variable x] image%d second
-    expr $second-$first
-} -cleanup {
-    imageCleanup
-} -result {1}
-
-test image-1.7 {Tk_ImageCmd procedure, "create" option} -constraints {
-    testImageType 
-} -setup {
-    imageCleanup
-} -body {
-    image create test myimage -variable x
-    .c create image 100 50 -image myimage
-    .c create image 100 150 -image myimage
-    update
-    set x {}
-    image create test myimage -variable x
-    update
-    return $x
-} -cleanup {
-    imageCleanup
-} -result {{myimage free} {myimage free} {myimage delete} {myimage get} {myimage get} {myimage display 0 0 30 15 30 30} {myimage display 0 0 30 15 30 130}}
-test image-1.8 {Tk_ImageCmd procedure, "create" option} -constraints {
-	testImageType 
-} -setup {
-    .c delete all
-    imageCleanup
-} -body {
-    image create test myimage -variable x
-    .c create image 100 50 -image myimage
-    .c create image 100 150 -image myimage
-    image delete myimage
-    update
-    set x {}
-    image create test myimage -variable x
-    update
-    return $x
-} -cleanup {
-    .c delete all
-    imageCleanup
-} -result {{myimage get} {myimage get} {myimage display 0 0 30 15 30 30} {myimage display 0 0 30 15 30 130}}
-test image-1.9 {Tk_ImageCmd procedure, "create" option} -constraints {
-	testImageType 
-} -body {
-    image create test -badName foo
-} -returnCodes error -result {bad option name "-badName"}
-test image-1.10 {Tk_ImageCmd procedure, "create" option} -constraints {
-    testImageType 
-} -body {
-    catch {image create test -badName foo}
-    imageNames
-} -result {}
-test image-1.11 {Tk_ImageCmd procedure, "create" option with same name as main window} -body {
-    set code [loadTkCommand]
-    append code {
-	    update
-	    puts [list [catch {image create photo .} msg] $msg]
-	    exit
-    }
-    set script [makeFile $code script]
-    exec [interpreter] <$script
-} -cleanup {
-    removeFile script
-} -result {1 {images may not be named the same as the main window}}
-test image-1.12 {Tk_ImageCmd procedure, "create" option with same name as main window after renaming} -body {
-    set code [loadTkCommand]
-    append code {
-	    update
-	    puts [list [catch {rename . foo;image create photo foo} msg] $msg]
-	    exit
-    }
-    set script [makeFile $code script]
-    exec [interpreter] <$script
-} -cleanup {
-    removeFile script
-} -result {1 {images may not be named the same as the main window}}
-test image-1.13 {Tk_ImageCmd, "create" option: do not generated command name in use} -setup {
-    .c delete all
-    imageCleanup
-} -body {
-    set i [image create bitmap]
-    regexp {^image(\d+)$} $i -> serial
-    incr serial
-    proc image$serial {} {return works}
-    set j [image create bitmap]
-
-    image$serial
-} -cleanup {
-    rename image$serial {}
-    image delete $i $j
-} -result works
-
-test image-2.1 {Tk_ImageCmd procedure, "delete" option} -body {
-    image delete
-} -result {}
-test image-2.2 {Tk_ImageCmd procedure, "delete" option} -constraints {
-    testImageType 
-} -setup {
-    imageCleanup
-    set result {}
-} -body {
-    image create test myimage
-    image create test img2
-    lappend result [lsort [imageNames]]
-    image d myimage img2
-    lappend result [imageNames]
-} -cleanup {
-    imageCleanup
-} -result {{img2 myimage} {}}
-test image-2.3 {Tk_ImageCmd procedure, "delete" option} -constraints {
-    testImageType 
-} -setup {
-    imageCleanup
-} -body {
-    image create test myimage
-    image create test img2
-    image delete myimage gorp img2
-} -cleanup {
-    imageCleanup
-} -returnCodes error -result {image "gorp" doesn't exist}
-test image-2.4 {Tk_ImageCmd procedure, "delete" option} -constraints {
-    testImageType 
-} -setup {
-    imageCleanup
-} -body {
-    image create test myimage
-    image create test img2
-    catch {image delete myimage gorp img2}
-    imageNames
-} -cleanup {
-    imageCleanup
-} -result {img2}
-
-
-test image-3.1 {Tk_ImageCmd procedure, "height" option} -body {
-    image height
-} -returnCodes error -result {wrong # args: should be "image height name"}
-test image-3.2 {Tk_ImageCmd procedure, "height" option} -body {
-    image height a b
-} -returnCodes error -result {wrong # args: should be "image height name"}
-test image-3.3 {Tk_ImageCmd procedure, "height" option} -body {
-    image height foo
-} -returnCodes error -result {image "foo" doesn't exist}
-test image-3.4 {Tk_ImageCmd procedure, "height" option} -constraints {
-    testImageType 
-} -setup {
-    imageCleanup
-} -body {
-    image create test myimage
-    set x [image h myimage]
-    myimage changed 0 0 0 0 60 50
-    list $x [image height myimage]
-} -cleanup {
-    imageCleanup
-} -result {15 50}
-
-
-test image-4.1 {Tk_ImageCmd procedure, "names" option} -body {
-    image names x
-} -returnCodes error -result {wrong # args: should be "image names"}
-test image-4.2 {Tk_ImageCmd procedure, "names" option} -constraints {
-    testImageType 
-} -setup {
-    catch {interp delete testinterp}
-} -body {
-    interp create testinterp
-    load {} Tk testinterp
-    interp eval testinterp {
-        image delete {*}[image names]
-        image create test myimage
-        image create test img2
-        image create test 24613
-        lsort [image names]
-    }
-} -cleanup {
-    interp delete testinterp
-} -result {24613 img2 myimage}
-test image-4.3 {Tk_ImageCmd procedure, "names" option} -setup {
-    catch {interp delete testinterp}
-} -body {
-    interp create testinterp
-    load {} Tk testinterp
-    interp eval testinterp {
-        image delete {*}[image names]
-        eval image delete [image names] [image names]
-        lsort [image names]
-    }
-} -cleanup {
-    interp delete testinterp
-} -result {}
-
-
-test image-5.1 {Tk_ImageCmd procedure, "type" option} -body {
-    image type
-} -returnCodes error -result {wrong # args: should be "image type name"}
-test image-5.2 {Tk_ImageCmd procedure, "type" option} -body {
-    image type a b
-} -returnCodes error -result {wrong # args: should be "image type name"}
-test image-5.3 {Tk_ImageCmd procedure, "type" option} -body {
-    image type foo
-} -returnCodes error -result {image "foo" doesn't exist}
-
-test image-5.4 {Tk_ImageCmd procedure, "type" option} -constraints {
-    testImageType 
-} -setup {
-    imageCleanup
-} -body {
-    image create test myimage
-    image type myimage
-} -cleanup {
-    imageCleanup
-} -result {test}
-test image-5.5 {Tk_ImageCmd procedure, "type" option} -constraints {
-    testImageType 
-} -setup {
-    imageCleanup
-} -body {
-    image create test myimage
-    .c create image 50 50 -image myimage
-    image delete myimage
-    image type myimage
-} -cleanup {
-    imageCleanup
-} -returnCodes error -result {image "myimage" doesn't exist}
-test image-5.6 {Tk_ImageCmd procedure, "type" option} -constraints {
-    testOldImageType 
-} -setup {
-    imageCleanup
-} -body {
-    image create oldtest myimage
-    image type myimage
-} -cleanup {
-    imageCleanup
-} -result {oldtest}
-test image-5.7 {Tk_ImageCmd procedure, "type" option} -constraints {
-    testOldImageType 
-} -setup {
-    .c delete all
-    imageCleanup
-} -body {
-    image create oldtest myimage
-    .c create image 50 50 -image myimage
-    image delete myimage
-    image type myimage
-} -cleanup {
-    .c delete all
-    imageCleanup
-} -returnCodes error -result {image "myimage" doesn't exist}
-
-
-test image-6.1 {Tk_ImageCmd procedure, "types" option} -body {
-    image types x
-} -returnCodes error -result {wrong # args: should be "image types"}
-test image-6.2 {Tk_ImageCmd procedure, "types" option} -constraints {
-    testImageType 
-} -body {
-    lsort [image types]
-} -result {bitmap oldtest photo test}
-
-
-test image-7.1 {Tk_ImageCmd procedure, "width" option} -body {
-    image width
-} -returnCodes error -result {wrong # args: should be "image width name"}
-test image-7.2 {Tk_ImageCmd procedure, "width" option} -body {
-    image width a b
-} -returnCodes error -result {wrong # args: should be "image width name"}
-test image-7.3 {Tk_ImageCmd procedure, "width" option} -body {
-    image width foo
-} -returnCodes error -result {image "foo" doesn't exist}
-test image-7.4 {Tk_ImageCmd procedure, "width" option} -constraints {
-    testImageType 
-} -setup {
-    imageCleanup
-} -body {
-    image create test myimage
-    set x [image w myimage]
-    myimage changed 0 0 0 0 60 50
-    list $x [image width myimage]
-} -cleanup {
-    imageCleanup
-} -result {30 60}
-
-
-test image-8.1 {Tk_ImageCmd procedure, "inuse" option} -constraints {
-    testImageType 
-} -setup {
-    imageCleanup
-    set res {}
-    destroy .b
-} -body {
-    image create test myimage2
-    lappend res [image inuse myimage2]
-    button .b -image myimage2
-    lappend res [image inuse myimage2]
-} -cleanup {
-    imageCleanup
-    catch {destroy .b}
-} -result [list 0 1]
-    
-
-test image-9.1 {Tk_ImageChanged procedure} -constraints testImageType -setup {
-    .c delete all
-    imageCleanup
-} -body {
-    image create test foo -variable x
-    .c create image 50 50 -image foo
-    update
-    set x {}
-    foo changed 5 6 7 8 30 15
-    update
-    return $x
-} -cleanup {
-    .c delete all
-    imageCleanup
-} -result {{foo display 5 6 7 8 30 30}}
-test image-9.2 {Tk_ImageChanged procedure} -constraints testImageType -setup {
-    .c delete all
-    imageCleanup
-} -body {
-    image create test foo -variable x
-    .c create image 50 50 -image foo
-    .c create image 90 100 -image foo
-    update
-    set x {}
-    foo changed 5 6 7 8 30 15
-    update
-    return $x
-} -cleanup {
-    .c delete all
-    imageCleanup
-} -result {{foo display 5 6 25 9 30 30} {foo display 0 0 12 14 65 74}}
-
-
-test image-10.1 {Tk_GetImage procedure} -setup {
-    imageCleanup
-} -body {
-    .c create image 100 10 -image bad_name
-} -cleanup {
-    imageCleanup
-} -returnCodes error -result {image "bad_name" doesn't exist}
-test image-10.2 {Tk_GetImage procedure} -constraints testImageType -setup {
-    destroy .l
-    imageCleanup
-} -body {
-    image create test mytest
-    label .l -image mytest
-    image delete  mytest
-    label .l2 -image mytest
-} -cleanup {
-    destroy .l
-    imageCleanup
-} -returnCodes error -result {image "mytest" doesn't exist}
-
-
-test image-11.1 {Tk_FreeImage procedure} -constraints testImageType -setup {
-    .c delete all
-    imageCleanup
-} -body {
-    image create test foo -variable x
-    .c create image 50 50 -image foo -tags i1
-    .c create image 90 100 -image foo -tags i2
-    pack forget .c
-    update
-    set x {}
-    .c delete i1
-    pack .c
-    update
-    list [imageNames] $x
-} -cleanup {
-    .c delete all
-    imageCleanup
-} -result {foo {{foo free} {foo display 0 0 30 15 103 121}}}
-test image-11.2 {Tk_FreeImage procedure} -constraints testImageType -setup {
-    .c delete all
-    imageCleanup
-} -body {
-    image create test foo -variable x
-    .c create image 50 50 -image foo -tags i1
-    set names [imageNames]
-    image delete foo
-    update
-    set names2 [imageNames]
-    set x {}
-    .c delete i1
-    pack forget .c
-    pack .c
-    update
-    list $names $names2 [imageNames] $x
-} -cleanup {
-    .c delete all
-    imageCleanup
-} -result {foo {} {} {}}
-
-
-# Non-portable, apparently due to differences in rounding:
-test image-12.1 {Tk_RedrawImage procedure, redisplay area clipping} -constraints {
-    testImageType nonPortable
-} -setup {
-    imageCleanup
-} -body {
-    image create test foo -variable x
-    .c create image 50 60 -image foo -tags i1 -anchor nw
-    update
-    .c create rectangle 30 40 55 65 -width 0 -fill black -outline {}
-    set x {}
-    update
-    return $x
-} -cleanup {
-    imageCleanup
-} -result {{foo display 0 0 5 5 50 50}}
-test image-12.2 {Tk_RedrawImage procedure, redisplay area clipping} -constraints {
-    testImageType nonPortable
-} -setup {
-    imageCleanup
-} -body {
-    image create test foo -variable x
-    .c create image 50 60 -image foo -tags i1 -anchor nw
-    update
-    .c create rectangle 60 40 100 65 -width 0 -fill black -outline {}
-    set x {}
-    update
-    return $x
-} -cleanup {
-    imageCleanup
-} -result {{foo display 10 0 20 5 30 50}}
-test image-12.3 {Tk_RedrawImage procedure, redisplay area clipping} -constraints {
-    testImageType nonPortable
-} -setup {
-    imageCleanup
-} -body {
-    image create test foo -variable x
-    .c create image 50 60 -image foo -tags i1 -anchor nw
-    update
-    .c create rectangle 60 70 100 200 -width 0 -fill black -outline {}
-    set x {}
-    update
-    return $x
-} -cleanup {
-    imageCleanup
-} -result {{foo display 10 10 20 5 30 30}}
-test image-12.4 {Tk_RedrawImage procedure, redisplay area clipping} -constraints {
-    testImageType nonPortable
-} -setup {
-    imageCleanup
-} -body {
-    image create test foo -variable x
-    .c create image 50 60 -image foo -tags i1 -anchor nw
-    update
-    .c create rectangle 30 70 55 200 -width 0 -fill black -outline {}
-    set x {}
-    update
-    return $x
-} -cleanup {
-    imageCleanup
-} -result {{foo display 0 10 5 5 50 30}}
-test image-12.5 {Tk_RedrawImage procedure, redisplay area clipping} -constraints {
-    testImageType nonPortable
-} -setup {
-    imageCleanup
-} -body {
-    image create test foo -variable x
-    .c create image 50 60 -image foo -tags i1 -anchor nw
-    update
-    .c create rectangle 10 20 120 130 -width 0 -fill black -outline {}
-    set x {}
-    update
-    return $x
-} -cleanup {
-    imageCleanup
-} -result {{foo display 0 0 30 15 70 70}}
-test image-12.6 {Tk_RedrawImage procedure, redisplay area clipping} -constraints {
-    testImageType nonPortable
-} -setup {
-    imageCleanup
-} -body {
-    image create test foo -variable x
-    .c create image 50 60 -image foo -tags i1 -anchor nw
-    update
-    .c create rectangle 55 65 75 70 -width 0 -fill black -outline {}
-    set x {}
-    update
-    return $x
-} -cleanup {
-    imageCleanup
-} -result {{foo display 5 5 20 5 30 30}}
-
-
-test image-13.1 {Tk_SizeOfImage procedure} -constraints testImageType -setup {
-    imageCleanup
-} -body {
-    image create test foo -variable x
-    set result [list [image width foo] [image height foo]]
-    foo changed 0 0 0 0 85 60
-    lappend result [image width foo] [image height foo]
-} -cleanup {
-    imageCleanup
-} -result {30 15 85 60}
-
-test image-13.2 {DeleteImage procedure} -constraints testImageType -setup {
-    .c delete all
-    imageCleanup
-} -body {
-    image create test foo -variable x
-    .c create image 50 50 -image foo -tags i1
-    .c create image 90 100 -image foo -tags i2
-    set x {}
-    image delete foo
-    lappend x | [imageNames] | [catch {image delete foo} msg] | $msg | [imageNames] |
-} -cleanup {
-    imageCleanup
-} -result {{foo free} {foo free} {foo delete} | {} | 1 | {image "foo" doesn't exist} | {} |}
-
-test image-13.3 {Tk_SizeOfImage procedure} -constraints testOldImageType -setup {
-    imageCleanup
-} -body {
-    image create oldtest foo -variable x
-    set result [list [image width foo] [image height foo]]
-    foo changed 0 0 0 0 85 60
-    lappend result [image width foo] [image height foo]
-} -cleanup {
-    imageCleanup
-} -result {30 15 85 60}
-
-test image-13.4 {DeleteImage procedure} -constraints testOldImageType -setup {
-    .c delete all
-    imageCleanup
-} -body {
-    image create oldtest foo -variable x
-    .c create image 50 50 -image foo -tags i1
-    .c create image 90 100 -image foo -tags i2
-    set x {}
-    image delete foo
-    lappend x | [imageNames] | [catch {image delete foo} msg] | $msg | [imageNames] |
-} -cleanup {
-    .c delete all
-    imageCleanup
-} -result {{foo free} {foo free} {foo delete} | {} | 1 | {image "foo" doesn't exist} | {} |}
-
-test image-14.1 {image command vs hidden commands} -body {
-    catch {image delete hidden}
-    set l [imageNames]
-    set h [interp hidden]
-    image create photo hidden
-    interp hide {} hidden
-    image delete hidden
-    set res1 [list [imageNames] [interp hidden]]
-    set res2 [list $l $h]
-    expr {$res1 eq $res2}
-} -result 1
-
-test image-15.1 {deleting image does not make widgets forget about it} -setup {
-    .c delete all
-    imageCleanup
-} -body {
-    image create photo foo -width 10 -height 10
-    .c create image 10 10 -image foo -tags i1 -anchor nw
-    update
-    set x [.c bbox i1]
-    lappend x [imageNames]
-    image delete foo
-    lappend x [imageNames]
-    image create photo foo -width 20 -height 20
-    lappend x [.c bbox i1] [imageNames]
-} -cleanup {
-    .c delete all
-    imageCleanup
-} -result {10 10 20 20 foo {} {10 10 30 30} foo}
-    
-destroy .c
-imageFinish
-
-# cleanup
-cleanupTests
-return
-
-# Local variables:
-# mode: tcl
-# End: