From 5f282fbabb61c71f5dcac0a3664bd3e6061585fe Mon Sep 17 00:00:00 2001
From: fvogel <fvogelnew1@free.fr>
Date: Sat, 8 Jun 2024 20:39:55 +0000
Subject: Add test imgPhoto-19.1 demonstrating bug [1576528] for the GIF case,
 and imgPhoto-19.2 (which shows a workaround and passes).

---
 tests/constraints.tcl |  4 ++++
 tests/imgPhoto.test   | 16 ++++++++++++++++
 tests/menu.test       |  3 ---
 3 files changed, 20 insertions(+), 3 deletions(-)

diff --git a/tests/constraints.tcl b/tests/constraints.tcl
index ad0ca85..22bc52d 100644
--- a/tests/constraints.tcl
+++ b/tests/constraints.tcl
@@ -296,6 +296,10 @@ testConstraint testtext      [llength [info commands testtext]]
 testConstraint testwinevent  [llength [info commands testwinevent]]
 testConstraint testwrapper   [llength [info commands testwrapper]]
 
+# the earth.gif file is used in some tests
+set earthPhotoFile [file join [file dirname [info script]] earth.gif]
+testConstraint hasEarthPhoto [file exists $earthPhotoFile]
+
 # constraints about what sort of fonts are available
 testConstraint fonts 1
 destroy .e
diff --git a/tests/imgPhoto.test b/tests/imgPhoto.test
index 1d3b6e5..54294b9 100644
--- a/tests/imgPhoto.test
+++ b/tests/imgPhoto.test
@@ -1425,6 +1425,22 @@ test imgPhoto-18.12 {Valid GIF (file)} -setup {
     catch {image delete gif1}
 } -result gif1
 
+test imgPhoto-19.1 {Read GIF file with -from option - Bug [1576528]} -constraints hasEarthPhoto -body {
+    image create photo gif1
+    gif1 read $earthPhotoFile -from 152 62 185 97
+    lindex [lindex [gif1 data] 0] 0
+} -cleanup {
+    catch {image delete gif1}
+} -result {#d8c8b8}
+test imgPhoto-19.2 {Read GIF file, copy with -from option} -constraints hasEarthPhoto -body {
+    image create photo gif1 -file $earthPhotoFile
+    image create photo gif2
+    gif2 copy gif1 -from 152 62 185 97
+    lindex [lindex [gif2 data] 0] 0
+} -cleanup {
+    catch {image delete gif1 ; image delete gif2}
+} -result {#d8c8b8}
+
 catch {rename foreachPixel {}}
 catch {rename checkImgTrans {}}
 catch {rename checkImgTransLoop {}}
diff --git a/tests/menu.test b/tests/menu.test
index 7fed665..8b3b556 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]]
 
-- 
cgit v0.12


From cba533255d5353b806f6c3369b3bd6dcb060269d Mon Sep 17 00:00:00 2001
From: fvogel <fvogelnew1@free.fr>
Date: Sat, 8 Jun 2024 20:45:23 +0000
Subject: Fix [1576528fff]: image read file with -from option - GIF case

---
 generic/tkImgGIF.c | 3 +++
 1 file changed, 3 insertions(+)

diff --git a/generic/tkImgGIF.c b/generic/tkImgGIF.c
index 3467bd5..23a2953 100644
--- a/generic/tkImgGIF.c
+++ b/generic/tkImgGIF.c
@@ -710,11 +710,14 @@ FileReadGIF(
 	    ckfree(block.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) {
+	    block.pixelPtr -= srcX * block.pixelSize + srcY * block.pitch;
 	    ckfree(block.pixelPtr);
 	    goto error;
 	}
+	block.pixelPtr -= srcX * block.pixelSize + srcY * block.pitch;
 	ckfree(block.pixelPtr);
     }
 
-- 
cgit v0.12


From ac4a3d5ccfb8d411352a169e6e3ad3fb3bdd6f94 Mon Sep 17 00:00:00 2001
From: fvogel <fvogelnew1@free.fr>
Date: Sat, 8 Jun 2024 20:58:57 +0000
Subject: Add test imgPhoto-19.3 demonstrating bug [1576528] for the PNG case,
 and imgPhoto-19.4 (which shows a workaround and passes).

---
 tests/constraints.tcl |   4 +++-
 tests/imgPhoto.test   |  15 +++++++++++++++
 tests/ouster.png      | Bin 0 -> 54257 bytes
 3 files changed, 18 insertions(+), 1 deletion(-)
 create mode 100644 tests/ouster.png

diff --git a/tests/constraints.tcl b/tests/constraints.tcl
index 22bc52d..1087d25 100644
--- a/tests/constraints.tcl
+++ b/tests/constraints.tcl
@@ -296,9 +296,11 @@ testConstraint testtext      [llength [info commands testtext]]
 testConstraint testwinevent  [llength [info commands testwinevent]]
 testConstraint testwrapper   [llength [info commands testwrapper]]
 
-# the earth.gif file is used in some tests
+# Some graphic files used in some tests
 set earthPhotoFile [file join [file dirname [info script]] earth.gif]
 testConstraint hasEarthPhoto [file exists $earthPhotoFile]
+set ousterPhotoFile [file join [file dirname [info script]] ouster.png]
+testConstraint hasOusterPhoto [file exists $ousterPhotoFile]
 
 # constraints about what sort of fonts are available
 testConstraint fonts 1
diff --git a/tests/imgPhoto.test b/tests/imgPhoto.test
index 54294b9..78ddcd7 100644
--- a/tests/imgPhoto.test
+++ b/tests/imgPhoto.test
@@ -1440,6 +1440,21 @@ test imgPhoto-19.2 {Read GIF file, copy with -from option} -constraints hasEarth
 } -cleanup {
     catch {image delete gif1 ; image delete gif2}
 } -result {#d8c8b8}
+test imgPhoto-19.3 {Read PNG file with -from option - Bug [1576528]} -constraints hasOusterPhoto -body {
+    image create photo png1
+    png1 read $ousterPhotoFile -from 102 62 135 97
+    lindex [lindex [png1 data] 0] 0
+} -cleanup {
+    catch {image delete png1}
+} -result {#c97962}
+test imgPhoto-19.4 {Read PNG file, copy with -from option} -constraints hasOusterPhoto -body {
+    image create photo png1 -file $ousterPhotoFile
+    image create photo png2
+    png2 copy png1 -from 102 62 135 97
+    lindex [lindex [png2 data] 0] 0
+} -cleanup {
+    catch {image delete png1 ; image delete png2}
+} -result {#c97962}
 
 catch {rename foreachPixel {}}
 catch {rename checkImgTrans {}}
diff --git a/tests/ouster.png b/tests/ouster.png
new file mode 100644
index 0000000..259b8f9
Binary files /dev/null and b/tests/ouster.png differ
-- 
cgit v0.12


From 3904a64e4920c1e91b5b1dfec542cc8a159caed2 Mon Sep 17 00:00:00 2001
From: fvogel <fvogelnew1@free.fr>
Date: Sun, 9 Jun 2024 07:35:29 +0000
Subject: Less ugly fix for the GIF case.

---
 generic/tkImgGIF.c | 16 ++++++++--------
 1 file changed, 8 insertions(+), 8 deletions(-)

diff --git a/generic/tkImgGIF.c b/generic/tkImgGIF.c
index 23a2953..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,26 +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) {
-	    block.pixelPtr -= srcX * block.pixelSize + srcY * block.pitch;
-	    ckfree(block.pixelPtr);
+	    ckfree(pixelPtr);
 	    goto error;
 	}
-	block.pixelPtr -= srcX * block.pixelSize + srcY * block.pitch;
-	ckfree(block.pixelPtr);
+	ckfree(pixelPtr);
     }
 
     /*
-- 
cgit v0.12


From 620f58a044a9b25a3b58df35d4eb16cbfb05b7ff Mon Sep 17 00:00:00 2001
From: fvogel <fvogelnew1@free.fr>
Date: Sun, 9 Jun 2024 12:13:28 +0000
Subject: Fix [1576528fff]: image read file with -from option - PNG case

---
 generic/tkImgPNG.c | 76 ++++++++++++++++++++++++++++--------------------------
 1 file changed, 40 insertions(+), 36 deletions(-)

diff --git a/generic/tkImgPNG.c b/generic/tkImgPNG.c
index 83406d9..c44c7fe 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;
 
     /*
@@ -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);
-- 
cgit v0.12


From 349a69f9287ebf1e15f32de11cca27f67713ade7 Mon Sep 17 00:00:00 2001
From: fvogel <fvogelnew1@free.fr>
Date: Sun, 9 Jun 2024 12:29:09 +0000
Subject: Remove constraints hasEarthPhoto and hasOusterPhoto, the image files
 used in the tests are distributed in the tests directory so these constraints
 are always satisfied.

---
 tests/constraints.tcl |  6 -----
 tests/imgPhoto.test   | 16 +++++++++---
 tests/menu.test       | 68 ++++++++++++++++-----------------------------------
 3 files changed, 33 insertions(+), 57 deletions(-)

diff --git a/tests/constraints.tcl b/tests/constraints.tcl
index 1087d25..ad0ca85 100644
--- a/tests/constraints.tcl
+++ b/tests/constraints.tcl
@@ -296,12 +296,6 @@ testConstraint testtext      [llength [info commands testtext]]
 testConstraint testwinevent  [llength [info commands testwinevent]]
 testConstraint testwrapper   [llength [info commands testwrapper]]
 
-# Some graphic files used in some tests
-set earthPhotoFile [file join [file dirname [info script]] earth.gif]
-testConstraint hasEarthPhoto [file exists $earthPhotoFile]
-set ousterPhotoFile [file join [file dirname [info script]] ouster.png]
-testConstraint hasOusterPhoto [file exists $ousterPhotoFile]
-
 # constraints about what sort of fonts are available
 testConstraint fonts 1
 destroy .e
diff --git a/tests/imgPhoto.test b/tests/imgPhoto.test
index 78ddcd7..f6ed988 100644
--- a/tests/imgPhoto.test
+++ b/tests/imgPhoto.test
@@ -1425,35 +1425,43 @@ test imgPhoto-18.12 {Valid GIF (file)} -setup {
     catch {image delete gif1}
 } -result gif1
 
-test imgPhoto-19.1 {Read GIF file with -from option - Bug [1576528]} -constraints hasEarthPhoto -body {
+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
     lindex [lindex [gif1 data] 0] 0
 } -cleanup {
     catch {image delete gif1}
+    unset earthPhotoFile
 } -result {#d8c8b8}
-test imgPhoto-19.2 {Read GIF file, copy with -from option} -constraints hasEarthPhoto -body {
+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
     lindex [lindex [gif2 data] 0] 0
 } -cleanup {
     catch {image delete gif1 ; image delete gif2}
+    unset earthPhotoFile
 } -result {#d8c8b8}
-test imgPhoto-19.3 {Read PNG file with -from option - Bug [1576528]} -constraints hasOusterPhoto -body {
+test imgPhoto-19.3 {Read PNG file with -from option - Bug [1576528]} -body {
+    set ousterPhotoFile [file join [file dirname [info script]] ouster.png]
     image create photo png1
     png1 read $ousterPhotoFile -from 102 62 135 97
     lindex [lindex [png1 data] 0] 0
 } -cleanup {
     catch {image delete png1}
+    unset ousterPhotoFile
 } -result {#c97962}
-test imgPhoto-19.4 {Read PNG file, copy with -from option} -constraints hasOusterPhoto -body {
+test imgPhoto-19.4 {Read PNG file, copy with -from option} -body {
+    set ousterPhotoFile [file join [file dirname [info script]] ouster.png]
     image create photo png1 -file $ousterPhotoFile
     image create photo png2
     png2 copy png1 -from 102 62 135 97
     lindex [lindex [png2 data] 0] 0
 } -cleanup {
     catch {image delete png1 ; image delete png2}
+    unset ousterPhotoFile
 } -result {#c97962}
 
 catch {rename foreachPixel {}}
diff --git a/tests/menu.test b/tests/menu.test
index 8b3b556..b345e26 100644
--- a/tests/menu.test
+++ b/tests/menu.test
@@ -287,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
@@ -689,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
@@ -706,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
@@ -717,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
@@ -734,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
@@ -980,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
@@ -1015,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
@@ -1209,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 {
@@ -2328,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 {
@@ -2669,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
@@ -2684,7 +2656,7 @@ test menu-11.19 {ConfigureMenuEntry} -constraints {
     imageCleanup
 } -result {}
 test menu-11.20 {ConfigureMenuEntry} -constraints {
-    testImageType hasEarthPhoto
+    testImageType
 } -setup {
     deleteWindows
     imageCleanup
@@ -2699,7 +2671,7 @@ test menu-11.20 {ConfigureMenuEntry} -constraints {
     imageCleanup
 } -result {}
 test menu-11.21 {ConfigureMenuEntry} -constraints {
-    testImageType hasEarthPhoto
+    testImageType
 } -setup {
     deleteWindows
     imageCleanup
@@ -2715,6 +2687,8 @@ test menu-11.21 {ConfigureMenuEntry} -constraints {
     imageCleanup
 } -result {}
 
+unset earthPhotoFile
+
 
 test menu-12.1 {ConfigureMenuCloneEntries} -setup {
     deleteWindows
-- 
cgit v0.12


From 25eb1dc787868840925c52258f560534f860d435 Mon Sep 17 00:00:00 2001
From: fvogel <fvogelnew1@free.fr>
Date: Sun, 9 Jun 2024 16:44:10 +0000
Subject: Fix width and height of the image read (PNG case only, GIF was
 already OK).

---
 generic/tkImgPNG.c  |  4 ++--
 tests/imgPhoto.test | 16 ++++++++--------
 2 files changed, 10 insertions(+), 10 deletions(-)

diff --git a/generic/tkImgPNG.c b/generic/tkImgPNG.c
index c44c7fe..fccb465 100644
--- a/generic/tkImgPNG.c
+++ b/generic/tkImgPNG.c
@@ -2488,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;
     }
 
diff --git a/tests/imgPhoto.test b/tests/imgPhoto.test
index f6ed988..43f487f 100644
--- a/tests/imgPhoto.test
+++ b/tests/imgPhoto.test
@@ -1429,40 +1429,40 @@ 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
-    lindex [lindex [gif1 data] 0] 0
+    list [lindex [lindex [gif1 data] 0] 0] [image width gif1] [image height gif1]
 } -cleanup {
     catch {image delete gif1}
     unset earthPhotoFile
-} -result {#d8c8b8}
+} -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
-    lindex [lindex [gif2 data] 0] 0
+    list [lindex [lindex [gif2 data] 0] 0] [image width gif2] [image height gif2]
 } -cleanup {
     catch {image delete gif1 ; image delete gif2}
     unset earthPhotoFile
-} -result {#d8c8b8}
+} -result {{#d8c8b8} 33 35}
 test imgPhoto-19.3 {Read PNG file with -from option - Bug [1576528]} -body {
     set ousterPhotoFile [file join [file dirname [info script]] ouster.png]
     image create photo png1
     png1 read $ousterPhotoFile -from 102 62 135 97
-    lindex [lindex [png1 data] 0] 0
+    list [lindex [lindex [png1 data] 0] 0] [image width png1] [image height png1]
 } -cleanup {
     catch {image delete png1}
     unset ousterPhotoFile
-} -result {#c97962}
+} -result {{#c97962} 33 35}
 test imgPhoto-19.4 {Read PNG file, copy with -from option} -body {
     set ousterPhotoFile [file join [file dirname [info script]] ouster.png]
     image create photo png1 -file $ousterPhotoFile
     image create photo png2
     png2 copy png1 -from 102 62 135 97
-    lindex [lindex [png2 data] 0] 0
+    list [lindex [lindex [png2 data] 0] 0] [image width png2] [image height png2]
 } -cleanup {
     catch {image delete png1 ; image delete png2}
     unset ousterPhotoFile
-} -result {#c97962}
+} -result {{#c97962} 33 35}
 
 catch {rename foreachPixel {}}
 catch {rename checkImgTrans {}}
-- 
cgit v0.12


From 8362e9ef8e64a52adae203d7e629e13156113186 Mon Sep 17 00:00:00 2001
From: fvogel <fvogelnew1@free.fr>
Date: Sun, 9 Jun 2024 17:38:52 +0000
Subject: Add more tests for GIF and PNG images read with -from and/or -to
 options.

---
 tests/imgPhoto.test | 44 ++++++++++++++++++++++++++++++++++++--------
 1 file changed, 36 insertions(+), 8 deletions(-)

diff --git a/tests/imgPhoto.test b/tests/imgPhoto.test
index 43f487f..45fd396 100644
--- a/tests/imgPhoto.test
+++ b/tests/imgPhoto.test
@@ -1425,6 +1425,7 @@ 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
@@ -1432,7 +1433,6 @@ test imgPhoto-19.1 {Read GIF file with -from option - Bug [1576528]} -body {
     list [lindex [lindex [gif1 data] 0] 0] [image width gif1] [image height gif1]
 } -cleanup {
     catch {image delete gif1}
-    unset earthPhotoFile
 } -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]
@@ -1442,27 +1442,55 @@ test imgPhoto-19.2 {Read GIF file, copy with -from option} -body {
     list [lindex [lindex [gif2 data] 0] 0] [image width gif2] [image height gif2]
 } -cleanup {
     catch {image delete gif1 ; image delete gif2}
-    unset earthPhotoFile
 } -result {{#d8c8b8} 33 35}
-test imgPhoto-19.3 {Read PNG file with -from option - Bug [1576528]} -body {
-    set ousterPhotoFile [file join [file dirname [info script]] ouster.png]
+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}
+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}
-    unset ousterPhotoFile
 } -result {{#c97962} 33 35}
-test imgPhoto-19.4 {Read PNG file, copy with -from option} -body {
-    set ousterPhotoFile [file join [file dirname [info script]] ouster.png]
+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}
-    unset ousterPhotoFile
 } -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}
+unset ousterPhotoFile
 
 catch {rename foreachPixel {}}
 catch {rename checkImgTrans {}}
-- 
cgit v0.12


From 3ef006b70f69d3fc0a86bceb3360eb7549cd04bb Mon Sep 17 00:00:00 2001
From: fvogel <fvogelnew1@free.fr>
Date: Sun, 9 Jun 2024 18:21:33 +0000
Subject: Remove constraint hasTeapotPhoto, the image file used in the tests is
 distributed in the tests directory so this constraint is always satisfied.

---
 tests/imgPhoto.test | 120 ++++++++++++++--------------------------------------
 1 file changed, 32 insertions(+), 88 deletions(-)

diff --git a/tests/imgPhoto.test b/tests/imgPhoto.test
index 45fd396..802c960 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
-- 
cgit v0.12


From 2e885d3219e939c63c04be3594ef1070ad1eb7b5 Mon Sep 17 00:00:00 2001
From: fvogel <fvogelnew1@free.fr>
Date: Sun, 9 Jun 2024 18:38:47 +0000
Subject: Add more tests for GIF and PNG images read with -from, -to and
 -shrink options.

---
 tests/imgPhoto.test | 15 +++++++++++++++
 1 file changed, 15 insertions(+)

diff --git a/tests/imgPhoto.test b/tests/imgPhoto.test
index 802c960..741a4c0 100644
--- a/tests/imgPhoto.test
+++ b/tests/imgPhoto.test
@@ -1402,6 +1402,14 @@ test imgPhoto-19.4 {Read GIF file with -from and -to options} -body {
 } -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}
 unset earthPhotoFile
 
 set ousterPhotoFile [file join [file dirname [info script]] ouster.png]
@@ -1434,6 +1442,13 @@ test imgPhoto-20.4 {Read PNG file with -from and -to options} -body {
 } -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}
 unset ousterPhotoFile
 
 catch {rename foreachPixel {}}
-- 
cgit v0.12


From f59389521788b120e5293872c26ececc0724b294 Mon Sep 17 00:00:00 2001
From: fvogel <fvogelnew1@free.fr>
Date: Sun, 9 Jun 2024 18:51:00 +0000
Subject: Add more tests for GIF and PNG images: read large region from small
 file.

---
 tests/imgPhoto.test | 15 +++++++++++++++
 1 file changed, 15 insertions(+)

diff --git a/tests/imgPhoto.test b/tests/imgPhoto.test
index 741a4c0..62b0587 100644
--- a/tests/imgPhoto.test
+++ b/tests/imgPhoto.test
@@ -1410,6 +1410,14 @@ test imgPhoto-19.5 {Read GIF file with -from, -to and -shrink options} -body {
 } -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]
@@ -1449,6 +1457,13 @@ test imgPhoto-20.5 {Read PNG file with -from, -to and -shrink options} -body {
 } -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 {}}
-- 
cgit v0.12