Index: generic/tkImgGIF.c ================================================================== --- generic/tkImgGIF.c +++ generic/tkImgGIF.c @@ -675,10 +675,11 @@ if (height > imageHeight) { height = imageHeight; } if ((width > 0) && (height > 0)) { + unsigned char* pixelPtr; Tk_PhotoImageBlock block; /* * Read the data and put it into the photo buffer for display by the * general image machinery. @@ -697,27 +698,29 @@ block.pitch = block.pixelSize * imageWidth; if (imageHeight > (int)(UINT_MAX/block.pitch)) { goto error; } nBytes = block.pitch * imageHeight; - block.pixelPtr = ckalloc(nBytes); - if (block.pixelPtr) { - memset(block.pixelPtr, 0, nBytes); + pixelPtr = ckalloc(nBytes); + if (pixelPtr) { + memset(pixelPtr, 0, nBytes); } + block.pixelPtr = pixelPtr; if (ReadImage(gifConfPtr, interp, block.pixelPtr, chan, imageWidth, imageHeight, colorMap, srcX, srcY, BitSet(buf[8], INTERLACE), transparent) != TCL_OK) { - ckfree(block.pixelPtr); + ckfree(pixelPtr); goto error; } + block.pixelPtr += srcX * block.pixelSize + srcY * block.pitch; if (Tk_PhotoPutBlock(interp, imageHandle, &block, destX, destY, width, height, TK_PHOTO_COMPOSITE_SET) != TCL_OK) { - ckfree(block.pixelPtr); + ckfree(pixelPtr); goto error; } - ckfree(block.pixelPtr); + ckfree(pixelPtr); } /* * We've successfully read the GIF frame (or there was nothing to read, * which suits as well). We're done. Index: generic/tkImgPNG.c ================================================================== --- generic/tkImgPNG.c +++ generic/tkImgPNG.c @@ -194,11 +194,12 @@ unsigned long calculated); static void CleanupPNGImage(PNGImage *pngPtr); static int DecodeLine(Tcl_Interp *interp, PNGImage *pngPtr); static int DecodePNG(Tcl_Interp *interp, PNGImage *pngPtr, Tcl_Obj *fmtObj, Tk_PhotoHandle imageHandle, - int destX, int destY); + int destX, int destY, int width, int height, + int srcX, int srcY); static int EncodePNG(Tcl_Interp *interp, Tk_PhotoImageBlock *blockPtr, PNGImage *pngPtr); static int FileMatchPNG(Tcl_Channel chan, const char *fileName, Tcl_Obj *fmtObj, int *widthPtr, int *heightPtr, Tcl_Interp *interp); @@ -2372,19 +2373,23 @@ *---------------------------------------------------------------------- */ static int DecodePNG( - Tcl_Interp *interp, - PNGImage *pngPtr, - Tcl_Obj *fmtObj, - Tk_PhotoHandle imageHandle, - int destX, - int destY) + Tcl_Interp *interp, /* Interpreter to use for reporting errors. */ + PNGImage *pngPtr, /* PNG image information record. */ + Tcl_Obj *fmtObj, /* User-specified format object, or NULL. */ + Tk_PhotoHandle imageHandle, /* The photo image to write into. */ + int destX, int destY, /* Coordinates of top-left pixel in photo + * image to be written to. */ + int width, int height, /* Dimensions of block of photo image to be + * written to. */ + int srcX, int srcY) /* Coordinates of top-left pixel to be used in + * image being read. */ { unsigned long chunkType; - int chunkSz; + int result, chunkSz; unsigned long crc; /* * Parse the PNG signature and IHDR (header) chunk. */ @@ -2481,12 +2486,12 @@ * Expand the photo size (if not set by the user) to provide enough space * for the image being parsed. It does not matter if width or height wrap * to negative here: Tk will not shrink the image. */ - if (Tk_PhotoExpand(interp, imageHandle, destX + pngPtr->block.width, - destY + pngPtr->block.height) == TCL_ERROR) { + if (Tk_PhotoExpand(interp, imageHandle, destX + width, + destY + height) == TCL_ERROR) { return TCL_ERROR; } /* * A scan line consists of one byte for a filter type, plus the number of @@ -2636,17 +2641,16 @@ /* * Copy the decoded image block into the Tk photo image. */ - if (Tk_PhotoPutBlock(interp, imageHandle, &pngPtr->block, destX, destY, - pngPtr->block.width, pngPtr->block.height, - TK_PHOTO_COMPOSITE_SET) == TCL_ERROR) { - return TCL_ERROR; - } + pngPtr->block.pixelPtr += srcX * pngPtr->block.pixelSize + srcY * pngPtr->block.pitch; + result = Tk_PhotoPutBlock(interp, imageHandle, &pngPtr->block, destX, destY, + width, height, TK_PHOTO_COMPOSITE_SET); + pngPtr->block.pixelPtr -= srcX * pngPtr->block.pixelSize + srcY * pngPtr->block.pitch; - return TCL_OK; + return result; } /* *---------------------------------------------------------------------- * @@ -2709,29 +2713,29 @@ *---------------------------------------------------------------------- */ static int FileReadPNG( - Tcl_Interp *interp, - Tcl_Channel chan, - const char *fileName, - Tcl_Obj *fmtObj, - Tk_PhotoHandle imageHandle, - int destX, - int destY, - int width, - int height, - int srcX, - int srcY) + Tcl_Interp* interp, /* Interpreter to use for reporting errors. */ + Tcl_Channel chan, /* The image file, open for reading. */ + const char* fileName, /* The name of the image file. */ + Tcl_Obj *fmtObj, /* User-specified format object, or NULL. */ + Tk_PhotoHandle imageHandle, /* The photo image to write into. */ + int destX, int destY, /* Coordinates of top-left pixel in photo + * image to be written to. */ + int width, int height, /* Dimensions of block of photo image to be + * written to. */ + int srcX, int srcY) /* Coordinates of top-left pixel to be used in + * image being read. */ { PNGImage png; int result = TCL_ERROR; result = InitPNGImage(interp, &png, chan, NULL, TCL_ZLIB_STREAM_INFLATE); if (TCL_OK == result) { - result = DecodePNG(interp, &png, fmtObj, imageHandle, destX, destY); + result = DecodePNG(interp, &png, fmtObj, imageHandle, destX, destY, width, height, srcX, srcY); } CleanupPNGImage(&png); return result; } @@ -2797,29 +2801,29 @@ *---------------------------------------------------------------------- */ static int StringReadPNG( - Tcl_Interp *interp, + Tcl_Interp* interp, /* Interpreter to use for reporting errors. */ Tcl_Obj *pObjData, - Tcl_Obj *fmtObj, - Tk_PhotoHandle imageHandle, - int destX, - int destY, - int width, - int height, - int srcX, - int srcY) + Tcl_Obj *fmtObj, /* User-specified format object, or NULL. */ + Tk_PhotoHandle imageHandle, /* The photo image to write into. */ + int destX, int destY, /* Coordinates of top-left pixel in photo + * image to be written to. */ + int width, int height, /* Dimensions of block of photo image to be + * written to. */ + int srcX, int srcY) /* Coordinates of top-left pixel to be used in + * image being read. */ { PNGImage png; int result = TCL_ERROR; result = InitPNGImage(interp, &png, NULL, pObjData, TCL_ZLIB_STREAM_INFLATE); if (TCL_OK == result) { - result = DecodePNG(interp, &png, fmtObj, imageHandle, destX, destY); + result = DecodePNG(interp, &png, fmtObj, imageHandle, destX, destY, width, height, srcX, srcY); } CleanupPNGImage(&png); return result; } Index: tests/imgPhoto.test ================================================================== --- tests/imgPhoto.test +++ tests/imgPhoto.test @@ -53,13 +53,11 @@ imageInit set README [makeFile { README -- Tk test suite design document. } README-imgPhoto] -# find the teapot.ppm file for use in these tests set teapotPhotoFile [file join [file dirname [info script]] teapot.ppm] -testConstraint hasTeapotPhoto [file exists $teapotPhotoFile] test imgPhoto-1.1 {options for photo images} -body { image create photo photo1 -width 79 -height 83 list [photo1 cget -width] [photo1 cget -height] \ [image width photo1] [image height photo1] @@ -68,20 +66,20 @@ } -result {79 83 79 83} test imgPhoto-1.2 {options for photo images} -body { list [catch {image create photo photo1 -file no.such.file} err] \ [string tolower $err] } -result {1 {couldn't open "no.such.file": no such file or directory}} -test imgPhoto-1.3 {options for photo images} -constraints hasTeapotPhoto -body { +test imgPhoto-1.3 {options for photo images} -body { image create photo photo1 -file $teapotPhotoFile -format no.such.format } -returnCodes error -result {image file format "no.such.format" is not supported} -test imgPhoto-1.4 {options for photo images} -constraints hasTeapotPhoto -body { +test imgPhoto-1.4 {options for photo images} -body { image create photo photo1 -file $teapotPhotoFile list [image width photo1] [image height photo1] } -cleanup { image delete photo1 } -result {256 256} -test imgPhoto-1.5 {options for photo images} -constraints hasTeapotPhoto -body { +test imgPhoto-1.5 {options for photo images} -body { image create photo photo1 -file $teapotPhotoFile \ -format ppm -width 79 -height 83 list [image width photo1] [image height photo1] [photo1 cget -file] [photo1 cget -format] } -cleanup { image delete photo1 @@ -129,30 +127,24 @@ # catch {image create photo photo2 -file bogus.img} msg # photo1 copy photo2 # set msg # } {couldn't open "bogus.img": no such file or directory} -test imgPhoto-3.1 {ImgPhotoConfigureModel procedure} -constraints { - hasTeapotPhoto -} -body { +test imgPhoto-3.1 {ImgPhotoConfigureModel procedure} -body { image create photo photo1 -file $teapotPhotoFile photo1 configure -file $teapotPhotoFile } -cleanup { image delete photo1 } -result {} -test imgPhoto-3.2 {ImgPhotoConfigureModel procedure} -constraints { - hasTeapotPhoto -} -body { +test imgPhoto-3.2 {ImgPhotoConfigureModel procedure} -body { image create photo photo1 -file $teapotPhotoFile list [catch {photo1 configure -file bogus} err] [string tolower $err] \ [image width photo1] [image height photo1] } -cleanup { image delete photo1 } -result {1 {couldn't open "bogus": no such file or directory} 256 256} -test imgPhoto-3.3 {ImgPhotoConfigureModel procedure} -constraints { - hasTeapotPhoto -} -setup { +test imgPhoto-3.3 {ImgPhotoConfigureModel procedure} -setup { destroy .c pack [canvas .c] update } -body { image create photo photo1 @@ -230,13 +222,11 @@ } -body { photo1 configure -palette {} -gamma } -cleanup { image delete photo1 } -returnCodes error -result {value for "-gamma" missing} -test imgPhoto-4.10 {ImgPhotoCmd procedure: copy option} -constraints { - hasTeapotPhoto -} -setup { +test imgPhoto-4.10 {ImgPhotoCmd procedure: copy option} -setup { image create photo photo1 image create photo photo2 -width 25 -height 30 } -body { image create photo photo2 -file $teapotPhotoFile photo1 configure -width 0 -height 0 -palette {} -gamma 1 @@ -273,80 +263,66 @@ } -body { photo1 copy photo2 -from -to } -returnCodes error -cleanup { image delete photo1 photo2 } -result {the "-from" option requires one to four integer values} -test imgPhoto-4.15 {ImgPhotoCmd procedure: copy option} -constraints { - hasTeapotPhoto -} -setup { +test imgPhoto-4.15 {ImgPhotoCmd procedure: copy option} -setup { image create photo photo1 image create photo photo2 -file $teapotPhotoFile } -body { photo1 copy photo2 photo1 copy photo2 -from 0 70 60 120 -shrink list [image width photo1] [image height photo1] [photo1 get 20 10] } -cleanup { image delete photo1 photo2 } -result {60 50 {215 154 120}} -test imgPhoto-4.16 {ImgPhotoCmd procedure: copy option} -constraints { - hasTeapotPhoto -} -setup { +test imgPhoto-4.16 {ImgPhotoCmd procedure: copy option} -setup { image create photo photo1 image create photo photo2 -file $teapotPhotoFile } -body { photo1 copy photo2 -from 60 120 0 70 -to 20 50 list [image width photo1] [image height photo1] [photo1 get 40 80] } -cleanup { image delete photo1 photo2 } -result {80 100 {19 92 192}} -test imgPhoto-4.17 {ImgPhotoCmd procedure: copy option} -constraints { - hasTeapotPhoto -} -setup { +test imgPhoto-4.17 {ImgPhotoCmd procedure: copy option} -setup { image create photo photo1 image create photo photo2 -file $teapotPhotoFile } -body { photo1 copy photo2 -from 0 120 60 70 -to 0 0 100 100 list [image width photo1] [image height photo1] [photo1 get 80 60] } -cleanup { image delete photo1 photo2 } -result {100 100 {215 154 120}} -test imgPhoto-4.18 {ImgPhotoCmd procedure: copy option} -constraints { - hasTeapotPhoto -} -setup { +test imgPhoto-4.18 {ImgPhotoCmd procedure: copy option} -setup { image create photo photo1 image create photo photo2 -file $teapotPhotoFile } -body { photo1 copy photo2 -from 60 70 0 120 -zoom 2 list [image width photo1] [image height photo1] [photo1 get 100 50] } -cleanup { image delete photo1 photo2 } -result {120 100 {169 99 47}} -test imgPhoto-4.19 {ImgPhotoCmd procedure: copy option} -constraints { - hasTeapotPhoto -} -setup { +test imgPhoto-4.19 {ImgPhotoCmd procedure: copy option} -setup { image create photo photo1 image create photo photo2 -file $teapotPhotoFile } -body { photo1 copy photo2 -from 0 70 60 120 -zoom 2 list [image width photo1] [image height photo1] [photo1 get 100 50] } -cleanup { image delete photo1 photo2 } -result {120 100 {169 99 47}} -test imgPhoto-4.20 {ImgPhotoCmd procedure: copy option} -constraints { - hasTeapotPhoto -} -setup { +test imgPhoto-4.20 {ImgPhotoCmd procedure: copy option} -setup { image create photo photo1 image create photo photo2 -file $teapotPhotoFile } -body { photo1 copy photo2 -from 20 20 200 180 -subsample 2 -shrink list [image width photo1] [image height photo1] [photo1 get 50 30] } -cleanup { image delete photo1 photo2 } -result {90 80 {207 146 112}} -test imgPhoto-4.21 {ImgPhotoCmd procedure: copy option} -constraints { - hasTeapotPhoto -} -setup { +test imgPhoto-4.21 {ImgPhotoCmd procedure: copy option} -setup { image create photo photo1 image create photo photo2 -file $teapotPhotoFile } -body { photo1 copy photo2 set result [list [image width photo1] [image height photo1]] @@ -363,13 +339,11 @@ photo1 copy photo2 -from 0 0 10 10 -shrink lappend result [image width photo1] [image height photo1] } -cleanup { image delete photo1 photo2 } -result {256 256 49 51 49 51 49 51 10 51 10 10} -test imgPhoto-4.22 {ImgPhotoCmd procedure: get option} -constraints { - hasTeapotPhoto -} -setup { +test imgPhoto-4.22 {ImgPhotoCmd procedure: get option} -setup { image create photo photo1 } -body { photo1 read $teapotPhotoFile list [photo1 get 100 100] [photo1 get 150 100] [photo1 get 100 150] } -cleanup { @@ -430,13 +404,11 @@ } -body { photo1 read } -returnCodes error -cleanup { image delete photo1 } -result {wrong # args: should be "photo1 read fileName ?-option value ...?"} -test imgPhoto-4.31 {ImgPhotoCmd procedure: read option} -constraints { - hasTeapotPhoto -} -setup { +test imgPhoto-4.31 {ImgPhotoCmd procedure: read option} -setup { image create photo photo1 } -body { photo1 read $teapotPhotoFile -zoom 2 } -returnCodes error -cleanup { image delete photo1 @@ -446,13 +418,11 @@ } -body { list [catch {photo1 read bogus} err] [string tolower $err] } -cleanup { image delete photo1 } -result {1 {couldn't open "bogus": no such file or directory}} -test imgPhoto-4.33 {ImgPhotoCmd procedure: read option} -constraints { - hasTeapotPhoto -} -setup { +test imgPhoto-4.33 {ImgPhotoCmd procedure: read option} -setup { image create photo photo1 } -body { photo1 read $teapotPhotoFile -format bogus } -cleanup { image delete photo1 @@ -462,23 +432,19 @@ } -body { photo1 read $README } -returnCodes error -cleanup { image delete photo1 } -result [subst {couldn't recognize data in image file "$README"}] -test imgPhoto-4.35 {ImgPhotoCmd procedure: read option} -constraints { - hasTeapotPhoto -} -setup { +test imgPhoto-4.35 {ImgPhotoCmd procedure: read option} -setup { image create photo photo1 } -body { photo1 read $teapotPhotoFile list [image width photo1] [image height photo1] [photo1 get 120 120] } -cleanup { image delete photo1 } -result {256 256 {161 109 82}} -test imgPhoto-4.36 {ImgPhotoCmd procedure: read option} -constraints { - hasTeapotPhoto -} -setup { +test imgPhoto-4.36 {ImgPhotoCmd procedure: read option} -setup { image create photo photo1 } -body { photo1 read $teapotPhotoFile -from 0 70 60 120 -to 10 10 -shrink list [image width photo1] [image height photo1] [photo1 get 29 19] } -cleanup { @@ -800,23 +766,19 @@ } -body { photo1 put {{white}} -to 10 10 20 20 {{white}} } -cleanup { image delete photo1 } -returnCodes 1 -result {wrong # args: should be "photo1 put data ?-option value ...?"} -test imgPhoto-4.75 { read command: filename starting with '-'} -constraints { - hasTeapotPhoto -} -body { +test imgPhoto-4.75 { read command: filename starting with '-'} -body { file copy -force $teapotPhotoFile -teapotPhotoFile image create photo photo1 photo1 read -teapotPhotoFile } -cleanup { image delete photo1 file delete ./-teapotPhotoFile } -result {} -test imgPhoto-4.76 {ImgPhotoCmd procedure: copy to same image} -constraints { - hasTeapotPhoto -} -setup { +test imgPhoto-4.76 {ImgPhotoCmd procedure: copy to same image} -setup { imageCleanup image create photo photo1 -file $teapotPhotoFile } -body { # non-regression test for bug [5239fd749b] - shall just not crash photo1 copy photo1 -to 0 0 2000 1000 @@ -823,13 +785,11 @@ photo1 copy photo1 -subsample 2 2 -shrink } -cleanup { imageCleanup } -result {} -test imgPhoto-5.1 {ImgPhotoGet/Free procedures, shared instances} -constraints { - hasTeapotPhoto -} -setup { +test imgPhoto-5.1 {ImgPhotoGet/Free procedures, shared instances} -setup { destroy .c pack [canvas .c] imageCleanup } -body { image create photo photo1 -file $teapotPhotoFile @@ -860,13 +820,11 @@ } -cleanup { destroy .c image delete photo1 } -result {} -test imgPhoto-7.1 {ImgPhotoFree procedure, resource freeing} -constraints { - hasTeapotPhoto -} -setup { +test imgPhoto-7.1 {ImgPhotoFree procedure, resource freeing} -setup { destroy .c pack [canvas .c] imageCleanup } -body { image create photo photo1 -file $teapotPhotoFile @@ -875,13 +833,11 @@ .c delete all image delete photo1 } -cleanup { destroy .c } -result {} -test imgPhoto-7.2 {ImgPhotoFree procedures, unlinking} -constraints { - hasTeapotPhoto -} -setup { +test imgPhoto-7.2 {ImgPhotoFree procedures, unlinking} -setup { deleteWindows imageCleanup } -body { image create photo photo1 -file $teapotPhotoFile pack [canvas .c] @@ -900,13 +856,11 @@ .c delete all } -cleanup { destroy .c image delete photo1 } -result {} -test imgPhoto-7.3 {ImgPhotoFree procedures, multiple visuals} -constraints { - hasTeapotPhoto -} -setup { +test imgPhoto-7.3 {ImgPhotoFree procedures, multiple visuals} -setup { deleteWindows imageCleanup } -body { image create photo photo1 -file $teapotPhotoFile button .b1 -image photo1 @@ -921,17 +875,15 @@ update destroy .f image delete photo1 } -result {} -test imgPhoto-8.1 {ImgPhotoDelete procedure} -constraints hasTeapotPhoto -body { +test imgPhoto-8.1 {ImgPhotoDelete procedure} -body { image create photo photo2 -file $teapotPhotoFile image delete photo2 } -result {} -test imgPhoto-8.2 {ImgPhotoDelete procedure} -constraints { - hasTeapotPhoto -} -setup { +test imgPhoto-8.2 {ImgPhotoDelete procedure} -setup { set x {} } -body { image create photo photo2 -file $teapotPhotoFile rename photo2 newphoto2 lappend x [info command photo2] [info command new*] [newphoto2 cget -file] @@ -945,13 +897,11 @@ photo1 copy photo2 } -returnCodes error -cleanup { imageCleanup } -result {image "photo2" doesn't exist or is not a photo image} -test imgPhoto-9.1 {ImgPhotoCmdDeletedProc procedure} -constraints { - hasTeapotPhoto -} -body { +test imgPhoto-9.1 {ImgPhotoCmdDeletedProc procedure} -body { image create photo photo2 -file $teapotPhotoFile rename photo2 {} list [expr {"photo2" in [imageNames]}] [catch {photo2 foo} msg] $msg } -result {0 1 {invalid command name "photo2"}} @@ -961,13 +911,11 @@ image create photo photo1 photo1 put "{#ff0000 #ff0000 #ff0000 #ff0000 #ff0000 #ff0000 #ff0000 #ff0000}" -to 0 0 photo1 put "{#00ff00 #00ff00}" -to 2 0 list [photo1 get 2 0] [photo1 get 3 0] [photo1 get 4 0] } -result {{0 255 0} {0 255 0} {255 0 0}} -test imgPhoto-10.2 {Tk_ImgPhotoPutBlock, same source and dest img} -constraints { - hasTeapotPhoto -} -setup { +test imgPhoto-10.2 {Tk_ImgPhotoPutBlock, same source and dest img} -setup { imageCleanup } -body { # Test for bug e4336bef5d image create photo photo1 -file $teapotPhotoFile image create photo photo2 -file $teapotPhotoFile @@ -975,13 +923,11 @@ photo1 copy photo1 -to 1 2 string equal [photo1 data] [photo2 data] } -cleanup { imageCleanup } -result 1 -test imgPhoto-10.3 {Tk_ImgPhotoPutBlock, same source and dest img} -constraints { - hasTeapotPhoto -} -setup { +test imgPhoto-10.3 {Tk_ImgPhotoPutBlock, same source and dest img} -setup { imageCleanup } -body { # Test for bug e4336bef5d image create photo photo1 -file $teapotPhotoFile image create photo photo2 -file $teapotPhotoFile @@ -1009,21 +955,19 @@ photo1 copy i1 } -cleanup { imageCleanup } -returnCodes error -result {image "i1" doesn't exist or is not a photo image} -test imgPhoto-12.1 {Tk_PhotoPutZoomedBlock} -constraints hasTeapotPhoto -body { +test imgPhoto-12.1 {Tk_PhotoPutZoomedBlock} -body { image create photo p3 -file $teapotPhotoFile set result [list [p3 get 50 50] [p3 get 100 100]] p3 copy p3 -zoom 2 lappend result [image width p3] [image height p3] [p3 get 100 100] } -cleanup { image delete p3 } -result {{19 92 192} {169 117 90} 512 512 {19 92 192}} -test imgPhoto-12.2 {Tk_ImgPhotoPutZoomedBlock, same source and dest img} -constraints { - hasTeapotPhoto -} -setup { +test imgPhoto-12.2 {Tk_ImgPhotoPutZoomedBlock, same source and dest img} -setup { imageCleanup } -body { # Test for bug e4336bef5d image create photo photo1 -file $teapotPhotoFile image create photo photo2 -file $teapotPhotoFile @@ -1422,10 +1366,107 @@ } -body { image create photo gif1 -file $fileName } -cleanup { catch {image delete gif1} } -result gif1 + +set earthPhotoFile [file join [file dirname [info script]] earth.gif] +test imgPhoto-19.1 {Read GIF file with -from option - Bug [1576528]} -body { + set earthPhotoFile [file join [file dirname [info script]] earth.gif] + image create photo gif1 + gif1 read $earthPhotoFile -from 152 62 185 97 + list [lindex [lindex [gif1 data] 0] 0] [image width gif1] [image height gif1] +} -cleanup { + catch {image delete gif1} +} -result {{#d8c8b8} 33 35} +test imgPhoto-19.2 {Read GIF file, copy with -from option} -body { + set earthPhotoFile [file join [file dirname [info script]] earth.gif] + image create photo gif1 -file $earthPhotoFile + image create photo gif2 + gif2 copy gif1 -from 152 62 185 97 + list [lindex [lindex [gif2 data] 0] 0] [image width gif2] [image height gif2] +} -cleanup { + catch {image delete gif1 ; image delete gif2} +} -result {{#d8c8b8} 33 35} +test imgPhoto-19.3 {Read GIF file with -to option} -body { + image create photo gif1 + gif1 read $earthPhotoFile -to 100 200 + list [lindex [lindex [gif1 data] 262] 252] [image width gif1] [image height gif1] +} -cleanup { + catch {image delete gif1} +} -result {{#d8c8b8} 420 400} +test imgPhoto-19.4 {Read GIF file with -from and -to options} -body { + set earthPhotoFile [file join [file dirname [info script]] earth.gif] + image create photo gif1 + gif1 read $earthPhotoFile -from 152 62 185 97 -to 100 200 + list [lindex [lindex [gif1 data] 200] 100] [image width gif1] [image height gif1] +} -cleanup { + catch {image delete gif1} +} -result {{#d8c8b8} 133 235} +test imgPhoto-19.5 {Read GIF file with -from, -to and -shrink options} -body { + set earthPhotoFile [file join [file dirname [info script]] earth.gif] + image create photo gif1 -file $teapotPhotoFile + gif1 read $earthPhotoFile -from 152 62 185 97 -to 80 120 -shrink + list [lindex [lindex [gif1 data] 120] 80] [image width gif1] [image height gif1] +} -cleanup { + catch {image delete gif1} +} -result {{#d8c8b8} 113 155} +test imgPhoto-19.6 {Read GIF file with -from option, read large region from small file} -body { + set earthPhotoFile [file join [file dirname [info script]] earth.gif] + image create photo gif1 + catch {gif1 read $earthPhotoFile -from 152 62 2000 1000} msg + list $msg [image width gif1] [image height gif1] +} -cleanup { + catch {image delete gif1} +} -result {{coordinates for -from option extend outside source image} 0 0} +unset earthPhotoFile + +set ousterPhotoFile [file join [file dirname [info script]] ouster.png] +test imgPhoto-20.1 {Read PNG file with -from option - Bug [1576528]} -body { + image create photo png1 + png1 read $ousterPhotoFile -from 102 62 135 97 + list [lindex [lindex [png1 data] 0] 0] [image width png1] [image height png1] +} -cleanup { + catch {image delete png1} +} -result {{#c97962} 33 35} +test imgPhoto-20.2 {Read PNG file, copy with -from option} -body { + image create photo png1 -file $ousterPhotoFile + image create photo png2 + png2 copy png1 -from 102 62 135 97 + list [lindex [lindex [png2 data] 0] 0] [image width png2] [image height png2] +} -cleanup { + catch {image delete png1 ; image delete png2} +} -result {{#c97962} 33 35} +test imgPhoto-20.3 {Read PNG file with -to option} -body { + image create photo png1 + png1 read $ousterPhotoFile -to 100 200 + list [lindex [lindex [png1 data] 262] 202] [image width png1] [image height png1] +} -cleanup { + catch {image delete png1} +} -result {{#c97962} 242 381} +test imgPhoto-20.4 {Read PNG file with -from and -to options} -body { + image create photo png1 + png1 read $ousterPhotoFile -from 102 62 135 97 -to 100 200 + list [lindex [lindex [png1 data] 200] 100] [image width png1] [image height png1] +} -cleanup { + catch {image delete png1} +} -result {{#c97962} 133 235} +test imgPhoto-20.5 {Read PNG file with -from, -to and -shrink options} -body { + image create photo png1 -file $teapotPhotoFile + png1 read $ousterPhotoFile -from 102 62 135 97 -to 80 120 -shrink + list [lindex [lindex [png1 data] 120] 80] [image width png1] [image height png1] +} -cleanup { + catch {image delete png1} +} -result {{#c97962} 113 155} +test imgPhoto-20.6 {Read PNG file with -from option, read large region from small file} -body { + image create photo png1 + catch {png1 read $ousterPhotoFile -from 102 62 2000 1000} msg + list $msg [image width png1] [image height png1] +} -cleanup { + catch {image delete png1} +} -result {{coordinates for -from option extend outside source image} 0 0} +unset ousterPhotoFile catch {rename foreachPixel {}} catch {rename checkImgTrans {}} catch {rename checkImgTransLoop {}} imageFinish Index: tests/menu.test ================================================================== --- tests/menu.test +++ tests/menu.test @@ -9,13 +9,10 @@ namespace import ::tcltest::* eval tcltest::configure $argv tcltest::loadTestedCommands imageInit -# find the earth.gif file for use in these tests (tests 2.*) -set earthPhotoFile [file join [file dirname [info script]] earth.gif] -testConstraint hasEarthPhoto [file exists $earthPhotoFile] testConstraint pressbutton [llength [info commands pressbutton]] testConstraint movemouse [llength [info commands movemouse]] test menu-1.1 {Tk_MenuCmd procedure} -body { menu @@ -288,13 +285,12 @@ .m1 add cascade -label "cascade" -menu .m2 .m1 add separator .m1 add checkbutton -label "checkbutton" -variable check -onvalue on -offvalue off .m1 add radiobutton -label "radiobutton" -variable radio -if {[testConstraint hasEarthPhoto]} { - image create photo image1 -file $earthPhotoFile -} +set earthPhotoFile [file join [file dirname [info script]] earth.gif] +image create photo image1 -file $earthPhotoFile test menu-2.31 {entry configuration options 0 -activebackground #012345 tearoff} -body { .m1 entryconfigure 0 -activebackground #012345 } -returnCodes error -result {unknown option "-activebackground"} @@ -690,58 +686,46 @@ test menu-2.120 {entry configuration options 5 -foreground non-existent radiobutton} -body { .m1 entryconfigure 5 -foreground non-existent } -returnCodes error -result {unknown color name "non-existent"} -test menu-2.121 {entry configuration options 0 -image image1 tearoff} -constraints { - hasEarthPhoto -} -body { +test menu-2.121 {entry configuration options 0 -image image1 tearoff} -body { .m1 entryconfigure 0 -image image1 } -returnCodes error -result {unknown option "-image"} -test menu-2.122 {entry configuration options 1 -image image1 command} -constraints { - hasEarthPhoto -} -setup { +test menu-2.122 {entry configuration options 1 -image image1 command} -setup { .m1 entryconfigure 1 -image {} } -body { .m1 entryconfigure 1 -image image1 lindex [.m1 entryconfigure 1 -image] 4 } -cleanup { .m1 entryconfigure 1 -image {} } -result {image1} -test menu-2.123 {entry configuration options 2 -image image1 cascade} -constraints { - hasEarthPhoto -} -setup { +test menu-2.123 {entry configuration options 2 -image image1 cascade} -setup { .m1 entryconfigure 2 -image {} } -body { .m1 entryconfigure 2 -image image1 lindex [.m1 entryconfigure 2 -image] 4 } -cleanup { .m1 entryconfigure 2 -image {} } -result {image1} -test menu-2.124 {entry configuration options 3 -image image1 separator} -constraints { - hasEarthPhoto -} -body { +test menu-2.124 {entry configuration options 3 -image image1 separator} -body { .m1 entryconfigure 3 -image image1 } -returnCodes error -result {unknown option "-image"} -test menu-2.125 {entry configuration options 4 -image image1 checkbutton} -constraints { - hasEarthPhoto -} -setup { +test menu-2.125 {entry configuration options 4 -image image1 checkbutton} -setup { .m1 entryconfigure 4 -image {} } -body { .m1 entryconfigure 4 -image image1 lindex [.m1 entryconfigure 4 -image] 4 } -cleanup { .m1 entryconfigure 4 -image {} } -result {image1} -test menu-2.126 {entry configuration options 5 -image image1 radiobutton} -constraints { - hasEarthPhoto -} -setup { +test menu-2.126 {entry configuration options 5 -image image1 radiobutton} -setup { .m1 entryconfigure 5 -image {} } -body { .m1 entryconfigure 5 -image image1 lindex [.m1 entryconfigure 5 -image] 4 } -cleanup { @@ -981,48 +965,36 @@ test menu-2.180 {entry configuration options 5 -selectcolor non-existent radiobutton} -body { .m1 entryconfigure 5 -selectcolor non-existent } -returnCodes error -result {unknown color name "non-existent"} -test menu-2.181 {entry configuration options 0 -selectimage image1 tearoff} -constraints { - hasEarthPhoto -} -body { +test menu-2.181 {entry configuration options 0 -selectimage image1 tearoff} -body { .m1 entryconfigure 0 -selectimage image1 } -returnCodes error -result {unknown option "-selectimage"} -test menu-2.182 {entry configuration options 1 -selectimage image1 command} -constraints { - hasEarthPhoto -} -body { +test menu-2.182 {entry configuration options 1 -selectimage image1 command} -body { .m1 entryconfigure 1 -selectimage image1 } -returnCodes error -result {unknown option "-selectimage"} -test menu-2.183 {entry configuration options 2 -selectimage image1 cascade} -constraints { - hasEarthPhoto -} -body { +test menu-2.183 {entry configuration options 2 -selectimage image1 cascade} -body { .m1 entryconfigure 2 -selectimage image1 } -returnCodes error -result {unknown option "-selectimage"} -test menu-2.184 {entry configuration options 3 -selectimage image1 separator} -constraints { - hasEarthPhoto -} -body { +test menu-2.184 {entry configuration options 3 -selectimage image1 separator} -body { .m1 entryconfigure 3 -selectimage image1 } -returnCodes error -result {unknown option "-selectimage"} -test menu-2.185 {entry configuration options 4 -selectimage image1 checkbutton} -constraints { - hasEarthPhoto -} -setup { +test menu-2.185 {entry configuration options 4 -selectimage image1 checkbutton} -setup { .m1 entryconfigure 4 -selectimage {} } -body { .m1 entryconfigure 4 -selectimage image1 lindex [.m1 entryconfigure 4 -selectimage] 4 } -cleanup { .m1 entryconfigure 4 -selectimage {} } -result {image1} -test menu-2.186 {entry configuration options 5 -selectimage image1 radiobutton} -constraints { - hasEarthPhoto -} -setup { +test menu-2.186 {entry configuration options 5 -selectimage image1 radiobutton} -setup { .m1 entryconfigure 5 -selectimage {} } -body { .m1 entryconfigure 5 -selectimage image1 lindex [.m1 entryconfigure 5 -selectimage] 4 } -cleanup { @@ -1210,14 +1182,11 @@ test menu-2.228 {entry configuration options 5 -underline 3p radiobutton} -body { .m1 entryconfigure 5 -underline 3p } -returnCodes error -result {expected integer but got "3p"} deleteWindows -if {[testConstraint hasEarthPhoto]} { - image delete image1 -} - +image delete image1 test menu-3.1 {MenuWidgetCmd procedure} -setup { destroy .m1 } -body { @@ -2329,11 +2298,11 @@ menu .m1 menu .m2 .m1 add cascade -menu .m2 list [.m1 delete 1] [destroy .m1 .m2] } -result {{} {}} -test menu-8.2 {DestroyMenuEntry} -constraints hasEarthPhoto -setup { +test menu-8.2 {DestroyMenuEntry} -setup { deleteWindows catch {image delete image1a} } -body { image create photo image1a -file $earthPhotoFile menu .m1 @@ -2670,11 +2639,11 @@ } -cleanup { deleteWindows imageCleanup } -result {} test menu-11.19 {ConfigureMenuEntry} -constraints { - testImageType hasEarthPhoto + testImageType } -setup { deleteWindows imageCleanup } -body { image create test image1 @@ -2685,11 +2654,11 @@ } -cleanup { deleteWindows imageCleanup } -result {} test menu-11.20 {ConfigureMenuEntry} -constraints { - testImageType hasEarthPhoto + testImageType } -setup { deleteWindows imageCleanup } -body { image create photo image1 -file $earthPhotoFile @@ -2700,11 +2669,11 @@ } -cleanup { deleteWindows imageCleanup } -result {} test menu-11.21 {ConfigureMenuEntry} -constraints { - testImageType hasEarthPhoto + testImageType } -setup { deleteWindows imageCleanup } -body { image create photo image1 -file $earthPhotoFile @@ -2715,10 +2684,12 @@ .m1 entryconfigure 1 -selectimage image3 } -cleanup { deleteWindows imageCleanup } -result {} + +unset earthPhotoFile test menu-12.1 {ConfigureMenuCloneEntries} -setup { deleteWindows } -body { ADDED tests/ouster.png Index: tests/ouster.png ================================================================== --- /dev/null +++ tests/ouster.png cannot compute difference between binary files