diff options
author | fvogel <fvogelnew1@free.fr> | 2024-06-11 03:17:35 (GMT) |
---|---|---|
committer | fvogel <fvogelnew1@free.fr> | 2024-06-11 03:17:35 (GMT) |
commit | 15dc2cfa976b10c2dcd29e446a331a7d7f04b790 (patch) | |
tree | 44df2ad1b11369807463f910f8ac4a6702bb0edf | |
parent | 13ad83e207e848df4017b03f3f51087b16c2b079 (diff) | |
parent | f59389521788b120e5293872c26ececc0724b294 (diff) | |
download | tk-15dc2cfa976b10c2dcd29e446a331a7d7f04b790.zip tk-15dc2cfa976b10c2dcd29e446a331a7d7f04b790.tar.gz tk-15dc2cfa976b10c2dcd29e446a331a7d7f04b790.tar.bz2 |
Fix [1576528fff]: image read file with -from option.
-rw-r--r-- | generic/tkImgGIF.c | 15 | ||||
-rw-r--r-- | generic/tkImgPNG.c | 80 | ||||
-rw-r--r-- | tests/imgPhoto.test | 217 | ||||
-rw-r--r-- | tests/menu.test | 71 | ||||
-rw-r--r-- | tests/ouster.png | bin | 0 -> 54257 bytes |
5 files changed, 201 insertions, 182 deletions
diff --git a/generic/tkImgGIF.c b/generic/tkImgGIF.c index 3467bd5..7e237fa 100644 --- a/generic/tkImgGIF.c +++ b/generic/tkImgGIF.c @@ -677,6 +677,7 @@ FileReadGIF( } if ((width > 0) && (height > 0)) { + unsigned char* pixelPtr; Tk_PhotoImageBlock block; /* @@ -699,23 +700,25 @@ FileReadGIF( 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); } /* diff --git a/generic/tkImgPNG.c b/generic/tkImgPNG.c index 83406d9..fccb465 100644 --- a/generic/tkImgPNG.c +++ b/generic/tkImgPNG.c @@ -196,7 +196,8 @@ 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, @@ -2374,15 +2375,19 @@ ParseFormat( 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; /* @@ -2483,8 +2488,8 @@ DecodePNG( * 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; } @@ -2638,13 +2643,12 @@ DecodePNG( * 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; } /* @@ -2711,17 +2715,17 @@ FileMatchPNG( 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; @@ -2729,7 +2733,7 @@ FileReadPNG( 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); @@ -2799,16 +2803,16 @@ StringMatchPNG( 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; @@ -2817,7 +2821,7 @@ StringReadPNG( 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); diff --git a/tests/imgPhoto.test b/tests/imgPhoto.test index 865e96c..23a80dd 100644 --- a/tests/imgPhoto.test +++ b/tests/imgPhoto.test @@ -55,9 +55,7 @@ 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 @@ -70,16 +68,16 @@ 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] @@ -131,26 +129,20 @@ test imgPhoto-2.2 {ImgPhotoCreate procedure} -setup { # 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 @@ -232,9 +224,7 @@ test imgPhoto-4.9 {ImgPhotoCmd procedure: configure option} -setup { } -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 { @@ -275,9 +265,7 @@ test imgPhoto-4.14 {ImgPhotoCmd procedure: copy option} -setup { } -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 { @@ -287,9 +275,7 @@ test imgPhoto-4.15 {ImgPhotoCmd procedure: copy option} -constraints { } -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 { @@ -298,9 +284,7 @@ test imgPhoto-4.16 {ImgPhotoCmd procedure: copy option} -constraints { } -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 { @@ -309,9 +293,7 @@ test imgPhoto-4.17 {ImgPhotoCmd procedure: copy option} -constraints { } -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 { @@ -320,9 +302,7 @@ test imgPhoto-4.18 {ImgPhotoCmd procedure: copy option} -constraints { } -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 { @@ -331,9 +311,7 @@ test imgPhoto-4.19 {ImgPhotoCmd procedure: copy option} -constraints { } -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 { @@ -342,9 +320,7 @@ test imgPhoto-4.20 {ImgPhotoCmd procedure: copy option} -constraints { } -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 { @@ -365,9 +341,7 @@ test imgPhoto-4.21 {ImgPhotoCmd procedure: copy option} -constraints { } -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 @@ -432,9 +406,7 @@ test imgPhoto-4.30 {ImgPhotoCmd procedure: read option} -setup { } -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 @@ -448,9 +420,7 @@ test imgPhoto-4.32 {ImgPhotoCmd procedure: read option} -setup { } -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 @@ -464,9 +434,7 @@ test imgPhoto-4.34 {ImgPhotoCmd procedure: read option} -setup { } -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 @@ -474,9 +442,7 @@ test imgPhoto-4.35 {ImgPhotoCmd procedure: read option} -constraints { } -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 @@ -802,9 +768,7 @@ test imgPhoto-4.74 {ImgPhotoCmd procedure: put option error handling} -setup { } -cleanup { image delete photo1 } -returnCodes 1 -result {wrong # args: should be "photo1 put data ?-option value ...?"} -test imgPhoto-4.75 {<photo> read command: filename starting with '-'} -constraints { - hasTeapotPhoto -} -body { +test imgPhoto-4.75 {<photo> read command: filename starting with '-'} -body { file copy -force $teapotPhotoFile -teapotPhotoFile image create photo photo1 photo1 read -teapotPhotoFile @@ -812,9 +776,7 @@ test imgPhoto-4.75 {<photo> read command: filename starting with '-'} -constrain 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 { @@ -825,9 +787,7 @@ test imgPhoto-4.76 {ImgPhotoCmd procedure: copy to same image} -constraints { 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 @@ -862,9 +822,7 @@ test imgPhoto-6.1 {ImgPhotoDisplay procedure, blank display} -setup { 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 @@ -877,9 +835,7 @@ test imgPhoto-7.1 {ImgPhotoFree procedure, resource freeing} -constraints { } -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 { @@ -902,9 +858,7 @@ test imgPhoto-7.2 {ImgPhotoFree procedures, unlinking} -constraints { 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 { @@ -923,13 +877,11 @@ test imgPhoto-7.3 {ImgPhotoFree procedures, multiple visuals} -constraints { 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 @@ -947,9 +899,7 @@ test imgPhoto-8.3 {ImgPhotoDelete procedure, name cleanup} -body { 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 @@ -963,9 +913,7 @@ test imgPhoto-10.1 {Tk_ImgPhotoPutBlock procedure} -setup { 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 @@ -977,9 +925,7 @@ test imgPhoto-10.2 {Tk_ImgPhotoPutBlock, same source and dest img} -constraints } -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 @@ -1011,7 +957,7 @@ test imgPhoto-11.1 {Tk_FindPhoto} -setup { 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 @@ -1019,9 +965,7 @@ test imgPhoto-12.1 {Tk_PhotoPutZoomedBlock} -constraints hasTeapotPhoto -body { } -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 @@ -1436,6 +1380,103 @@ test imgPhoto-18.12 {Valid GIF (file)} -setup { 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 {}} diff --git a/tests/menu.test b/tests/menu.test index 7fed665..b345e26 100644 --- a/tests/menu.test +++ b/tests/menu.test @@ -11,9 +11,6 @@ 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]] @@ -290,9 +287,8 @@ menu .m2 -tearoff 1 .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 @@ -692,15 +688,11 @@ test menu-2.120 {entry configuration options 5 -foreground non-existent radiobut .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 @@ -709,9 +701,7 @@ test menu-2.122 {entry configuration options 1 -image image1 command} -constrain .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 @@ -720,15 +710,11 @@ test menu-2.123 {entry configuration options 2 -image image1 cascade} -constrain .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 @@ -737,9 +723,7 @@ test menu-2.125 {entry configuration options 4 -image image1 checkbutton} -const .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 @@ -983,33 +967,23 @@ test menu-2.180 {entry configuration options 5 -selectcolor non-existent radiobu .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 @@ -1018,9 +992,7 @@ test menu-2.185 {entry configuration options 4 -selectimage image1 checkbutton} .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 @@ -1212,10 +1184,7 @@ test menu-2.228 {entry configuration options 5 -underline 3p radiobutton} -body } -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 { @@ -2331,7 +2300,7 @@ test menu-8.1 {DestroyMenuEntry} -setup { .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 { @@ -2672,7 +2641,7 @@ test menu-11.18 {ConfigureMenuEntry} -constraints testImageType -setup { imageCleanup } -result {} test menu-11.19 {ConfigureMenuEntry} -constraints { - testImageType hasEarthPhoto + testImageType } -setup { deleteWindows imageCleanup @@ -2687,7 +2656,7 @@ test menu-11.19 {ConfigureMenuEntry} -constraints { imageCleanup } -result {} test menu-11.20 {ConfigureMenuEntry} -constraints { - testImageType hasEarthPhoto + testImageType } -setup { deleteWindows imageCleanup @@ -2702,7 +2671,7 @@ test menu-11.20 {ConfigureMenuEntry} -constraints { imageCleanup } -result {} test menu-11.21 {ConfigureMenuEntry} -constraints { - testImageType hasEarthPhoto + testImageType } -setup { deleteWindows imageCleanup @@ -2718,6 +2687,8 @@ test menu-11.21 {ConfigureMenuEntry} -constraints { imageCleanup } -result {} +unset earthPhotoFile + test menu-12.1 {ConfigureMenuCloneEntries} -setup { deleteWindows diff --git a/tests/ouster.png b/tests/ouster.png Binary files differnew file mode 100644 index 0000000..259b8f9 --- /dev/null +++ b/tests/ouster.png |