Merge trunk.

13 files changed, 1654 insertions, 63 deletions

diff --git a/tests/corruptMangled.gif b/tests/corruptMangled.gif
new file mode 100644
index 0000000..9c1637c
--- /dev/null
+++ b/tests/corruptMangled.gif
diff --git a/tests/corruptMangled4G.gif b/tests/corruptMangled4G.gif
new file mode 100644
index 0000000..7dfde0e
--- /dev/null
+++ b/tests/corruptMangled4G.gif
@@ -0,0 +1,2 @@
+GIF89aÂf3ÿÿ33ÿ3ÿ3ÿ33ÿÿÿÿ3ÿÿÿ!ù
+,!xºÜ-0Bw¤ïÚ¥µê×Jâ8Uæªkir/3Re7  ;
\ No newline at end of file
diff --git a/tests/corruptTruncated.gif b/tests/corruptTruncated.gif
new file mode 100644
index 0000000..948305a
--- /dev/null
+++ b/tests/corruptTruncated.gif
diff --git a/tests/font.test b/tests/font.test
index b8c0144..6f31df8 100644
--- a/tests/font.test
+++ b/tests/font.test
@@ -1956,6 +1956,16 @@ test font-31.6 {Tk_IntersectTextLayout procedure: ignore spaces at eol} -body {
     .t.c itemconfig text -width 0
     return $x
 } -result {}
+test font-31.7 {TkIntersectAngledTextLayout procedure: bug [514ff64dd0]} -body {
+    csetup "This is line one\nand line two\nand line three here"
+    .t.c itemconfigure text -angle 90
+    # Coordinates of the rectangle to check can be hardcoded:
+    # The goal of this test is to check whether the overlap detection algorithm
+    # works when the rectangle is entirely included in a chunk of the text layout.
+    # The text has been rotated 90 degrees around it's upper left corner,
+    # so it's enough to check with a small rectangle with small negative y coords.
+    .t.c find overlapping 5 -7 7 -5
+} -result {1}
 destroy .t.c
 
 
diff --git a/tests/imgListFormat.test b/tests/imgListFormat.test
new file mode 100644
index 0000000..b2c401c
--- /dev/null
+++ b/tests/imgListFormat.test
@@ -0,0 +1,661 @@
+# This file is a Tcl script to test out the default image data format
+# ("list format") implementend in the file tkImgListFormat.c.
+# It is organized in the standard fashion for Tcl tests.
+#
+# Copyright (c) 2017 Simon Bachmann
+# All rights reserved.
+#
+# Author: Simon Bachmann (simonbachmann@bluewin.ch)
+
+package require tcltest 2.2
+namespace import ::tcltest::*
+tcltest::configure {*}$argv
+tcltest::loadTestedCommands
+
+imageInit
+
+# 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]
+# let's see if we have the semi-transparent one as well
+set transpTeapotPhotoFile [file join [file dirname [info script]] teapotTransparent.png]
+testConstraint hasTranspTeapotPhoto [file exists $transpTeapotPhotoFile]
+
+# ---------------------------------------------------------------------
+
+
+test imgListFormat-1.1 {ParseFormatOptions: default values} -setup {
+    image create photo photo1
+} -body {
+    photo1 put {{red green} {blue black}}
+    lindex [photo1 data] 1 1
+} -cleanup {
+    imageCleanup
+} -result {#000000}
+test imgListFormat-1.2 {ParseFormatOptions: format name as first arg} -setup {
+    image create photo photo1
+} -body {
+    photo1 put #1256ef -format {default} -to 0 0 10 10
+} -cleanup {
+    imageCleanup
+} -result {}
+test imgListFormat-1.3 {ParseFormatOptions: unknown option} -setup {
+    image create photo photo1
+} -body {
+    photo1 data -format {default -bogus}
+} -cleanup {
+    imageCleanup
+} -returnCodes error -result {bad format option "-bogus": must be -colorformat}
+test imgListFormat-1.4 {ParseFormatOptions: option not allowed} -setup {
+    image create photo photo1
+} -body {
+    photo1 put yellow -format {default -colorformat rgb}
+} -cleanup {
+    imageCleanup
+} -returnCodes error -result \
+    {bad format option "-colorformat": no options allowed}
+test imgListFormat-1.5 {ParseFormatOptions: no -colorformat value} -setup {
+    image create photo photo1 -data black
+} -body {
+    photo1 data -format {default -colorformat}
+} -returnCodes error -result {the "-colorformat" option requires a value}
+test imgListFormat-1.6 {ParseFormatOptions: bad -colorformat val #1} -setup {
+    image create photo photo1
+} -body {
+    photo1 put yellow
+    photo1 data -format {default -colorformat bogus}
+} -cleanup {
+    imageCleanup
+} -returnCodes error -result \
+    {bad color format "bogus": must be rgb, rgba, or list}
+test imgListFormat-1.7 {ParseFormatOptions: bad -colorformat val #2} -setup {
+    image create photo photo1
+} -body {
+    photo1 data -format {default -colorformat tkcolor}
+} -returnCodes error -result \
+    {bad color format "tkcolor": must be rgb, rgba, or list}
+test imgListFormat-1.8 {ParseFormatOptions: bad -colorformat #3} -setup {
+    image create photo photo1
+} -body {
+    photo1 data -format {default -colorformat emptystring}
+} -returnCodes error -result \
+    {bad color format "emptystring": must be rgb, rgba, or list}
+test imgListFormat-1.9 {ParseFormatOptions: bad -colorformat #4} -setup {
+    image create photo photo1
+} -body {
+    photo1 data -format {default -colorformat rgb-short}
+} -cleanup {
+    imageCleanup
+} -returnCodes error -result \
+    {bad color format "rgb-short": must be rgb, rgba, or list}
+test imgListFormat-1.10 {ParseFormatOptions: bad -colorformat #5} -setup {
+    image create photo photo1
+} -body {
+    photo1 data -format {default -colorformat rgba-short}
+} -returnCodes error -result \
+    {bad color format "rgba-short": must be rgb, rgba, or list}
+test imgListFormat-1.11 {valid colorformats} -setup {
+    image create photo photo1
+} -body {
+    photo1 put white#78
+    set result {}
+    lappend result [photo1 data -format {default -colorformat rgb}]
+    lappend result [photo1 data -format {default -colorformat rgba}]
+    lappend result [photo1 data -format {default -colorformat list}]
+    set result
+} -cleanup {
+    imageCleanup
+    unset result
+} -result {{{#ffffff}} {{#ffffff78}} {{{255 255 255 120}}}}
+
+# GetBadOptMsg: only use case already tested with imgListFormat-1.4
+
+test imgListFormat-3.1 {StringMatchDef: data is not a list} -body {
+    testphotostringmatch {not a " proper list}
+    # " (this comment is here only for editor highlighting)
+} -returnCodes error -result {unmatched open quote in list}
+# empty data case tested with imgPhoto-4.95 (imgPhoto.test)
+test imgListFormat-3.2 {StringMatchDef: \
+        list element not a proper list} -body {
+    testphotostringmatch {{red white} {not "} {blue green}}
+    # "
+} -returnCodes error -result {unmatched open quote in list}
+test imgListFormat-3.3 {StringMatchDef: \
+        sublists with differen lengths} -body {
+    testphotostringmatch {{#001122 #334455 #667788}
+		{#99AABB #CCDDEE}
+		{#FF0011 #223344 #556677}}
+} -returnCodes error -result \
+    {invalid row # 1: all rows must have the same number of elements}
+test imgListFormat-3.4 {StringMatchDef: base64 data is not parsed as valid \
+} -setup {
+    image create photo photo1
+} -body {
+    photo1 put {
+	iVBORw0KGgoAAAANSUhEUgAAAAIAAAACCA
+	YAAAEFsT2yAAAABGdBTUEAAYagMeiWXwAA
+	ABdJREFUCJkFwQEBAAAAgiD6P9pACRoqDk
+	fUBvt1wUFKAAAAAElFTkSuQmCC
+    } -format default
+} -cleanup {
+    imageCleanup
+} -returnCodes error -result {couldn't recognize image data}
+test imgListFormat-3.5 {StringMatchDef: valid data} -setup {
+    image create photo photo1
+} -body {
+    photo1 put {{blue green}
+		{yellow magenta}
+	        {#000000 #FFFFFFFF}}
+    list [image width photo1] [image height photo1] \
+	[photo1 get 0 2 -withalpha]
+} -cleanup {
+    imageCleanup
+} -result {2 3 {0 0 0 255}}
+
+# ImgStringRead: most of the error cases cannot be tested with current code,
+# as the errors are detected by StringMatchDef
+test imgListFormat-4.1 {StringReadDef: use with -format opt} -setup {
+    image create photo photo1
+} -body {
+    photo1 put white -format "default"
+    photo1 get 0 0
+} -cleanup {
+    imageCleanup
+} -result {255 255 255}
+test imgListFormat-4.2 {StringReadDef: suboptions to format} -setup {
+    image create photo photo1
+} -body {
+    photo1 put white -format {default -bogus}
+} -cleanup {
+    imageCleanup
+} -returnCodes error -result \
+    {bad format option "-bogus": no options allowed}
+test imgListFormat-4.3 {StringReadDef: erroneous non-option argument} -setup {
+    image create photo photo1
+} -body {
+    photo1 put orange -format {default bogus}
+} -returnCodes error -result {bad format option "bogus": no options allowed}
+test imgListFormat-4.4 {StringReadDef: normal use case} -constraints {
+    hasTeapotPhoto
+} -setup {
+    image create photo photo1 -file $teapotPhotoFile
+    image create photo photo2
+} -body {
+    set imgData [photo1 data]
+    photo2 put $imgData
+    string equal [photo1 data] [photo2 data]
+} -cleanup {
+    imageCleanup
+    unset imgData
+} -result {1}
+test imgListFormat-4.5 {StringReadDef: correct compositing rule} -constraints {
+    hasTranspTeapotPhoto
+} -setup {
+    image create photo photo1 -file $transpTeapotPhotoFile
+    image create photo photo2
+} -body {
+    photo2 put #FF0000 -to 0 0 50 50
+    photo2 put [photo1 data -format {default -colorformat rgba}] -to 10 10 40 40
+    list [photo2 get 0 0 -withalpha] [photo2 get 20 25 -withalpha] \
+	[photo2 get 49 49 -withalpha]
+} -cleanup {
+    imageCleanup
+} -result {{255 0 0 255} {0 78 185 225} {255 0 0 255}}
+
+test imgListFormat-5.1 {StringWriteDef: format options not a list} -setup {
+    image create photo photo1
+} -body {
+    photo1 data -format {default " bogus}
+    # "
+} -cleanup {
+    imageCleanup
+} -returnCodes error -result {unmatched open quote in list}
+test imgListFormat-5.2 {StringWriteDef: invalid format option} -setup {
+    image create photo photo1
+} -body {
+    photo1 data -format {default -bogus}
+} -cleanup {
+    imageCleanup
+} -returnCodes error -result {bad format option "-bogus": must be -colorformat}
+test imgListFormat-5.3 {StringWriteDef: non-option arg in format} -setup {
+    image create photo photo1
+} -body {
+    photo1 data -format {default -colorformat list bogus}
+} -cleanup {
+    imageCleanup
+} -returnCodes error -result {bad format option "bogus": must be -colorformat}
+test imgListFormat-5.4 {StringWriteDef: empty image} -setup {
+    image create photo photo1
+} -body {
+    photo1 data -format {default -colorformat rgba}
+} -cleanup {
+    imageCleanup
+} -result {}
+test imgListFormat-5.5 {StirngWriteDef: size of data} -setup {
+    image create photo photo1
+} -body {
+    photo1 put blue -to 0 0 35 64
+    set imgData [photo1 data]
+    list [llength [lindex $imgData 0]] [llength $imgData]
+} -cleanup {
+    unset imgData
+    imageCleanup
+} -result {35 64}
+test imgListFormat-5.6 {StringWriteDef: test some pixels #1} -constraints {
+    hasTeapotPhoto
+} -setup {
+    set result {}
+    image create photo photo1 -file $teapotPhotoFile
+} -body {
+    set imgData [photo1 data]
+    # note: with [lindex], the coords are inverted (y x)
+    lappend result [lindex $imgData 0 0]
+    lappend result [lindex $imgData 3 2]
+    lappend result [lindex $imgData 107 53]
+    lappend result [lindex $imgData 203 157]
+    lappend result [lindex $imgData 255 255]
+    set result
+} -cleanup {
+    unset result
+    unset imgData
+    imageCleanup
+} -result {{#135cc0} #135cc0 #a06d52 #e1c8ba #135cc0}
+test imgListFormat-5.7 {StringWriteDef: test some pixels #2} -constraints {
+    hasTeapotPhoto
+} -setup {
+    set result {}
+    image create photo photo1 -file $teapotPhotoFile
+} -body {
+    set imgData [photo1 data -format {default -colorformat rgba}]
+    # note: with [lindex], the coords are inverted (y x)
+    lappend result [lindex $imgData 0 0]
+    lappend result [lindex $imgData 3 2]
+    lappend result [lindex $imgData 107 53]
+    lappend result [lindex $imgData 203 157]
+    lappend result [lindex $imgData 255 255]
+    set result
+} -cleanup {
+    unset result
+    unset imgData
+    imageCleanup
+} -result {{#135cc0ff} #135cc0ff #a06d52ff #e1c8baff #135cc0ff}
+test imgListFormat-5.8 {StringWriteDef: test some pixels #3} -constraints {
+    hasTranspTeapotPhoto
+} -setup {
+    image create photo photo1 -file $transpTeapotPhotoFile
+} -body {
+    set imgData [photo1 data -format {default -colorformat rgb}]
+    set result {}
+    lappend result [lindex $imgData 3 2]
+    lappend result [lindex $imgData 107 53]
+    lappend result [lindex $imgData 203 157]
+    set result
+} -cleanup {
+    unset result
+    unset imgData
+    imageCleanup
+} -result {{#004eb9} #a14100 #ffca9f}
+test imgListFormat-5.9 {StringWriteDef: test some pixels #4} -constraints {
+    hasTranspTeapotPhoto
+} -setup {
+    image create photo photo1 -file $transpTeapotPhotoFile
+} -body {
+    set imgData [photo1 data -format {default -colorformat rgba}]
+    set result [lindex $imgData 3 2]
+    lappend result [lindex $imgData 107 53]
+    lappend result [lindex $imgData 203 157]
+    set result
+} -cleanup {
+    unset result
+    unset imgData
+    imageCleanup
+} -result {{#004eb9e1} #a14100aa #ffca9faf}
+test imgListFormat-5.10 {StringWriteDef: test some pixels #5} -constraints {
+    hasTranspTeapotPhoto
+} -setup {
+    image create photo photo1 -file $transpTeapotPhotoFile
+} -body {
+    set imgData [photo1 data -format {default -colorformat list}]
+    set result {}
+    lappend result [lindex $imgData 3 2]
+    lappend result [lindex $imgData 107 53]
+    lappend result [lindex $imgData 203 157]
+    set result
+} -cleanup {
+    unset imgData
+    unset result
+    imageCleanup
+} -result {{0 78 185 225} {161 65 0 170} {255 202 159 175}}
+
+test imgListFormat-6.1 {ParseColor: empty string} -setup {
+    image create photo photo1
+    set result {}
+} -body {
+    photo1 put {{"" ""} {"" ""}}
+    lappend result [image width photo1]
+    lappend result [image height photo1]
+    lappend result [photo1 get 1 1 -withalpha]
+    set result
+} -cleanup {
+    unset result
+    imageCleanup
+} -result {2 2 {0 0 0 0}}
+test imgListFormat-6.2 {ParseColor: empty string, mixed} -setup {
+    image create photo photo1
+} -body {
+    photo1 put {{black white} {{} white}}
+    list [photo1 get 0 0 -withalpha] [photo1 get 0 1 -withalpha]
+} -cleanup {
+    imageCleanup
+} -result {{0 0 0 255} {0 0 0 0}}
+test imgListFormat-6.3 {ParseColor: color name too long} -setup {
+    image create photo photo1
+    set longstr {}
+    for {set i 1} {$i <= 100} {incr i} {
+        append longstr "z"
+    }
+} -body {
+    photo1 put [list [list blue] [list $longstr]]
+} -cleanup {
+    imageCleanup
+    unset longstr
+} -returnCodes error -result {invalid color}
+test imgListFormat-6.4 {ParseColor: #XXX color, different forms} -setup {
+    image create photo photo1
+} -body {
+    photo1 put {{#A123 #334455} {#012 #fffefd#00}}
+    photo1 data -format {default -colorformat rgba}
+} -cleanup {
+    imageCleanup
+} -result {{#aa112233 #334455ff} {#001122ff #fffefd00}}
+test imgListFormat-6.5 {ParseColor: list format} -setup {
+    image create photo photo1
+} -body {
+    photo1 put [list [list [list 255 255 255]]]
+    photo1 get 0 0 -withalpha
+} -cleanup {
+    imageCleanup
+} -result {255 255 255 255}
+test imgListFormat-6.6 {ParseColor: string format} -setup {
+    image create photo photo1
+} -body {
+    photo1 put [list [list [list white]]]
+    photo1 get 0 0 -withalpha
+} -cleanup {
+    imageCleanup
+} -result {255 255 255 255}
+test imgListFormat-6.7 {ParseColor: invalid color} -setup {
+    image create photo photo1
+} -body {
+    photo1 put {{blue red} {green bogus}}
+} -cleanup {
+    imageCleanup
+} -returnCodes error -result {invalid color name "bogus"}
+test imgListFormat-6.8 {ParseColor: overall test} -setup {
+    image create photo photo1
+    set result {}
+} -body {
+    photo1 put {
+		{snow@0.5 snow#80 snow#8 #fffffafafafa@0.5 #fffffabbfacc#8}
+		{#fffffafffaff#80 #ffffaafaa@.5 #ffffaafaa#8 #ffffaafaa#80 #fee#8}
+		{#fee#80 #fee@0.5 #fffafa@0.5 #fffafa#8 #fffafa#80}
+		{{0xff 250 0xfa 128} {255 250 250} #fee8 #fffafa80 snow}}
+    for {set y 0} {$y < 4} {incr y} {
+		for {set x 0} {$x < 5} {incr x} {
+			lappend result [photo1 get $x $y -withalpha]
+		}
+    }
+    set result
+} -cleanup {
+    imageCleanup
+    unset result
+} -result \
+{{255 250 250 128} {255 250 250 128} {255 250 250 136} {255 250 250 128}\
+{255 250 250 136} {255 250 250 128} {255 250 250 128} {255 250 250 136}\
+{255 250 250 128} {255 238 238 136} {255 238 238 128} {255 238 238 128}\
+{255 250 250 128} {255 250 250 136} {255 250 250 128} {255 250 250 128}\
+{255 250 250 255} {255 238 238 136} {255 250 250 128} {255 250 250 255}}
+
+# Note: these tests were written for an earlier implementation of
+# ParseColorAsList. For this reason, their order and layout do not follow the
+# current code very well. Test coverage is pretty good, nevertheless.
+test imgListFormat-7.1 {ParseColorAsList: invalid list} -setup {
+    image create photo photo1
+} -body {
+    photo1 put {{{123 45 67 89} {123 45 " 67}}}
+	#"
+} -cleanup {
+    imageCleanup
+} -returnCodes error -result {invalid color name "123 45 " 67"}
+#"
+test imgListFormat-7.2 {ParseColorAsList: too few elements in list} -setup {
+    image create photo photo1
+} -body {
+    photo1 put {{{0 255 0 255} {0 255}}}
+} -cleanup {
+    imageCleanup
+} -returnCodes error -result {invalid color name "0 255"}
+test imgListFormat-7.3 {ParseColorAsList: too many elements in list} -setup {
+    image create photo photo1
+} -body {
+    photo1 put {{{0 100 200 255} {0 100 200 255 0}}}
+} -returnCodes error -result {invalid color name "0 100 200 255 0"}
+test imgListFormat-7.4 {ParseColorAsList: not an integer value} -setup {
+    image create photo photo1
+} -body {
+    photo1 put {{{9 0xf3 87 65} {43 21 10 1.0}}}
+} -cleanup {
+    imageCleanup
+} -returnCodes error -result {invalid color name "43 21 10 1.0"}
+test imgListFormat-7.5 {ParseColorAsList: negative value in list} -setup {
+    image create photo photo1
+} -body {
+    photo1 put {{{121 121 121} {121 121 -1}}}
+} -cleanup {
+    imageCleanup
+} -returnCodes error -result {invalid color name "121 121 -1"}
+test imgListFormat-7.6 {ParseColorAsList: value in list too large} -setup {
+    image create photo photo1
+} -body {
+    photo1 put {{{0 1 2 3} {254 255 256}}}
+} -cleanup {
+    imageCleanup
+} -returnCodes error -result {invalid color name "254 255 256"}
+test imgListFormat-7.7 {ParseColorAsList: suffix not allowed} -setup {
+    image create photo photo1
+} -body {
+    photo1 put {{{100 100 100} {100 100 100#FE}}}
+} -cleanup {
+    imageCleanup
+} -returnCodes error -result {invalid color name "100 100 100#FE"}
+test imgListFormat-7.8 {ParseColorAsList: valid list form} -setup {
+    image create photo photo1
+} -body {
+    photo1 put {{{0x0 0x10 0xfe 0xff} {0 100 254}}
+		{{30 30 30 0} {1 1 254 1}}}
+    list [photo1 get 0 0 -withalpha] [photo1 get 1 0 -withalpha] \
+	[photo1 get 0 1 -withalpha] [photo1 get 1 1 -withalpha]
+} -cleanup {
+    imageCleanup
+} -result {{0 16 254 255} {0 100 254 255} {30 30 30 0} {1 1 254 1}}
+test imgListFormat-7.9 {ParseColorAsList: additional spaces in list} -setup {
+    image create photo photo1
+} -body {
+    photo1 put { { { 1 2 3} {1  2	 3} } { {1 2 3  } {  1  2  3   4  }  } }
+    photo1 data -format {default -colorformat rgba}
+} -cleanup {
+    imageCleanup
+} -result {{#010203ff #010203ff} {#010203ff #01020304}}
+test imgListFormat-7.10 {ParseColorAsList: list format, string rep} -setup {
+	image create photo photo1
+} -body {
+	photo1 put {{"111 222 33 44"}}
+	photo1 get 0 0 -withalpha
+} -cleanup {
+	imageCleanup
+} -result {111 222 33 44}
+
+test imgListFormat-8.1 {ParseColorAsHex: RGB format} -setup {
+    image create photo photo1
+} -body {
+    photo1 put {{#010 #001100}}
+    photo1 data
+} -cleanup {
+    imageCleanup
+} -result {{#001100 #001100}}
+test imgListFormat-8.2 {ParseColorAsHex: invalid hex digit} -setup {
+    image create photo photo1
+} -body {
+    photo1 put {#ABCD #ABCZ}
+} -cleanup {
+    imageCleanup
+} -returnCodes error -result {invalid color name "#ABCZ"}
+test imgListFormat-8.3 {ParseColorAsHex: RGB with suffix, 8 chars} -setup {
+    image create photo photo1
+} -body {
+    photo1 put {{#FFfFFf #AbCdef#0}}
+    photo1 data
+} -cleanup {
+    imageCleanup
+} -result {{#ffffff #abcdef}}
+test imgListFormat-8.4 {ParseColor: valid #RGBA color} -setup {
+    image create photo photo1
+} -body {
+    photo1 put {{#9bd5020d #7acF}}
+    list [photo1 get 0 0 -withalpha] [photo1 get 1 0 -withalpha]
+} -cleanup {
+    imageCleanup
+} -result {{155 213 2 13} {119 170 204 255}}
+
+test imgListFormat-9.1 {ParseColorAsStandard:
+        Tk color, valid suffixes} -setup {
+    image create photo photo1
+    set result {}
+} -body {
+    photo1 put {{blue@0.711 #114433#C} {#8D4#1A magenta}}
+    lappend result [photo1 get 0 0 -withalpha]
+    lappend result [photo1 get 1 0 -withalpha]
+    lappend result [photo1 get 0 1 -withalpha]
+    lappend result [photo1 get 1 1 -withalpha]
+    set result
+} -cleanup {
+    unset result
+    imageCleanup
+} -result {{0 0 255 181} {17 68 51 204} {136 221 68 26} {255 0 255 255}}
+test imgListFormat-9.2 {ParseColorAsStandard:
+        Tk color with and w/o suffixes} -setup {
+    image create photo photo1
+    set result {}
+} -body {
+    photo1 put {{#52D8a0 #2B5} {#E47@0.01 maroon#4}}
+    lappend result [photo1 get 0 0 -withalpha]
+    lappend result [photo1 get 1 0 -withalpha]
+    lappend result [photo1 get 0 1 -withalpha]
+    lappend result [photo1 get 1 1 -withalpha]
+    set result
+} -cleanup {
+    unset result
+    imageCleanup
+} -result {{82 216 160 255} {34 187 85 255} {238 68 119 3} {128 0 0 68}}
+test imgListFormat-9.3 {ParseColorAsStandard: wrong digit count} -setup {
+    image create photo photo1
+} -body {
+    photo1 put {{#000 #00}}
+} -returnCodes error -result {invalid color name "#00"}
+test imgListFormat-9.4 {ParseColorAsStandard: @A suffix, not a float} -setup {
+    image create photo photo1
+} -body {
+    photo1 put {{blue@0.5 blue@bogus}}
+} -cleanup {
+    imageCleanup
+} -returnCodes error -result \
+    {invalid alpha suffix "@bogus": expected floating-point value}
+test imgListFormat-9.5 {ParseColorAsStandard: @A, value too low} -setup {
+    image create photo photo1
+} -body {
+    photo1 put {green@.1 green@-0.1}
+} -cleanup {
+    imageCleanup
+} -returnCodes error -result \
+    {invalid alpha suffix "@-0.1": value must be in the range from 0 to 1}
+test imgListFormat-9.6 {ParseColorAsStandard: @A, value too high} -setup {
+    image create photo photo1
+} -body {
+    photo1 put {#000000@0 #000000@1.0001}
+} -cleanup {
+    imageCleanup
+} -returnCodes error -result \
+    {invalid alpha suffix "@1.0001": value must be in the range from 0 to 1}
+test imgListFormat-9.7 {ParseColorAsStandard: @A suffix, edge values} -setup {
+    imageCleanup
+    image create photo photo1
+} -body {
+    photo1 put {{yellow@1e-22 yellow@0.12352941 yellow@0.12352942 \
+		 yellow@0.9999999}}
+    list [photo1 get 0 0 -withalpha] [photo1 get 1 0 -withalpha] \
+	[photo1 get 2 0 -withalpha] [photo1 get 3 0 -withalpha]
+} -cleanup {
+    imageCleanup
+} -result {{255 255 0 0} {255 255 0 31} {255 255 0 32} {255 255 0 255}}
+test imgListFormat-9.8 {ParseColorAsStandard: # suffix, no hex digits} -setup {
+    image create photo photo1
+} -body {
+    photo1 put {{black#f} {black#}}
+} -cleanup {
+    imageCleanup
+} -returnCodes error -result {invalid alpha suffix "#"}
+test imgListFormat-9.9 {ParseColorAsStandard:
+        '#' suffix, too many digits} -setup {
+    image create photo photo1
+} -body {
+    photo1 put {{#ABC#12 #ABC#123}}
+} -cleanup {
+    imageCleanup
+} -returnCodes error -result {invalid alpha suffix "#123"}
+test imgListFormat-9.10 {ParseColorAsStandard:
+        invalid digit in #X suffix} -setup {
+    image create photo photo1
+} -body {
+    photo1 put {#000#a #000#g}
+} -cleanup {
+    imageCleanup
+} -returnCodes error -result {invalid alpha suffix "#g": expected hex digit}
+test imgListFormat-9.11 {ParseColorAsStandard:
+        invalid digit in #XX suffix} -setup {
+    image create photo photo1
+} -body {
+    photo1 put {green#2 green#2W}
+} -cleanup {
+    imageCleanup
+} -returnCodes error -result {invalid alpha suffix "#2W": expected hex digit}
+test imgListFormat-9.12 {ParseColorAsStandard:
+        invalid color: not a hex digit} -setup {
+    image create photo photo1
+} -body {
+    photo1 put {#ABCDEF@.99 #ABCDEG@.99}
+} -cleanup {
+    imageCleanup
+} -returnCodes error -result {invalid color name "#ABCDEG@.99"}
+test imgListFormat-9.13 {ParseColorAsStandard: suffix not allowed #1} -setup {
+    image create photo photo1
+} -body {
+    photo1 put {#ABC@.5 #ABCD@0.5}
+} -cleanup {
+    imageCleanup
+} -returnCodes error -result {invalid color name "#ABCD@0.5"}
+test imgListFormat-9.14 {ParseColorAsStandard: suffix not allowed #2} -setup {
+    image create photo photo1
+} -body {
+    photo1 put {#1111 #1111#1}
+} -cleanup {
+    imageCleanup
+} -returnCodes error -result {invalid color name "#1111#1"}
+
+
+# ---------------------------------------------------------------------
+
+imageFinish
+
+# cleanup
+cleanupTests
+return
diff --git a/tests/imgPhoto.test b/tests/imgPhoto.test
index 86da23d..7f26e67 100644
--- a/tests/imgPhoto.test
+++ b/tests/imgPhoto.test
@@ -10,14 +10,82 @@
 #
 # Author: Paul Mackerras (paulus@cs.anu.edu.au)
 
+#
+# This file is somewhat caothic: the order of the tests does not
+# really follow the order of the corresponding functions in
+# tkImgPhoto.c. Probably, because early versions had only a few tests
+# and over time test cases were added in bits and pieces.
+# To be noted, also, that this file is not complete: large portions of
+# code in tkImgPhoto.c have no test coverage.
+#
+# To help keeping the overview, the table below lists where to find
+# tests for each of the functions in tkImgPhoto.c. The function are
+# listed in the order as they appear in the source file.
+#
+
+#
+# Function name                         Tests for function
+#--------------------------------------------------------------------------
+# PhotoFormatThreadExitProc             no tests
+# Tk_Create*PhotoImageFormat            no tests
+# ImgPhotoCreate                        imgPhoto-2.*
+# ImgPhotoCmd                           imgPhoto-4.*, imgPhoto-17.*
+# GetExtension:                         no tests
+# ParseSubcommandOptions:               imgPhoto-1.*
+# ImgPhotoConfigureMaster:              imgPhoto-3.*, imgPhoto-15.*
+# toggleComplexAlphaIfNeeded:           no tests
+# ImgPhotoDelete:                       imgPhoto-8.*
+# ImgPhotoCmdDeleteProc:                imgPhoto-9.*
+# ImgPhotoSetSize:                      no tests
+# MatchFileFormat:                      imgPhoto-18.*
+# MatchSringFormat:                     imgPhoto-19.*
+# Tk_FindPhoto:                         imgPhoto-11.*
+# Tk_PhotoPutBlock:                     imgPhoto-10.*, imgPhoto-16.*
+# Tk_PhotoPutZoomedBlock:               imgPhoto-12.*
+# Tk_DitherPhoto:                       no tets
+# Tk_PhotoBlank:                        no tests
+# Tk_PhotoExpand:                       no tests
+# Tk_PhotoGetSize:                      no tests
+# Tk_PhotoSetSize:                      no tests
+# TkGetPhotoValidRegion:                no tests
+# ImgGetPhoto:                          no tests
+# Tk_PhotoGetImage                      no tests
+# ImgPostscriptPhoto                    no tests
+# Tk_PhotoPutBlock_NoComposite          no tests, probably none needed
+# Tk_PhotoPutZoomedBlock_NoComposite    no tests, probably none needed
+# Tk_PhotoExpand_Panic                  no tests, probably none needed
+# Tk_PhotoPutBlock_Panic                no tests, probably none needed
+# Tk_PhotoPutZoomedBlock_Panic          no tests, probably none needed
+# Tk_PhotoSetSize_Panic                 no tests, probably none needed
+#--------------------------------------------------------------------------
+#
+
+#
+# Some tests are not specific to a function in tkImgPhoto.c. They are:
+#
+
+#
+# Test name(s)          Description
+#--------------------------------------------------------------------------
+# imgPhoto-5.*          Do not really belong to this file. ImgPhotoGet and
+#                       ImgPhotoFree are defined in tkImgPhInstance.c.
+# imgPhoto-6.*          Do not really belong to this file. ImgPhotoDisplay
+#                       is defined in tkImgPhInstance.c.
+# imgPhoto-7.*          Do not really belong to this file. ImgPhotoFree is
+#                       defined in tkImgPhInstance.c.
+# imgPhoto-13.*         Tests for separation in different interpreters
+# imgPhoto-14.*         Test GIF format. Would belong to imgGIF.test
+#                       - which does not exist.
+#
+
 package require tcltest 2.2
 namespace import ::tcltest::*
 tcltest::configure {*}$argv
 tcltest::loadTestedCommands
-
-# Used for 4.65 - 4.73 tests
-# Now for some heftier testing, checking that setting and resetting of pixels'
-# transparency status doesn't "leak" with any one-off errors.
+
+#
+# Used for imgPhoto-4.65 - imgPhoto-4.73
+#
 proc foreachPixel {img xVar yVar script} {
     upvar 1 $xVar x $yVar y
     set width [image width $img]
@@ -58,8 +126,17 @@ set README [makeFile {
 # 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]
+# let's see if we have the semi-transparent one as well
+set transpTeapotPhotoFile [file join [file dirname [info script]] teapotTransparent.png]
+testConstraint hasTranspTeapotPhoto [file exists $transpTeapotPhotoFile]
+
+proc base64ok {} {
+    expr {
+        ![catch {package require base64}]
+    }
+}
 
-# ----------------------------------------------------------------------
+testConstraint base64PackageNeeded [base64ok]
 
 test imgPhoto-1.1 {options for photo images} -body {
     image create photo photo1 -width 79 -height 83
@@ -109,7 +186,23 @@ test imgPhoto-1.10 {options for photo images - error case} -body {
 test imgPhoto-1.11 {options for photo images - error case} -body {
     image create photo photo1 -format
 } -returnCodes error -result {value for "-format" missing}
-
+test imgPhoto-1.12 {option -alpha, normal use} -setup {
+    image create photo photo1
+} -body {
+    photo1 put "white" -to 0 0
+    photo1 transparency get 0 0 -alpha
+} -cleanup {
+    imageCleanup
+} -result {255}
+test imgPhoto-1.13 {option -withalpha, normal use} -setup {
+    image create photo photo1
+} -body {
+    photo1 put {{blue green}}
+    photo1 get 1 0 -withalpha
+} -cleanup {
+    imageCleanup
+} -result {0 128 0 255}
+
 test imgPhoto-2.1 {ImgPhotoCreate procedure} -setup {
     imageCleanup
 } -body {
@@ -132,7 +225,7 @@ test imgPhoto-2.2 {ImgPhotoCreate procedure} -setup {
 #     photo1 copy photo2
 #     set msg
 # } {couldn't open "bogus.img": no such file or directory}
-
+
 test imgPhoto-3.1 {ImgPhotoConfigureMaster procedure} -constraints {
     hasTeapotPhoto
 } -body {
@@ -168,7 +261,40 @@ test imgPhoto-3.3 {ImgPhotoConfigureMaster procedure} -constraints {
     destroy .c
     image delete photo1
 } -result {256 256 {10 10 266 266} {300 10 556 266}}
-
+test imgPhoto-3.4 {ImgPhotoConfigureMaster: -data <ppm>} -constraints {
+    hasTeapotPhoto
+} -setup {
+    image create photo photo1 -file $teapotPhotoFile
+    image create photo photo2
+} -body {
+    photo2 configure -data [photo1 data -format ppm -from 100 100 120 120]
+    list [image width photo2] [image height photo2]
+} -cleanup {
+    imageCleanup
+} -result {20 20}
+test imgPhoto-3.5 {ImgPhotoConfigureMaster: -data <png>} -constraints {
+    hasTeapotPhoto
+} -setup {
+    image create photo photo1 -file $teapotPhotoFile
+    image create photo photo2
+} -body {
+    photo2 configure -data [photo1 data -format png -from 120 120 140 140]
+    list [image width photo2] [image height photo2]
+} -cleanup {
+    imageCleanup
+} -result {20 20}
+test imgPhoto-3.6 {ImgPhotoConfigureMaster: -data <default>} -constraints {
+    hasTeapotPhoto
+} -setup {
+    image create photo photo1 -file $teapotPhotoFile
+    image create photo photo2
+} -body {
+    photo2 configure -data [photo1 data -from 80 90 100 110]
+    list [image width photo2] [image height photo2]
+} -cleanup {
+    imageCleanup
+} -result {20 20}
+
 test imgPhoto-4.1 {ImgPhotoCmd procedure} -setup {
     image create photo photo1
 } -body {
@@ -367,16 +493,19 @@ 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}
+# tests for <imageName> data: imgPhoto-4.
 test imgPhoto-4.22 {ImgPhotoCmd procedure: get option} -constraints {
-    hasTeapotPhoto
+    hasTranspTeapotPhoto
 } -setup {
     image create photo photo1
 } -body {
-    photo1 read $teapotPhotoFile
-    list [photo1 get 100 100] [photo1 get 150 100] [photo1 get 100 150]
+    photo1 read $transpTeapotPhotoFile
+    list [photo1 get 100 100 -withalpha] \
+	[photo1 get 150 100 -withalpha] \
+	[photo1 get 100 150] [photo1 get 150 150]
 } -cleanup {
     image delete photo1
-} -result {{169 117 90} {172 115 84} {35 35 35}}
+} -result {{175 71 0 162} {179 73 0 168} {14 8 0} {0 0 0}}
 test imgPhoto-4.23 {ImgPhotoCmd procedure: get option} -setup {
     image create photo photo1
 } -body {
@@ -394,10 +523,12 @@ test imgPhoto-4.24 {ImgPhotoCmd procedure: get option} -setup {
 test imgPhoto-4.25 {ImgPhotoCmd procedure: get option} -setup {
     image create photo photo1
 } -body {
-    photo1 get
+    photo1 get 0
 } -cleanup {
     image delete photo1
-} -returnCodes error -result {wrong # args: should be "photo1 get x y"}
+} -returnCodes error -result \
+    {wrong # args: should be "photo1 get x y ?-withalpha?"}
+# more test for image get: 4.101-4.102
 test imgPhoto-4.26 {ImgPhotoCmd procedure: put option} -setup {
     image create photo photo1
 } -body {
@@ -411,22 +542,28 @@ test imgPhoto-4.27 {ImgPhotoCmd procedure: put option} -setup {
     photo1 put {{white} {white white}}
 } -returnCodes error -cleanup {
     image delete photo1
-} -result {all elements of color list must have the same number of elements}
+} -result {couldn't recognize image data}
 test imgPhoto-4.28 {ImgPhotoCmd procedure: put option} -setup {
     image create photo photo1
 } -body {
     photo1 put {{blahgle}}
 } -cleanup {
     image delete photo1
-} -returnCodes error -result {can't parse color "blahgle"}
+} -returnCodes error -result {couldn't recognize image data}
 test imgPhoto-4.29 {ImgPhotoCmd procedure: put option} -setup {
     image create photo photo1
 } -body {
-    photo1 put -to 10 10 20 20 {{white}}
+    # SB: odd thing - this test passed with tk 8.6.6, even if the data
+    # is in the wrong position:
+    #photo1 put -to 10 10 20 20 {{white}}
+
+    # this is how it's supposed to be:
+    photo1 put {{white}} -to 10 10 20 20
     photo1 get 19 19
 } -cleanup {
     image delete photo1
 } -result {255 255 255}
+# more tests for image put: 4.90-4.100
 test imgPhoto-4.30 {ImgPhotoCmd procedure: read option} -setup {
     image create photo photo1
 } -body {
@@ -508,6 +645,7 @@ test imgPhoto-4.39 {ImgPhotoCmd procedure: write option} -setup {
 } -cleanup {
     image delete photo1
 } -returnCodes error -result {image file format "bogus" is unknown}
+# more tests on "imageName write": imgPhoto-17.*
 test imgPhoto-4.40 {ImgPhotoCmd procedure: transparency option} -setup {
     image create photo photo1
 } -body {
@@ -521,21 +659,21 @@ test imgPhoto-4.41 {ImgPhotoCmd procedure: transparency get option} -setup {
     photo1 transparency get
 } -returnCodes error -cleanup {
     image delete photo1
-} -result {wrong # args: should be "photo1 transparency get x y"}
+} -result {wrong # args: should be "photo1 transparency get x y ?-option?"}
 test imgPhoto-4.42 {ImgPhotoCmd procedure: transparency get option} -setup {
     image create photo photo1
 } -body {
     photo1 transparency get 0
 } -returnCodes error -cleanup {
     image delete photo1
-} -result {wrong # args: should be "photo1 transparency get x y"}
+} -result {wrong # args: should be "photo1 transparency get x y ?-option?"}
 test imgPhoto-4.43 {ImgPhotoCmd procedure: transparency get option} -setup {
     image create photo photo1
 } -body {
-    photo1 transparency get 0 0 0
+    photo1 transparency get 0 0 0 -alpha
 } -returnCodes error -cleanup {
     image delete photo1
-} -result {wrong # args: should be "photo1 transparency get x y"}
+} -result {wrong # args: should be "photo1 transparency get x y ?-option?"}
 test imgPhoto-4.44 {ImgPhotoCmd procedure: transparency get option} -setup {
     image create photo photo1
 } -body {
@@ -595,34 +733,39 @@ test imgPhoto-4.51 {ImgPhotoCmd procedure: transparency get option} -setup {
 } -cleanup {
     image delete photo1
 } -result 1
+# more tests for transparency get: 4.65, 4.66, 4.76-4.81
 test imgPhoto-4.52 {ImgPhotoCmd procedure: transparency set option} -setup {
     image create photo photo1
 } -body {
     photo1 transparency set
 } -returnCodes error -cleanup {
     image delete photo1
-} -result {wrong # args: should be "photo1 transparency set x y boolean"}
+} -result \
+    {wrong # args: should be "photo1 transparency set x y newVal ?-option?"}
 test imgPhoto-4.53 {ImgPhotoCmd procedure: transparency set option} -setup {
     image create photo photo1
 } -body {
     photo1 transparency set 0
 } -returnCodes error -cleanup {
     image delete photo1
-} -result {wrong # args: should be "photo1 transparency set x y boolean"}
+} -result \
+    {wrong # args: should be "photo1 transparency set x y newVal ?-option?"}
 test imgPhoto-4.54 {ImgPhotoCmd procedure: transparency set option} -setup {
     image create photo photo1
 } -body {
     photo1 transparency set 0 0
 } -returnCodes error -cleanup {
     image delete photo1
-} -result {wrong # args: should be "photo1 transparency set x y boolean"}
+} -result \
+    {wrong # args: should be "photo1 transparency set x y newVal ?-option?"}
 test imgPhoto-4.55 {ImgPhotoCmd procedure: transparency set option} -setup {
     image create photo photo1
 } -body {
-    photo1 transparency set 0 0 0 0
+    photo1 transparency set 0 0 0 0 -alpha
 } -returnCodes error -cleanup {
     image delete photo1
-} -result {wrong # args: should be "photo1 transparency set x y boolean"}
+} -result \
+    {wrong # args: should be "photo1 transparency set x y newVal ?-option?"}
 test imgPhoto-4.56 {ImgPhotoCmd procedure: transparency set option} -setup {
     image create photo photo1
 } -body {
@@ -639,6 +782,7 @@ test imgPhoto-4.57 {ImgPhotoCmd procedure: transparency set option} -setup {
 } -returnCodes error -result {expected integer but got "bogus"}
 test imgPhoto-4.58 {ImgPhotoCmd procedure: transparency set option} -setup {
     image create photo photo1
+    photo1 put blue
 } -body {
     photo1 transparency set 0 0 bogus
 } -cleanup {
@@ -690,6 +834,7 @@ test imgPhoto-4.64 {ImgPhotoCmd procedure: transparency set option} -setup {
 } -cleanup {
     image delete photo1
 } -result 1
+# more tests for transparency set: 4.67, 4.68, 4.82-4.89
 # Now for some heftier testing, checking that setting and resetting of pixels'
 # transparency status doesn't "leak" with any one-off errors.
 test imgPhoto-4.65 {ImgPhotoCmd procedure: transparency get option} -setup {
@@ -814,7 +959,423 @@ 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 {
+    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
+    photo1 copy photo1 -subsample 2 2 -shrink
+} -cleanup {
+    imageCleanup
+} -result {}
+test imgPhoto-4.76 {ImgPhotoCmd, transparancy get: too many options} -setup {
+    image create photo photo1
+} -body {
+    photo1 put white -to 0 0 1 1
+    photo1 transparency get 0 0 -alpha -bogus
+} -cleanup {
+    imageCleanup
+} -returnCodes error -result \
+    {wrong # args: should be "photo1 transparency get x y ?-option?"}
+test imgPhoto-4.77 {ImgPhotoCmd, transparency get: invalid option} -setup {
+    image create photo photo1
+} -body {
+    photo1 put white -to 0 0 1 1
+    photo1 transparency get 0 0 -bogus
+} -cleanup {
+    imageCleanup
+} -returnCodes error -result \
+    {unrecognized option "-bogus": must be -alpha}
+test imgPhoto-4.78 {ImgPhotoCmd, transparency get: normal use} -setup {
+    image create photo photo1
+} -body {
+    photo1 put white -to 0 0 1 1
+    set result [photo1 transparency get 0 0]
+    lappend result [photo1 transparency get 0 0 -alpha]
+} -cleanup {
+    imageCleanup
+} -result {0 255}
+test imgPhoto-4.79 {ImgPhotoCmd, transparency get: no option} -constraints {
+    hasTranspTeapotPhoto
+} -setup {
+    image create photo photo1 -file $transpTeapotPhotoFile
+    set result {}
+} -body {
+    set pixelCoords {{156 239} {76 207} {153 213} {139 43} {75 112}}
+    foreach coord $pixelCoords {
+	lappend result [photo1 transparency get {*}$coord]
+    }
+    set result
+} -cleanup {
+    imageCleanup
+} -result {0 1 0 0 0}
+# test imgPhoto-4.80: deleted (was transparency get: -boolean)
+test imgPhoto-4.81 {ImgPhotoCmd, transparency get: -alpha} -constraints {
+    hasTranspTeapotPhoto
+} -setup {
+    image create photo photo1 -file $transpTeapotPhotoFile
+    set result {}
+} -body {
+    set pixelCoords {{156 239} {76 207} {153 213} {139 43} {75 112}}
+    foreach coord $pixelCoords {
+	lappend result [photo1 transparency get {*}$coord -alpha]
+    }
+    set result
+} -cleanup {
+    imageCleanup
+} -result {255 0 1 254 206}
+test imgPhoto-4.82 {ImgPhotoCmd, transparency set: too many opts} -setup {
+    image create photo photo1
+} -body {
+    photo1 transparency set 0 0 -alpha -bogus 1
+} -cleanup {
+    imageCleanup
+} -returnCodes error -result \
+    {wrong # args: should be "photo1 transparency set x y newVal ?-option?"}
+test imgPhoto-4.83 {ImgPhotoCmd, transparency set: invalid opt} -setup {
+    image create photo photo1 -data black
+} -body {
+    photo1 transparency set 0 0 0 -bogus
+} -cleanup {
+    imageCleanup
+} -returnCodes error -result \
+    {unrecognized option "-bogus": must be -alpha}
+test imgPhoto-4.84 {ImgPhotoCmd, transparency set: invalid newVal} -setup {
+    image create photo photo1 -data white
+} -body {
+    photo1 transparency set 0 0 bogus -alpha
+} -cleanup {
+    imageCleanup
+} -returnCodes error -result {expected integer but got "bogus"}
+test imgPhoto-4.85 {ImgPhotoCmd, transparency set: invalid newVal} -setup {
+    image create photo photo1 -data red
+} -body {
+    photo1 transparency set 0 0 -1 -alpha
+} -returnCodes error -result \
+    {invalid alpha value "-1": must be integer between 0 and 255}
+test imgPhoto-4.86 {ImgPhotoCmd, transparency set: invalid newVal} -setup {
+    image create photo photo1 -data green
+} -body {
+    photo1 transparency set 0 0 256 -alpha
+} -cleanup {
+    imageCleanup
+} -returnCodes error -result \
+    {invalid alpha value "256": must be integer between 0 and 255}
+test imgPhoto-4.87 {ImgPhotoCmd, transparency set: no opt} -setup {
+    image create photo photo1
+} -body {
+    photo1 put white -to 0 0 2 1
+    photo1 transparency set 0 0 0
+    photo1 transparency set 1 0 1
+    list [photo1 transparency get 0 0 -alpha] \
+        [photo1 transparency get 1 0 -alpha]
+} -cleanup {
+    imageCleanup
+} -result {255 0}
+# deleted: test imgPhoto-4.88 {ImgPhotoCmd, transparency set: -boolean}
+test imgPhoto-4.89 {ImgPhotoCmd, transparency set: -alpha} -setup {
+    image create photo photo1
+} -body {
+    photo1 put white -to 0 0 2 2
+    photo1 transparency set 0 0 0 -alpha
+    photo1 transparency set 1 0 1 -alpha
+    photo1 transparency set 0 1 254 -alpha
+    photo1 transparency set 1 1 255 -alpha
+    list [photo1 transparency get 0 0] [photo1 transparency get 1 0] \
+	[photo1 transparency get 0 1] [photo1 transparency get 1 1]
+} -cleanup {
+    imageCleanup
+} -result {1 0 0 0}
+test imgPhoto-4.90 {ImgPhotoCmd put: existing but not allowed opt} -setup {
+    image create photo photo1
+} -body {
+    photo1 put yellow -from 0 0 1 1
+} -cleanup {
+    imageCleanup
+} -returnCodes error -result \
+    {unrecognized option "-from": must be -format, or -to}
+test imgPhoto-4.91 {ImgPhotoCmd put: invalid option} -setup {
+    image create photo photo1
+} -body {
+    photo1 put {{0 1 2 3}} -bogus x
+} -returnCodes error -result \
+    {unrecognized option "-bogus": must be -format, or -to}
+test imgPhoto-4.92 {ImgPhotocmd put: missing data} -setup {
+    image create photo photo1
+} -body {
+    photo1 put -to 0 0
+} -returnCodes error -result \
+    {wrong # args: should be "photo1 put data ?-option value ...?"}
+test imgPhoto-4.93 {ImgPhotoCmd put: data in ppm format} -constraints {
+    hasTeapotPhoto
+} -setup {
+    image create photo photo1 -file $teapotPhotoFile
+    image create photo photo2
+} -body {
+    set imgdata [photo1 data -format ppm]
+    photo2 put $imgdata -format ppm
+    set result {}
+    if {[image width photo1] != [image width photo2] \
+            || [image height photo1] != [image height photo2]} {
+        lappend result [list [image width photo2] [image height photo2]]
+    } else {
+        lappend result 1
+    }
+    foreach point {{206 125} {67 12} {13 46} {19 184}} {
+        if {[photo1 get {*}$point] ne [photo2 get {*}$point]} {
+            lappend result [photo2 get {*}$point]
+        } else {
+            lappend result 1
+        }
+    }
+    set result
+} -cleanup {
+    imageCleanup
+} -result {1 1 1 1 1}
+test imgPhoto-4.94 {ImgPhotoCmd put: unknown format} -setup {
+    image create photo photo1
+} -body {
+    photo1 put {no real data} -format bogus
+} -cleanup {
+    imageCleanup
+} -returnCodes error -result {image format "bogus" is not supported}
+test imgPhoto-4.95 {ImgPhotoCmd put: default fmt, invalid data} -setup {
+    image create photo photo1
+} -body {
+    photo1 put {{red green blue} {red " blue}}
+    #"
+} -cleanup {
+    imageCleanup
+} -returnCodes error -result {couldn't recognize image data}
+test imgPhoto-4.96 {ImgPhotoCmd put: "default" handler is selected} -setup {
+    image create photo photo1
+    image create photo photo2
+    set imgData {{{1 2 3 4} {5 6 7 8} {9 10 11 12}}
+        {{13 14 15 15} {17 18 19 20} {21 22 23 24}}}
+} -body {
+    photo1 put $imgData
+    photo2 put $imgData -format default
+    set result {}
+    lappend result [list [image width photo1] [image height photo1]]
+    lappend result [list [image width photo2] [image height photo2]]
+    lappend result [string equal \
+        [photo1 data -format "default -colorformat rgba"] \
+        [photo2 data -format "default -colorformat rgba"]]
+    set result
+} -cleanup {
+    imageCleanup
+    unset result
+    unset imgData
+} -result {{3 2} {3 2} 1}
+test imgPhoto-4.97 {ImgPhotoCmd put: image size} -setup {
+    image create photo photo1
+} -body {
+    photo1 put {{red green blue} {blue red green}}
+    list [image width photo1] [image height photo1]
+} -cleanup {
+    imageCleanup
+} -result {3 2}
+test imgPhoto-4.98 {ImgPhotoCmd put: -to with 2 coords} -setup {
+    image create photo photo1
+} -body {
+    photo1 put {{"alice blue" "blanched almond"}
+		{"deep sky blue" "ghost white"}
+		{#AABBCC #AABBCCDD}} -to 5 6
+    list [image width photo1] [image height photo1]
+} -cleanup {
+    imageCleanup
+} -result {7 9}
+test imgPhoto-4.99 {ImgPhotoCmd put: -to with 4 coords} -setup {
+    image create photo photo1
+} -body {
+    photo1 put {{#123 #456 #678} {#9AB #CDE #F01}} -to 1 2 20 21
+    set result {}
+    lappend result [photo1 get 19 20 -withalpha]
+    lappend result [string equal \
+	[photo1 data -from 1 2 4 4] [photo1 data -from 4 2 7 4]]
+    lappend result [string equal \
+	[photo1 data -from 10 12 13 14] [photo1 data -from 16 16 19 18]]
+    set result
+} -cleanup {
+    imageCleanup
+} -result {{17 34 51 255} 1 1}
+test imgPhoto-4.100 {ImgPhotoCmd put: no changes on empty data} -setup {
+    image create photo photo1
+} -body {
+    photo1 put {{brown blue} {cyan coral}}
+    set imgData [photo1 data]
+    photo1 put {}
+    string equal $imgData [photo1 data]
+} -cleanup {
+    imageCleanup
+} -result {1}
+test imgPhoto-4.101 {ImgPhotoCmd get: too many args} -setup {
+    image create photo photo1
+} -body {
+    photo1 get 0 0 -withalpha bogus
+} -cleanup {
+    imageCleanup
+} -returnCodes error -result \
+    {wrong # args: should be "photo1 get x y ?-withalpha?"}
+test imgPhoto-4.102 {ImgPhotoCmd get: invalid option} -setup {
+    image create photo photo1
+} -body {
+    photo1 get 0 0 -bogus
+} -cleanup {
+    imageCleanup
+} -returnCodes error -result \
+    {unrecognized option "-bogus": must be -withalpha}
+test imgPhoto-4.103 {ImgPhotoCmd data: accepted opts} -setup {
+    image create photo photo1 -data black
+} -body {
+    photo1 data -format default -from 0 0 -grayscale -background blue
+} -cleanup {
+    imageCleanup
+} -result {{#000000}}
+test imgPhoto-4.104 {ImgPhotoCmd data: existing but not accepted opt} -setup {
+    image create photo photo1
+} -body {
+    photo1 data -to
+} -cleanup {
+    imageCleanup
+} -returnCodes error -result \
+{unrecognized option "-to": must be -background, -format, -from, or -grayscale}
+test imgPhoto-4.105 {ImgPhotoCmd data: invalid option} -setup {
+    image create photo photo1
+} -body {
+    photo1 data -bogus
+} -cleanup {
+    imageCleanup
+} -returnCodes error -result \
+{unrecognized option "-bogus": must be -background, -format, -from, or -grayscale}
+test imgPhoto-4.106 {ImgPhotoCmd data: extra arg before options} -setup {
+    image create photo photo1
+} -body {
+    photo1 data bogus -grayscale
+} -cleanup {
+    imageCleanup
+} -returnCodes error -result \
+    {wrong # args: should be "photo1 data ?-option value ...?"}
+test imgPhoto-4.107 {ImgPhotoCmd data: extra arg after options} -setup {
+    image create photo photo1
+} -body {
+    photo1 data -format default bogus
+} -cleanup {
+    imageCleanup
+} -returnCodes error -result \
+    {wrong # args: should be "photo1 data ?-option value ...?"}
+test imgPhoto-4.108 {ImgPhotoCmd data: invalid -from coords #1} -setup {
+    image create photo photo1 -data blue
+} -body {
+    photo1 data -from 2 0
+} -cleanup {
+    imageCleanup
+} -returnCodes error -result \
+    {coordinates for -from option extend outside image}
+test imgPhoto-4.109 {ImgPhotoCmd data: invalid -from coords #2} -setup {
+    image create photo photo1 -data blue
+} -body {
+    photo1 data -from 0 2
+} -cleanup {
+    imageCleanup
+} -returnCodes error -result \
+    {coordinates for -from option extend outside image}
+test imgPhoto-4.110 {ImgPhotoCmd data: invalid -from coords #3} -setup {
+    image create photo photo1 -data blue
+} -body {
+    photo1 data -from 0 0 2 1
+} -cleanup {
+    imageCleanup
+} -returnCodes error -result \
+    {coordinates for -from option extend outside image}
+test imgPhoto-4.111 {ImgPhotoCmd data: invalid -from coords #4} -setup {
+    image create photo photo1 -data blue
+} -body {
+    photo1 data -from 0 0 1 2
+} -cleanup {
+    imageCleanup
+} -returnCodes error -result \
+    {coordinates for -from option extend outside image}
+test imgPhoto-4.112 {ImgPhotoCmd data: -from with 2 coords} -setup {
+    image create photo photo1 -data {
+        {black black black black black}
+        {white white white white white}
+        {green green green green green}}
+} -body {
+    set imgData [photo1 data -from 2 1]
+    list [llength [lindex $imgData 0]] [llength $imgData]
+} -cleanup {
+    imageCleanup
+    unset imgData
+} -result {3 2}
+test imgPhoto-4.113 {ImgPhotoCmd data: default is rgb format} -setup {
+    image create photo photo1 -data red
+} -body {
+    photo1 data
+} -cleanup {
+    imageCleanup
+} -result {{#ff0000}}
+test imgPhoto-4.114 {ImgPhotoCmd data: unknown format} -setup {
+    image create photo photo1
+} -body {
+    photo1 data -format bogus
+} -cleanup {
+    imageCleanup
+} -returnCodes error -result {image string format "bogus" is unknown}
+test imgPhoto-4.115 {ImgPhotoCmd data: rgb colorformat} -setup {
+    image create photo photo1 -data {{red#a green#b} {blue#c white}}
+} -body {
+    photo1 data -format {default -colorformat rgb}
+} -result {{#ff0000 #008000} {#0000ff #ffffff}}
+test imgPhoto-4.116 {ImgPhotoCmd data: rgba colorformat} -setup {
+    image create photo photo1 -data {{red green} {blue white}}
+} -body {
+    photo1 data -format {default -colorformat rgba}
+} -result {{#ff0000ff #008000ff} {#0000ffff #ffffffff}}
+test imgPhoto-4.117 {ImgPhotoCmd data: list colorformat} -setup {
+    image create photo photo1 -data {{red#a green} {blue#c white#d}}
+} -body {
+    photo1 data -format {default -colorformat list}
+} -result {{{255 0 0 170} {0 128 0 255}} {{0 0 255 204} {255 255 255 221}}}
+test imgPhoto-4.118 {ImgPhotoCmd data: using data for new image
+    results in same image as orignial } -constraints {
+        hasTeapotPhoto
+        hasTranspTeapotPhoto
+} -setup {
+    image create photo teapot -file $teapotPhotoFile
+    teapot copy teapot -from 50 60 70 80 -shrink
+    image create photo teapotTransp -file $transpTeapotPhotoFile
+    teapotTransp copy teapotTransp -from 100 110 120 130 -shrink
+    image create photo photo1
+} -body {
+    set result {}
+    # We don't test gif here, as there seems to be a problem with
+    # <imgName> data and gif format ("too many colors", probably a bug)
+    foreach fmt {ppm png {default -colorformat rgba} \
+            {default -colorformat list}} {
+        set imgData [teapotTransp data -format $fmt]
+        photo1 blank
+        photo1 put $imgData
+        if { ! [string equal [photo1 data] [teapotTransp data]]} {
+            lappend result $fmt
+        }
+    }
+    set imgData [teapot data -format default]
+    photo1 blank
+    photo1 put $imgData
+    if { ! [string equal [photo1 data] [teapot data]]} {
+        lappend result default
+    }
+    set result
+} -cleanup {
+    unset imgData
+    unset result
+    imageCleanup
+} -result {}
+
 test imgPhoto-5.1 {ImgPhotoGet/Free procedures, shared instances} -constraints {
     hasTeapotPhoto
 } -setup {
@@ -837,7 +1398,7 @@ test imgPhoto-5.1 {ImgPhotoGet/Free procedures, shared instances} -constraints {
 } -cleanup {
     destroy .c
 } -result {}
-
+
 test imgPhoto-6.1 {ImgPhotoDisplay procedure, blank display} -setup {
     destroy .c
     pack [canvas .c]
@@ -851,7 +1412,7 @@ test imgPhoto-6.1 {ImgPhotoDisplay procedure, blank display} -setup {
     destroy .c
     image delete photo1
 } -result {}
-
+
 test imgPhoto-7.1 {ImgPhotoFree procedure, resource freeing} -constraints {
     hasTeapotPhoto
 } -setup {
@@ -912,7 +1473,7 @@ test imgPhoto-7.3 {ImgPhotoFree procedures, multiple visuals} -constraints {
     destroy .f
     image delete photo1
 } -result {}
-
+
 test imgPhoto-8.1 {ImgPhotoDelete procedure} -constraints hasTeapotPhoto -body {
     image create photo photo2 -file $teapotPhotoFile
     image delete photo2
@@ -936,7 +1497,7 @@ test imgPhoto-8.3 {ImgPhotoDelete procedure, name cleanup} -body {
 } -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 {
@@ -944,7 +1505,7 @@ test imgPhoto-9.1 {ImgPhotoCmdDeletedProc procedure} -constraints {
     rename photo2 {}
     list [lsearch -exact [imageNames] photo2] [catch {photo2 foo} msg] $msg
 } -result {-1 1 {invalid command name "photo2"}}
-
+
 test imgPhoto-10.1 {Tk_ImgPhotoPutBlock procedure} -setup {
     imageCleanup
 } -body {
@@ -991,7 +1552,6 @@ test imgPhoto-10.4 {Tk_ImgPhotoPutBlock, empty image} -setup {
     imageCleanup
 } -result {0 0}
 
-
 test imgPhoto-11.1 {Tk_FindPhoto} -setup {
     imageCleanup
 } -body {
@@ -1001,7 +1561,7 @@ test imgPhoto-11.1 {Tk_FindPhoto} -setup {
 } -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 {
     image create photo p3 -file $teapotPhotoFile
     set result [list [p3 get 50 50] [p3 get 100 100]]
@@ -1090,7 +1650,7 @@ test imgPhoto-13.1 {check separation of images in different interpreters} -setup
     interp delete x1
     interp delete x2
 } -result T1_data
-
+
 test imgPhoto-14.1 {GIF writes work correctly} -setup {
     set data {
 	R0lGODlhYwA5APcAAAAAAIAAAACAAICAAAAAgIAAgACAgICAgAysnGy8hKzM
@@ -1183,7 +1743,7 @@ test imgPhoto-14.4 {GIF buffer overflow} -setup {
 } -cleanup {
     image delete $i
 } -returnCodes error -result {malformed image}
-
+
 test imgPhoto-15.1 {photo images can fail to allocate memory gracefully} -constraints {
     nonPortable
 } -body {
@@ -1191,7 +1751,7 @@ test imgPhoto-15.1 {photo images can fail to allocate memory gracefully} -constr
     # free memory available...
     image create photo -width 32000 -height 32000
 } -returnCodes error -result {not enough free memory for image buffer}
-
+
 test imgPhoto-16.1 {copying to self doesn't access freed memory} -setup {
     set i [image create photo]
 } -body {
@@ -1202,7 +1762,7 @@ test imgPhoto-16.1 {copying to self doesn't access freed memory} -setup {
 } -cleanup {
     image delete $i
 } -result {}
-
+
 # Check that we can guess our supported output formats [Bug 2983824]
 test imgPhoto-17.1 {photo write: format guessing from filename} -setup {
     set i [image create photo -width 3 -height 3]
@@ -1241,8 +1801,250 @@ test imgPhoto-17.3 {photo write: format guessing from filename} -setup {
     image delete $i
     catch {removeFile $f}
 } -result "P6\n"
+test imgPhoto-17.4 {photo write: default format not supported} -setup {
+    image create photo photo1 -data {{blue blue} {red red} {green green}}
+    set f [makeFile {} test.txt]
+} -body {
+    photo1 write $f -format default
+} -cleanup {
+    imageCleanup
+    catch {removeFile $f}
+    unset f
+} -returnCodes error -result \
+    {image file format "default" has no file writing capability}
+test imgPhoto-17.5 {photo write: file with extension .default} -setup {
+    image create photo photo1 -data {{black}}
+    set f [makeFile {} test.default]
+} -body {
+    photo1 write $f
+} -cleanup {
+    imageCleanup
+    catch {removeFile $f}
+    unset f
+} -returnCodes error -result \
+    {image file format "default" has no file writing capability}
+
+test imgPhoto-18.1 {MatchFileFormat: "default" format not supported} -setup {
+    image create photo photo1
+    set f [makeFile {} test.txt]
+} -body {
+    photo1 read $f -format default
+} -cleanup {
+    imageCleanup
+    catch {removeFile $f}
+    unset f
+} -returnCodes error -result {-file option isn't supported for default images}
+
+test imgPhoto-19.1 {MatchStringFormat: with "-format default"} -setup {
+    image create photo photo1
+} -body {
+    photo1 put {{red blue red} {yellow green yellow}} -format default
+    list [image width photo1] [image height photo1]
+} -cleanup {
+    imageCleanup
+} -result {3 2}
+test imgPhoto-19.2 {MatchStringFormat: without -format option,
+        default fmt} -body {
+    image create photo photo1
+    photo1 put {{red} {green}}
+    list [image width photo1] [image height photo1]
+} -cleanup {
+    imageCleanup
+} -result {1 2}
+test imgPhoto-19.3 {MatchStringFormat: "-format ppm"} -setup {
+    image create photo photo1
+    image create photo photo2
+    photo2 put {cyan cyan}
+    set imgData [photo2 data -format ppm]
+} -body {
+    photo1 put $imgData -format ppm
+    list [image width photo1] [image height photo1]
+} -cleanup {
+    unset imgData
+    imageCleanup
+} -result {1 2}
+test imgPhoto-19.4 {MatchStringFormat: ppm fmt, without opt} -constraints {
+    hasTeapotPhoto
+} -setup {
+    image create photo photo1 -file $teapotPhotoFile
+    image create photo photo2
+} -body {
+    set imgData [photo1 data -format ppm]
+    photo2 put $imgData
+    list [image width photo2] [image height photo2]
+} -cleanup {
+    imageCleanup
+    unset imgData
+} -result {256 256}
+test imgPhoto-19.5 {MatchStirngFormat: unknown -format} -setup {
+    image create photo photo1
+} -body {
+    photo1 put {} -format bogus
+} -cleanup {
+    imageCleanup
+} -returnCodes error -result {image format "bogus" is not supported}
+test imgPhoto-19.6 {MatchStringFormat: invalid data for default} -setup {
+    image create photo photo1
+} -body {
+    photo1 put bogus
+} -cleanup {
+    imageCleanup
+} -returnCodes error -result {couldn't recognize image data}
+test imgPhoto-19.7 {MatchStringFormat: invalid data for default} -setup {
+    image create photo photo1
+} -body {
+    photo1 put bogus -format dEFault
+} -cleanup {
+    imageCleanup
+} -returnCodes error -result {couldn't recognize image data}
+test imgPhoto-19.8 {MatchStirngFormat: invalid data for gif} -setup {
+    image create photo photo1
+} -body {
+    photo1 put bogus -format giF
+} -cleanup {
+    imageCleanup
+} -returnCodes error -result {couldn't recognize image data}
 
-# ----------------------------------------------------------------------
+# Reject corrupted or truncated image [Bug b601ce3ab1].
+# WARNING - tests 18.1-18.9 will cause a segfault on 8.5.19 and lower,
+#           and on 8.6.6 and lower.
+test imgPhoto-18.1 {Reject corrupted GIF (binary string)} -constraints {
+    base64PackageNeeded
+} -setup {
+    package require base64
+    set data [base64::decode {
+	R0lGODlhAAQABP8zM/8z/zP/MzP/////M////yH5CiwheLrcLTBCd6Tv2qW16tdK4jhV
+	5qpraXIvM1JlNyAgOw==
+    }]
+} -body {
+    image create photo gif1 -data $data
+} -cleanup {
+    catch {image delete gif1}
+} -returnCodes error -result {error reading color map|not enough free memory for image buffer} -match regexp
+test imgPhoto-18.2 {Reject corrupted GIF (base 64 string)} -setup {
+    set data {
+	R0lGODlhAAQABP8zM/8z/zP/MzP/////M////yH5CiwheLrcLTBCd6Tv2qW16tdK4jhV
+	5qpraXIvM1JlNyAgOw==
+    }
+} -body {
+    image create photo gif1 -data $data
+} -cleanup {
+    catch {image delete gif1}
+} -returnCodes error -result {error reading color map|not enough free memory for image buffer} -match regexp
+test imgPhoto-18.3 {Reject corrupted GIF (file)} -setup {
+    set fileName [file join [file dirname [info script]] corruptMangled.gif]
+} -body {
+    image create photo gif1 -file $fileName
+} -cleanup {
+    catch {image delete gif1}
+} -returnCodes error -result {error reading color map|not enough free memory for image buffer} -match regexp
+test imgPhoto-18.4 {Reject truncated GIF (binary string)} -constraints {
+    base64PackageNeeded
+} -setup {
+    package require base64
+    set data [base64::decode {
+	R0lGODlhEAAQAMIHAAAAADMz//8zM/8z/zP/MzP///8=
+    }]
+} -body {
+    image create photo gif1 -data $data
+} -cleanup {
+    catch {image delete gif1}
+} -returnCodes error -result {error reading color map}
+test imgPhoto-18.5 {Reject truncated GIF (base 64 string)} -setup {
+    set data {
+	R0lGODlhEAAQAMIHAAAAADMz//8zM/8z/zP/MzP///8=
+    }
+} -body {
+    image create photo gif1 -data $data
+} -cleanup {
+    catch {image delete gif1}
+} -returnCodes error -result {error reading color map}
+test imgPhoto-18.6 {Reject truncated GIF (file)} -setup {
+    set fileName [file join [file dirname [info script]] corruptTruncated.gif]
+} -body {
+    image create photo gif1 -file $fileName
+} -cleanup {
+    catch {image delete gif1}
+} -returnCodes error -result {error reading color map}
+test imgPhoto-18.7 {Reject corrupted GIF (> 4Gb) (binary string)} -constraints {
+    base64PackageNeeded nonPortable
+} -setup {
+    # About the non portability constraint of this test: see ticket [cc42cc18a5]
+    # If there is insufficient memory, the error message
+    # {not enough free memory for image buffer} should be returned.
+    # Instead, some systems (e.g. FreeBSD 11.1) terminate the test interpreter.
+    package require base64
+    set data [base64::decode {
+	R0lGODlhwmYz//8zM/8z/zP/MzP/////M////yH5Ciwhe
+	LrcLTBCd6Tv2qW16tdK4jhV5qpraXIvM1JlNyAgOw==
+    }]
+} -body {
+    image create photo gif1 -data $data
+} -cleanup {
+    catch {image delete gif1}
+} -returnCodes error -result {error reading color map|not enough free memory for image buffer} -match regexp
+test imgPhoto-18.8 {Reject corrupted GIF (> 4Gb) (base 64 string)} -constraints {
+    nonPortable
+} -setup {
+    # About the non portability constraint of this test: see ticket [cc42cc18a5]
+    # If there is insufficient memory, the error message
+    # {not enough free memory for image buffer} should be returned.
+    # Instead, some systems (e.g. FreeBSD 11.1) terminate the test interpreter.
+    set data {
+	R0lGODlhwmYz//8zM/8z/zP/MzP/////M////yH5Ciwhe
+	LrcLTBCd6Tv2qW16tdK4jhV5qpraXIvM1JlNyAgOw==
+    }
+} -body {
+    image create photo gif1 -data $data
+} -cleanup {
+    catch {image delete gif1}
+} -returnCodes error -result {error reading color map|not enough free memory for image buffer} -match regexp
+test imgPhoto-18.9 {Reject corrupted GIF (> 4Gb) (file)} -constraints {
+    nonPortable
+} -setup {
+    # About the non portability constraint of this test: see ticket [cc42cc18a5]
+    # If there is insufficient memory, the error message
+    # {not enough free memory for image buffer} should be returned.
+    # Instead, some systems (e.g. FreeBSD 11.1) terminate the test interpreter.
+    set fileName [file join [file dirname [info script]] corruptMangled4G.gif]
+} -body {
+    image create photo gif1 -file $fileName
+} -cleanup {
+    catch {image delete gif1}
+} -returnCodes error -result {error reading color map|not enough free memory for image buffer} -match regexp
+test imgPhoto-18.10 {Valid GIF (binary string)} -constraints {
+    base64PackageNeeded
+} -setup {
+    # Test the binary string reader with a valid GIF.
+    # This is not tested elsewhere.
+    # Tests 18.11, 18.12, with matching data, are included for completeness.
+    package require base64
+    set data [base64::decode {
+	R0lGODlhEAAQAMIHAAAAADMz//8zM/8z/zP/MzP/////M////yH5BAEKAAcALAAA
+	AAAQABAAAAMheLrcLTBCd6QV79qlterXB0riOFXmmapraXIvM1IdZTcJADs=
+    }]
+} -body {
+    image create photo gif1 -data $data
+} -cleanup {
+    catch {image delete gif1}
+} -result gif1
+test imgPhoto-18.11 {Valid GIF (base 64 string)} -setup {
+    set data {
+	R0lGODlhEAAQAMIHAAAAADMz//8zM/8z/zP/MzP/////M////yH5BAEKAAcALAAA
+	AAAQABAAAAMheLrcLTBCd6QV79qlterXB0riOFXmmapraXIvM1IdZTcJADs=
+    }
+} -body {
+    image create photo gif1 -data $data
+} -cleanup {
+    catch {image delete gif1}
+} -result gif1
+test imgPhoto-18.12 {Valid GIF (file)} -setup {
+    set fileName [file join [file dirname [info script]] red.gif]
+} -body {
+    image create photo gif1 -file $fileName
+} -cleanup {
+    catch {image delete gif1}
+} -result gif1
 
 catch {rename foreachPixel {}}
 catch {rename checkImgTrans {}}
diff --git a/tests/menu.test b/tests/menu.test
index af78947..1af36f1 100644
--- a/tests/menu.test
+++ b/tests/menu.test
@@ -279,9 +279,9 @@ destroy .m1
 # index 0 is tearoff, 1 command, 2 cascade, 3 separator, 4 checkbutton,
 # 5 radiobutton
 deleteWindows
-menu .m1
+menu .m1 -tearoff 1
 .m1 add command -label "command"
-menu .m2
+menu .m2 -tearoff 1
 .m2 add command -label "test"
 .m1 add cascade -label "cascade" -menu .m2
 .m1 add separator
@@ -1398,7 +1398,7 @@ test menu-3.23 {MenuWidgetCmd procedure, "delete" option} -setup {
 test menu-3.24 {MenuWidgetCmd procedure, "delete" option} -setup {
 	destroy .m1
 } -body {
-    menu .m1
+    menu .m1 -tearoff 1
     .m1 delete 0 "foo"
 } -returnCodes error -result {bad menu entry index "foo"}
 test menu-3.25 {MenuWidgetCmd procedure, "delete" option} -setup {
@@ -1546,7 +1546,7 @@ test menu-3.40 {MenuWidgetCmd procedure, "index" option} -setup {
 test menu-3.41 {MenuWidgetCmd procedure, "index" option} -setup {
 	destroy .m1
 } -body {
-    menu .m1
+    menu .m1 -tearoff 1
     .m1 add command -label "test"
     .m1 add command -label "3"
     .m1 add command -label "another label"
@@ -1629,7 +1629,7 @@ test menu-3.50 {MenuWidgetCmd procedure, "post" option} -constraints {
 	destroy .m1
 } -body {
     menu .m1
-    .m1 add command -label "menu-3.53: hit Escape" -command "puts hello"
+    .m1 add command -label "menu-3.50: hit Escape" -command "puts hello"
     .m1 post 40 40
 } -cleanup {
 	destroy .m1
@@ -1656,7 +1656,7 @@ test menu-3.53 {MenuWidgetCmd procedure, "postcascade" option} -constraints {
 	destroy .m1 .m2
 } -body {
     menu .m1
-    .m1 add command -label "menu-3.56 - hit Escape"
+    .m1 add command -label "menu-3.53 - hit Escape"
     menu .m2
     .m1 post 40 40
     .m1 add cascade -menu .m2
@@ -1739,7 +1739,7 @@ test menu-3.61 {MenuWidgetCmd procedure, "type" option} -setup {
 test menu-3.62 {MenuWidgetCmd procedure, "type" option} -setup {
 	destroy .m1
 } -body {
-    menu .m1
+    menu .m1 -tearoff 1
     .m1 type 0
 } -cleanup {
 	destroy .m1
@@ -1758,7 +1758,7 @@ test menu-3.64 {MenuWidgetCmd procedure, "unpost" option} -constraints {
 	destroy .m1
 } -body {
     menu .m1
-    .m1 add command -label "menu-3.68 - hit Escape"
+    .m1 add command -label "menu-3.64 - hit Escape"
     .m1 post 40 40
     .m1 unpost
 } -cleanup {
@@ -1772,14 +1772,38 @@ test menu-3.65 {MenuWidgetCmd procedure, "yposition" option} -setup {
 } -cleanup {
 	destroy .m1
 } -returnCodes error -result {wrong # args: should be ".m1 yposition index"}
-test menu-3.66 {MenuWidgetCmd procedure, "yposition" option} -setup {
+test menu-3.66a {MenuWidgetCmd procedure, "yposition" option, no tearoff} -setup {
 	destroy .m1
 } -body {
-    menu .m1
+    menu .m1 -tearoff 0
+    .m1 yposition 1
+} -cleanup {
+	destroy .m1
+} -result {0}
+test menu-3.66b {MenuWidgetCmd procedure, "yposition" option, with tearoff} -constraints {
+    notAqua
+} -setup {
+	destroy .m1
+} -body {
+    # on Win or Linux, tearoff menus are supported
+    # see menu-3.66c for aqua
+    menu .m1 -tearoff 1
     .m1 yposition 1
 } -cleanup {
 	destroy .m1
 } -result {1}
+test menu-3.66c {MenuWidgetCmd procedure, "yposition" option, with tearoff} -constraints {
+    aqua
+} -setup {
+	destroy .m1
+} -body {
+    # on OS X, tearoff menus are not supported
+    # see menu-3.66b for win or linux
+    menu .m1 -tearoff 1
+    .m1 yposition 1
+} -cleanup {
+	destroy .m1
+} -result {0}
 test menu-3.67 {MenuWidgetCmd procedure, bad option} -setup {
 	destroy .m1
 } -body {
@@ -1883,7 +1907,7 @@ test menu-4.6 {TkInvokeMenu: radiobutton} -setup {
     destroy .m1
 } -body {
     catch {unset foo}
-    menu .m1
+    menu .m1 -tearoff 1
     .m1 add radiobutton -label "1" -variable foo -value one
     .m1 add radiobutton -label "2" -variable foo -value two
     .m1 add radiobutton -label "3" -variable foo -value three
@@ -1895,7 +1919,7 @@ test menu-4.7 {TkInvokeMenu: radiobutton} -setup {
     destroy .m1
 } -body {
     catch {unset foo}
-    menu .m1
+    menu .m1 -tearoff 1
     .m1 add radiobutton -label "1" -variable foo -value one
     .m1 add radiobutton -label "2" -variable foo -value two
     .m1 add radiobutton -label "3" -variable foo -value three
@@ -1949,7 +1973,7 @@ test menu-4.11 {TkInvokeMenu} -setup {
 test menu-4.12 {TkInvokeMenu} -setup {
     destroy .m1
 } -body {
-    menu .m1
+    menu .m1 -tearoff 1
     .m1 add command -label "test" -command ".m1 delete 1"
     list [catch {.m1 invoke 1} msg] $msg [catch {.m1 type "test"} msg2] $msg2
 } -cleanup {
@@ -2337,7 +2361,7 @@ test menu-8.5 {DestroyMenuEntry} -setup {
 test menu-8.6 {DestroyMenuEntry} -setup {
     destroy .m1
 } -body {
-    menu .m1
+    menu .m1 -tearoff 1
     .m1 add command -label "one"
     .m1 add command -label "two"
     list [.m1 delete 1] [.m1 entrycget 1 -label] [destroy .m1]
@@ -2737,7 +2761,7 @@ test menu-12.4 {ConfigureMenuCloneEntries} -setup {
 test menu-13.1 {TkGetMenuIndex} -setup {
     deleteWindows
 } -body {
-    menu .m1
+    menu .m1 -tearoff 1
     .m1 add command -label "active"
     .m1 add command -label "test2"
     .m1 add command -label "test3"
@@ -2804,7 +2828,7 @@ test menu-13.6 {TkGetMenuIndex} -setup {
 test menu-13.7 {TkGetMenuIndex} -setup {
     deleteWindows
 } -body {
-    menu .m1
+    menu .m1 -tearoff 1
     .m1 add command -label "active"
     .m1 add command -label "test2"
     .m1 add command -label "test3"
@@ -2937,7 +2961,7 @@ test menu-16.3 {MenuAddOrInsert} -setup {
 test menu-16.4 {MenuAddOrInsert} -setup {
 	deleteWindows
 } -body {
-    menu .m1
+    menu .m1 -tearoff 1
     .m1 add command -label "test"
     .m1 insert 0 command -label "test2"
     .m1 entrycget 1 -label
@@ -3277,7 +3301,7 @@ test menu-20.9 {CloneMenu - cascades entries} -setup {
 test menu-20.10 {CloneMenu - tearoff fields} -setup {
 	deleteWindows
 } -body {
-    menu .m1
+    menu .m1 -tearoff 1
     list [.m1 clone .m2 normal] [.m2 cget -tearoff]
 } -cleanup {
 	deleteWindows
@@ -3328,7 +3352,7 @@ test menu-22.2 {GetIndexFromCoords} -setup {
 } -result {0}
 test menu-22.3 {GetIndexFromCoords: mapped window, y only} -setup {
 	deleteWindows
-} -constraints {unix} -body {
+} -constraints {x11} -body {
     menu .m1
     .m1 add command -label "test"
     .m1 configure -tearoff 0
@@ -3340,7 +3364,7 @@ test menu-22.3 {GetIndexFromCoords: mapped window, y only} -setup {
 } -result {0}
 test menu-22.4 {GetIndexFromCoords: mapped window x,y} -setup {
 	deleteWindows
-} -constraints {unix} -body {
+} -constraints {x11} -body {
     menu .m1
     .m1 add command -label "test"
     .m1 configure -tearoff 0
@@ -3354,7 +3378,7 @@ test menu-22.4 {GetIndexFromCoords: mapped window x,y} -setup {
 } -result {0}
 test menu-22.5 {GetIndexFromCoords: mapped wide window} -setup {
 	deleteWindows
-} -constraints {unix} -body {
+} -constraints {x11} -body {
     menu .m1
     .m1 add command -label "test"
     .m1 configure -tearoff 0
diff --git a/tests/red.gif b/tests/red.gif
new file mode 100644
index 0000000..1d12ebb
--- /dev/null
+++ b/tests/red.gif
diff --git a/tests/scale.test b/tests/scale.test
index 96e3cec..d22c4c3 100644
--- a/tests/scale.test
+++ b/tests/scale.test
@@ -1504,6 +1504,26 @@ test scale-20.8 {Bug [2262543fff] - Scale widget unexpectedly fires command call
     destroy .s
 } -result {10 10}
 
+test scale-21.1 {Bug [55b95f578a] - Associating variable with bignum value with scale crashes it} -setup {
+    catch {destroy .s}
+} -body {
+    pack [scale .s]
+    set foo 5.79e99
+    # non-regression test for bug [55b95f578a] - shall just not crash
+    .s configure -variable foo
+} -cleanup {
+    destroy .s
+} -result {}
+test scale-21.2 {Bug [55b95f578a] again - Bignum value for -from/-to with scale crashes it} -setup {
+    catch {destroy .s}
+} -body {
+    pack [scale .s]
+    # non-regression test for bug [55b95f578a] - shall just not crash
+    .s configure -from -6.8e99 -to 8.8e99
+} -cleanup {
+    destroy .s
+} -result {}
+
 option clear
 
 # cleanup
diff --git a/tests/teapotTransparent.png b/tests/teapotTransparent.png
new file mode 100644
index 0000000..1e7e46d
--- /dev/null
+++ b/tests/teapotTransparent.png
diff --git a/tests/text.test b/tests/text.test
index 84ed50e..321114d 100644
--- a/tests/text.test
+++ b/tests/text.test
@@ -1589,6 +1589,16 @@ test text-8.26 {TextWidgetCmd procedure, "replace" option crash} -setup {
 } -cleanup {
     destroy .tt
 } -result {}
+test text-8.27 {TextWidgetCmd procedure, "replace" option crash} -setup {
+    text .tt
+} -body {
+    .tt insert 0.0 \na
+    for {set i 0} {$i < 2} {incr i} {
+        .tt replace 2.0 3.0 b
+    }
+} -cleanup {
+    destroy .tt
+} -result {}
 
 
 test text-9.1 {TextWidgetCmd procedure, "get" option} -setup {
@@ -6333,6 +6343,7 @@ test text-27.11 {TextEditCmd procedure, set modified flag repeat} -setup {
     text .t
     pack .t
     set ::retval {}
+    update
 } -body {
     bind .t <<Modified>> "lappend ::retval modified"
 # Shouldn't require [update idle] to trigger event [Bug 1809538]
@@ -7368,7 +7379,9 @@ test text-35.3 {widget dump -command destroys widget} -setup {
 
 
 test text-36.1 "bug #1777362: event handling with hyphenated windows" -setup {
-    proc bgerror {m} {set ::my_error $m}
+    set save [interp bgerror {}]
+    interp bgerror {} returnerror-36.1
+    proc returnerror-36.1 {m opts} {set ::my_error $m}
     set ::my_error {}
     pack [set w [text .t-1]]
 } -body {
@@ -7379,9 +7392,14 @@ test text-36.1 "bug #1777362: event handling with hyphenated windows" -setup {
     set ::my_error
 } -cleanup {
     destroy .t-1
+    rename returnerror-36.1 ""
+    interp bgerror {} $save
+    unset -nocomplain save ::my_error w
 } -result {}
 test text-36.2 "bug #1777362: event handling with hyphenated windows" -setup {
-    proc bgerror {m} {set ::my_error $m}
+    set save [interp bgerror {}]
+    interp bgerror {} returnerror-36.2
+    proc returnerror-36.2 {m opts} {set ::my_error $m}
     set ::my_error {}
     pack [set w [text .t+1]]
 } -body {
@@ -7392,9 +7410,14 @@ test text-36.2 "bug #1777362: event handling with hyphenated windows" -setup {
     set ::my_error
 } -cleanup {
     destroy $w
+    rename returnerror-36.2 ""
+    interp bgerror {} $save
+    unset -nocomplain save ::my_error w
 } -result {}
 test text-36.3 "bug #1777362: event handling with hyphenated windows" -setup {
-    proc bgerror {m} {set ::my_error $m}
+    set save [interp bgerror {}]
+    interp bgerror {} returnerror-36.3
+    proc returnerror-36.3 {m opts} {set ::my_error $m}
     set ::my_error {}
     pack [set w [text .t*1]]
 } -body {
@@ -7405,6 +7428,32 @@ test text-36.3 "bug #1777362: event handling with hyphenated windows" -setup {
     set ::my_error
 } -cleanup {
     destroy $w
+    rename returnerror-36.3 ""
+    interp bgerror {} $save
+    unset -nocomplain save ::my_error w
+} -result {}
+
+
+test text-37.1 "bug #dd9667635d: text anchor not set" -setup {
+    set save [interp bgerror {}]
+    interp bgerror {} returnerror-37.1
+    proc returnerror-37.1 {m opts} {set ::my_error $m}
+    destroy .t
+    set ::my_error {}
+    pack [text .t]
+} -body {
+    .t insert end "Hello world!"
+    .t tag add sel 1.0 end
+    # this line shall not trigger error:
+    #     bad text index "tk::anchorN"
+    event generate .t <<SelectPrevLine>>
+    update
+    set ::my_error
+} -cleanup {
+    destroy .t
+    rename returnerror-37.1 ""
+    interp bgerror {} $save
+    unset -nocomplain save ::my_error
 } -result {}
 
 # cleanup
diff --git a/tests/textDisp.test b/tests/textDisp.test
index f2eb47d..6e861b1 100644
--- a/tests/textDisp.test
+++ b/tests/textDisp.test
@@ -948,6 +948,28 @@ test textDisp-6.9 {DisplayText, horizontal scrollbar updates} {
     update
     set scrollInfo
 } [list 0.0 [expr {4.0/11}]]
+test textDisp-6.10 {DisplayText, redisplay embedded windows after scroll.} {aqua} {
+    .t configure -wrap char
+    .t delete 1.0 end
+    .t insert 1.0 "Line 1"
+    foreach i {2 3 4} {
+	.t insert end "\nLine $i"
+    }
+    .t insert end "\n"
+    .t window create end -create {
+	button %W.button_one -text "Button 1"}
+    .t insert end "\nLine 6\n"
+    .t window create end -create {
+	button %W.button_two -text "Button 2"}
+    .t insert end "\nLine 8\n"
+    .t window create end -create {
+	button %W.button_three -text "Button 3"}
+    update
+    .t delete 2.0 3.0
+    update
+    list $tk_textEmbWinDisplay
+} {{4.0 6.0}}
+
 
 # The following group of tests is marked non-portable because
 # they result in a lot of extra redisplay under Ultrix.  I don't
diff --git a/tests/textTag.test b/tests/textTag.test
index ca3dc0f..2c09e1d 100644
--- a/tests/textTag.test
+++ b/tests/textTag.test
@@ -1502,6 +1502,7 @@ test textTag-18.1 {TkTextPickCurrent tag bindings} -setup {
     bind .t <Leave> {lappend res Leave}
 
     set res {}
+    update
     # Bindings must not trigger on the widget border, only over
     # the actual tagged characters themselves.
     event gen .t <Motion> -warp 1 -x 0 -y 0 ; update