summaryrefslogtreecommitdiffstats
path: root/tests/imgPhoto.test
diff options
context:
space:
mode:
Diffstat (limited to 'tests/imgPhoto.test')
-rw-r--r--tests/imgPhoto.test938
1 files changed, 506 insertions, 432 deletions
diff --git a/tests/imgPhoto.test b/tests/imgPhoto.test
index 268700a..d1692a8 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]
@@ -61,7 +129,7 @@ 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 imgPhoto-1.1 {options for photo images} -body {
@@ -112,7 +180,31 @@ 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 -boolean, normal use} -setup {
+ image create photo photo1
+} -body {
+ photo1 put "green" -to 0 0
+ photo1 transparency set 0 0 1 -boolean
+} -cleanup {
+ imageCleanup
+} -result {}
+test imgPhoto-1.14 {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 {
@@ -135,7 +227,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 {
@@ -171,7 +263,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 {
@@ -249,7 +374,7 @@ test imgPhoto-4.10 {ImgPhotoCmd procedure: copy option} -constraints {
list [image width photo1] [image height photo1] [photo1 get 100 100]
} -cleanup {
image delete photo1 photo2
-} -result {256 256 {169 117 90 255}}
+} -result {256 256 {169 117 90}}
test imgPhoto-4.11 {ImgPhotoCmd procedure: copy option} -setup {
image create photo photo1
} -body {
@@ -291,7 +416,7 @@ test imgPhoto-4.15 {ImgPhotoCmd procedure: copy option} -constraints {
list [image width photo1] [image height photo1] [photo1 get 20 10]
} -cleanup {
image delete photo1 photo2
-} -result {60 50 {215 154 120 255}}
+} -result {60 50 {215 154 120}}
test imgPhoto-4.16 {ImgPhotoCmd procedure: copy option} -constraints {
hasTeapotPhoto
} -setup {
@@ -302,7 +427,7 @@ test imgPhoto-4.16 {ImgPhotoCmd procedure: copy option} -constraints {
list [image width photo1] [image height photo1] [photo1 get 40 80]
} -cleanup {
image delete photo1 photo2
-} -result {80 100 {19 92 192 255}}
+} -result {80 100 {19 92 192}}
test imgPhoto-4.17 {ImgPhotoCmd procedure: copy option} -constraints {
hasTeapotPhoto
} -setup {
@@ -313,7 +438,7 @@ test imgPhoto-4.17 {ImgPhotoCmd procedure: copy option} -constraints {
list [image width photo1] [image height photo1] [photo1 get 80 60]
} -cleanup {
image delete photo1 photo2
-} -result {100 100 {215 154 120 255}}
+} -result {100 100 {215 154 120}}
test imgPhoto-4.18 {ImgPhotoCmd procedure: copy option} -constraints {
hasTeapotPhoto
} -setup {
@@ -324,7 +449,7 @@ test imgPhoto-4.18 {ImgPhotoCmd procedure: copy option} -constraints {
list [image width photo1] [image height photo1] [photo1 get 100 50]
} -cleanup {
image delete photo1 photo2
-} -result {120 100 {169 99 47 255}}
+} -result {120 100 {169 99 47}}
test imgPhoto-4.19 {ImgPhotoCmd procedure: copy option} -constraints {
hasTeapotPhoto
} -setup {
@@ -335,7 +460,7 @@ test imgPhoto-4.19 {ImgPhotoCmd procedure: copy option} -constraints {
list [image width photo1] [image height photo1] [photo1 get 100 50]
} -cleanup {
image delete photo1 photo2
-} -result {120 100 {169 99 47 255}}
+} -result {120 100 {169 99 47}}
test imgPhoto-4.20 {ImgPhotoCmd procedure: copy option} -constraints {
hasTeapotPhoto
} -setup {
@@ -346,7 +471,7 @@ test imgPhoto-4.20 {ImgPhotoCmd procedure: copy option} -constraints {
list [image width photo1] [image height photo1] [photo1 get 50 30]
} -cleanup {
image delete photo1 photo2
-} -result {90 80 {207 146 112 255}}
+} -result {90 80 {207 146 112}}
test imgPhoto-4.21 {ImgPhotoCmd procedure: copy option} -constraints {
hasTeapotPhoto
} -setup {
@@ -370,16 +495,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 {
hasTranspTeapotPhoto
} -setup {
image create photo photo1
} -body {
photo1 read $transpTeapotPhotoFile
- list [photo1 get 100 100] [photo1 get 150 100] [photo1 get 100 150]
+ list [photo1 get 100 100 -withalpha] \
+ [photo1 get 150 100 -withalpha] \
+ [photo1 get 100 150] [photo1 get 150 150]
} -cleanup {
image delete photo1
-} -result {{175 71 0 162} {179 73 0 168} {14 8 0 219}}
+} -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 {
@@ -397,10 +525,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 {
@@ -414,27 +544,28 @@ test imgPhoto-4.27 {ImgPhotoCmd procedure: put option} -setup {
photo1 put {{white} {white white}}
} -returnCodes error -cleanup {
image delete photo1
-} -result {invalid row # 1: all rows 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 {
# SB: odd thing - this test passed with tk 8.6.6, even if the data
- # is in the wrong position!
+ # 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 255}
-# more tests for image put: 4.90-4.94
+} -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 {
@@ -483,7 +614,7 @@ test imgPhoto-4.35 {ImgPhotoCmd procedure: read option} -constraints {
list [image width photo1] [image height photo1] [photo1 get 120 120]
} -cleanup {
image delete photo1
-} -result {256 256 {161 109 82 255}}
+} -result {256 256 {161 109 82}}
test imgPhoto-4.36 {ImgPhotoCmd procedure: read option} -constraints {
hasTeapotPhoto
} -setup {
@@ -493,7 +624,7 @@ test imgPhoto-4.36 {ImgPhotoCmd procedure: read option} -constraints {
list [image width photo1] [image height photo1] [photo1 get 29 19]
} -cleanup {
image delete photo1
-} -result {70 60 {244 180 144 255}}
+} -result {70 60 {244 180 144}}
test imgPhoto-4.37 {ImgPhotoCmd procedure: redither option} -setup {
image create photo photo1
} -body {
@@ -516,6 +647,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 {
@@ -540,7 +672,7 @@ test imgPhoto-4.42 {ImgPhotoCmd procedure: transparency get option} -setup {
test imgPhoto-4.43 {ImgPhotoCmd procedure: transparency get option} -setup {
image create photo photo1
} -body {
- photo1 transparency get 0 0 -boolean 0
+ photo1 transparency get 0 0 0 -boolean
} -returnCodes error -cleanup {
image delete photo1
} -result {wrong # args: should be "photo1 transparency get x y ?-option?"}
@@ -603,35 +735,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.75-4.80
+# 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 ?-option? newVal"}
+} -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 ?-option? newVal"}
+} -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 ?-option? newVal"}
+} -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 -boolean 0 0
+ photo1 transparency set 0 0 0 0 -boolean
} -returnCodes error -cleanup {
image delete photo1
-} -result {wrong # args: should be "photo1 transparency set x y ?-option? newVal"}
+} -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 {
@@ -648,6 +784,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 {
@@ -699,7 +836,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.81-4.88
+# 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 {
@@ -824,9 +961,7 @@ test imgPhoto-4.75 {<photo> read command: filename starting with '-'} -constrain
image delete photo1
file delete ./-teapotPhotoFile
} -result {}
-
-test imgPhoto-4.75 {ImgPhotoCmd procedure: transparancy get} -setup {
- imageCleanup
+test imgPhoto-4.76 {ImgPhotoCmd, transparancy get: too many options} -setup {
image create photo photo1
} -body {
photo1 put white -to 0 0 1 1
@@ -835,8 +970,7 @@ test imgPhoto-4.75 {ImgPhotoCmd procedure: transparancy get} -setup {
imageCleanup
} -returnCodes error -result \
{wrong # args: should be "photo1 transparency get x y ?-option?"}
-test imgPhoto-4.76 {ImgPhotoCmd procedure: transparency get} -setup {
- imageCleanup
+test imgPhoto-4.77 {ImgPhotoCmd, transparency get: invalid option} -setup {
image create photo photo1
} -body {
photo1 put white -to 0 0 1 1
@@ -844,9 +978,8 @@ test imgPhoto-4.76 {ImgPhotoCmd procedure: transparency get} -setup {
} -cleanup {
imageCleanup
} -returnCodes error -result \
- {unknown option "-bogus": must be -alpha or -boolean}
-test imgPhoto-4.77 {ImgPhotoCmd procedure: transparency get} -setup {
- imageCleanup
+ {unrecognized option "-bogus": must be -alpha, or -boolean}
+test imgPhoto-4.78 {ImgPhotoCmd, transparency get: normal use} -setup {
image create photo photo1
} -body {
photo1 put white -to 0 0 1 1
@@ -855,7 +988,7 @@ test imgPhoto-4.77 {ImgPhotoCmd procedure: transparency get} -setup {
} -cleanup {
imageCleanup
} -result {0 255}
-test imgPhoto-4.78 {ImgPhotoCmd procedure: transparency get} -constraints {
+test imgPhoto-4.79 {ImgPhotoCmd, transparency get: no option} -constraints {
hasTranspTeapotPhoto
} -setup {
image create photo photo1 -file $transpTeapotPhotoFile
@@ -869,7 +1002,8 @@ test imgPhoto-4.78 {ImgPhotoCmd procedure: transparency get} -constraints {
} -cleanup {
imageCleanup
} -result {0 1 0 0 0}
-test imgPhoto-4.79 {ImgPhotoCmd procedure: transparency get} -constraints {
+test imgPhoto-4.80 {ImgPhotoCmd, transparency get: -boolean option\
+} -constraints {
hasTranspTeapotPhoto
} -setup {
image create photo photo1 -file $transpTeapotPhotoFile
@@ -883,7 +1017,7 @@ test imgPhoto-4.79 {ImgPhotoCmd procedure: transparency get} -constraints {
} -cleanup {
imageCleanup
} -result {0 1 0 0 0}
-test imgPhoto-4.80 {ImgPhotoCmd procedure: transparency get} -constraints {
+test imgPhoto-4.81 {ImgPhotoCmd, transparency get: -alpha} -constraints {
hasTranspTeapotPhoto
} -setup {
image create photo photo1 -file $transpTeapotPhotoFile
@@ -897,135 +1031,170 @@ test imgPhoto-4.80 {ImgPhotoCmd procedure: transparency get} -constraints {
} -cleanup {
imageCleanup
} -result {255 0 1 254 206}
-test imgPhoto-4.81 {ImgPhotoCmd procedure: transparency set} -setup {
+test imgPhoto-4.82 {ImgPhotoCmd, transparency set: too many opts} -setup {
image create photo photo1
} -body {
photo1 transparency set 0 0 -alpha -boolean 1
} -cleanup {
imageCleanup
} -returnCodes error -result \
- {wrong # args: should be "photo1 transparency set x y ?-option? newVal"}
-test imgPhoto-4.82 {ImgPhotoCmd procedure: transparency set} -setup {
- image create photo photo1
+ {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 -bogus 0
+ photo1 transparency set 0 0 0 -bogus
} -cleanup {
imageCleanup
-} -returnCodes error -result {unknown option "-bogus": must be -alpha or -boolean}
-test imgPhoto-4.83 {ImgPhotoCmd procedure: transparency set} -setup {
- image create photo photo1
+} -returnCodes error -result \
+ {unrecognized option "-bogus": must be -alpha, or -boolean}
+test imgPhoto-4.84 {ImgPhotoCmd, transparency set: invalid newVal} -setup {
+ image create photo photo1 -data white
} -body {
- photo1 transparency set 0 0 -alpha bogus
+ photo1 transparency set 0 0 bogus -alpha
} -cleanup {
imageCleanup
} -returnCodes error -result {expected integer but got "bogus"}
-test imgPhoto-4.84 {ImgPhotoCmd procedure: transparency set} -setup {
- image create photo photo1
+test imgPhoto-4.85 {ImgPhotoCmd, transparency set: invalid newVal} -setup {
+ image create photo photo1 -data red
} -body {
- photo1 transparency set 0 0 -alpha -1
+ photo1 transparency set 0 0 -1 -alpha
} -returnCodes error -result \
{invalid alpha value "-1": must be integer between 0 and 255}
-test imgPhoto-4.85 {ImgPhotoCmd procedure: transparency set} -setup {
- image create photo photo1
+test imgPhoto-4.86 {ImgPhotoCmd, transparency set: invalid newVal} -setup {
+ image create photo photo1 -data green
} -body {
- photo1 transparency set 0 0 -alpha 256
+ 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.86 {ImgPhotoCmd procedure: transparency set} -setup {
+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]
+ list [photo1 transparency get 0 0 -alpha] \
+ [photo1 transparency get 1 0 -alpha]
} -cleanup {
imageCleanup
} -result {255 0}
-test imgPhoto-4.87 {ImgPhotoCmd procedure: transparency set} -setup {
+test imgPhoto-4.88 {ImgPhotoCmd, transparency set: -boolean} -setup {
image create photo photo1
} -body {
photo1 put white -to 0 0 2 1
- photo1 transparency set 0 0 -boolean 0
- photo1 transparency set 1 0 -boolean 1
- list [photo1 transparency get 0 0 -alpha] [photo1 transparency get 1 0 -alpha]
+ photo1 transparency set 0 0 0 -boolean
+ photo1 transparency set 1 0 1 -boolean
+ list [photo1 transparency get 0 0 -alpha] \
+ [photo1 transparency get 1 0 -alpha]
} -cleanup {
imageCleanup
} -result {255 0}
-test imgPhoto-4.88 {ImgPhotoCmd procedure: transparency set} -setup {
+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 -alpha 0
- photo1 transparency set 1 0 -alpha 1
- photo1 transparency set 0 1 -alpha 254
- photo1 transparency set 1 1 -alpha 255
+ 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.89 {ImgPhotoCmd procdeure: put option} -constraints {
+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 {
- # put data in a registered format
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]]
+ || [image height photo1] != [image height photo2]} {
+ lappend result [list [image width photo2] [image height photo2]]
} else {
- lappend result 1
+ 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
- }
+ 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.90 {ImgPhotoCmd procedure: put option} -setup {
- imageCleanup
+test imgPhoto-4.94 {ImgPhotoCmd put: unknown format} -setup {
image create photo photo1
} -body {
- # unknown format
photo1 put {no real data} -format bogus
} -cleanup {
imageCleanup
} -returnCodes error -result {image format "bogus" is not supported}
-test imgPhoto-4.91 {ImgPhotoCmd procedure: put option} -setup {
- imageCleanup
+test imgPhoto-4.95 {ImgPhotoCmd put: default fmt, invalid data} -setup {
image create photo photo1
} -body {
- # default format, invalid data error case
- photo1 put "not a \{ proper list"
+ photo1 put {{red green blue} {red " blue}}
+ #"
} -cleanup {
imageCleanup
-} -returnCodes error -result {unmatched open brace in list}
-test imgPhoto-4.92 {ImgPhotoCmd procedure: put option} -setup {
+} -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 argb"] \
+ [photo2 data -format "default -colorformat argb"]]
+ 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 {
- # no -to option, image size is data size
photo1 put {{red green blue} {blue red green}}
list [image width photo1] [image height photo1]
} -cleanup {
imageCleanup
} -result {3 2}
-test imgPhoto-4.93 {ImgPhotoCmd procedure: put option} -setup {
- imageCleanup
+test imgPhoto-4.98 {ImgPhotoCmd put: -to with 2 coords} -setup {
image create photo photo1
} -body {
- # two coordinates for -to option
photo1 put {{"alice blue" "blanched almond"}
{"deep sky blue" "ghost white"}
{#AABBCC #AABBCCDD}} -to 5 6
@@ -1033,14 +1202,12 @@ test imgPhoto-4.93 {ImgPhotoCmd procedure: put option} -setup {
} -cleanup {
imageCleanup
} -result {7 9}
-test imgPhoto-4.94 {ImgPhotoCmd procedure: put option} -setup {
- imageCleanup
+test imgPhoto-4.99 {ImgPhotoCmd put: -to with 4 coords} -setup {
image create photo photo1
} -body {
- # 4 coordinates for -to option, data gets tiled
photo1 put {{#123 #456 #678} {#9AB #CDE #F01}} -to 1 2 20 21
set result {}
- lappend result [photo1 get 19 20]
+ 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 \
@@ -1049,11 +1216,9 @@ test imgPhoto-4.94 {ImgPhotoCmd procedure: put option} -setup {
} -cleanup {
imageCleanup
} -result {{17 34 51 255} 1 1}
-test imgPhoto-4.95 {ImgPhotoCmd procedure: put option} -setup {
- imageCleanup
+test imgPhoto-4.100 {ImgPhotoCmd put: no changes on empty data} -setup {
image create photo photo1
} -body {
- # empty data does not cause changes
photo1 put {{brown blue} {cyan coral}}
set imgData [photo1 data]
photo1 put {}
@@ -1061,7 +1226,170 @@ test imgPhoto-4.95 {ImgPhotoCmd procedure: put option} -setup {
} -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: argb colorformat} -setup {
+ image create photo photo1 -data {{red green} {blue white}}
+} -body {
+ photo1 data -format {default -colorformat argb}
+} -result {{#ffff0000 #ff008000} {#ff0000ff #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 argb} \
+ {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 {
@@ -1084,7 +1412,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]
@@ -1098,7 +1426,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 {
@@ -1159,7 +1487,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
@@ -1183,7 +1511,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 {
@@ -1191,7 +1519,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 {
@@ -1199,8 +1527,8 @@ test imgPhoto-10.1 {Tk_ImgPhotoPutBlock procedure} -setup {
photo1 put "{#ff0000 #ff0000 #ff0000 #ff0000 #ff0000 #ff0000 #ff0000 #ff0000}" -to 0 0
photo1 put "{#00ff00 #00ff00}" -to 2 0
list [photo1 get 2 0] [photo1 get 3 0] [photo1 get 4 0]
-} -result {{0 255 0 255} {0 255 0 255} {255 0 0 255}}
-
+} -result {{0 255 0} {0 255 0} {255 0 0}}
+
test imgPhoto-11.1 {Tk_FindPhoto} -setup {
imageCleanup
} -body {
@@ -1210,7 +1538,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]]
@@ -1218,8 +1546,8 @@ test imgPhoto-12.1 {Tk_PhotoPutZoomedBlock} -constraints hasTeapotPhoto -body {
lappend result [image width p3] [image height p3] [p3 get 100 100]
} -cleanup {
image delete p3
-} -result {{19 92 192 255} {169 117 90 255} 512 512 {19 92 192 255}}
-
+} -result {{19 92 192} {169 117 90} 512 512 {19 92 192}}
+
test imgPhoto-13.1 {check separation of images in different interpreters} -setup {
imageCleanup
set data {
@@ -1264,7 +1592,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
@@ -1357,7 +1685,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 {
@@ -1365,7 +1693,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 {
@@ -1376,7 +1704,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]
@@ -1415,364 +1743,110 @@ test imgPhoto-17.3 {photo write: format guessing from filename} -setup {
image delete $i
catch {removeFile $f}
} -result "P6\n"
-
-test imgPhoto-18.1 {ImgStringMatch: data is not a list} -setup {
- imageCleanup
- image create photo photo1
+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 put {not a " proper list}
- # " (this comment is here only for editor highlighting)
+ photo1 write $f -format default
} -cleanup {
imageCleanup
-} -returnCodes error -result {unmatched open quote in list}
-# empty data case tested with imgPhoto-4.95
-test imgPhoto-18.2 {ImgStringMatch: list element not a proper list} -setup {
- imageCleanup
- image create photo photo1
+ 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 put {{red white} {not "} {blue green}}
- # "
+ photo1 write $f
} -cleanup {
- imageCleanup
-} -returnCodes error -result {unmatched open quote in list}
-test imgPhoto-18.3 {ImgStringMatch: sublists with differen lengths} -setup {
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 put {{#001122 #334455 #667788}
- {#99AABB #CCDDEE}
- {#FF0011 #223344 #556677}}
+ photo1 read $f -format default
} -cleanup {
imageCleanup
-} -returnCodes error -result \
- {invalid row # 1: all rows must have the same number of elements}
-test imgPhoto-18.4 {ImgStringMatch: valid data} -setup {
- 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 {{blue green}
- {yellow magenta}
- {#000000 #FFFFFFFF}}
- list [image width photo1] [image height photo1] [photo1 get 0 2]
+ photo1 put {{red blue red} {yellow green yellow}} -format default
+ list [image width photo1] [image height photo1]
} -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 ImgStringMatch
-test imgPhoto-19.1 {ImgStringRead: normal use case} -constraints {
- hasTeapotPhoto
-} -setup {
- imageCleanup
- image create photo photo1 -file $teapotPhotoFile
- image create photo photo2
-} -body {
- set imgData [photo1 data]
- photo2 put $imgData
- string equal [photo1 data] [photo2 data]
+} -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
- unset imgData
-} -result {1}
-test imgPhoto-19.2 {ImgStringRead: correct compositing rule} -constraints {
- hasTranspTeapotPhoto
-} -setup {
- imageCleanup
- image create photo photo1 -file $transpTeapotPhotoFile
+} -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 {
- # currently, this test is pointless, as [imageName data] does not include
- # transparency information. To be considered as a placeholder.
- photo2 put #FF0000 -to 0 0 50 50
- photo2 put [photo1 data] -to 10 10 40 40
- list [photo2 get 0 0] [photo2 get 20 25] [photo2 get 49 49]
+ photo1 put $imgData -format ppm
+ list [image width photo1] [image height photo1]
} -cleanup {
+ unset imgData
imageCleanup
-} -result {{255 0 0 255} {0 78 185 255} {255 0 0 255}}
-test imgPhoto-20.1 {ImgStringWrite: test some pixels} -constraints {
+} -result {1 2}
+test imgPhoto-19.4 {MatchStringFormat: ppm fmt, without opt} -constraints {
hasTeapotPhoto
} -setup {
- set result {}
- imageCleanup
image create photo photo1 -file $teapotPhotoFile
+ image create photo photo2
} -body {
- set imgData [photo1 data]
- # note: with [lindex], the coords are inverted (y x)
- 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 {{#135cc0} #a06d52 #e1c8ba}
-test imgPhoto-21.1 {ImgPhotoParseColor: valid suffixes} -setup {
- imageCleanup
- image create photo photo1
- set result {}
-} -body {
- photo1 put {{blue@0.711 #114433#C} {#8D4#1A magenta}}
- lappend result [photo1 get 0 0]
- lappend result [photo1 get 1 0]
- lappend result [photo1 get 0 1]
- lappend result [photo1 get 1 1]
- set result
-} -cleanup {
- unset result
- imageCleanup
-} -result {{0 0 255 181} {17 68 51 204} {136 221 68 26} {255 0 255 255}}
-test imgPhoto-21.2 {ImgPhotoParseColor: valid suffixes, no suffix} -setup {
- imageCleanup
- image create photo photo1
- set result {}
-} -body {
- photo1 put {{#52D8a0 #2B5} {#E47@0.01 maroon#4}}
- lappend result [photo1 get 0 0]
- lappend result [photo1 get 1 0]
- lappend result [photo1 get 0 1]
- lappend result [photo1 get 1 1]
- set result
-} -cleanup {
- unset result
- imageCleanup
-} -result {{82 216 160 255} {34 187 85 255} {238 68 119 3} {128 0 0 68}}
-test imgPhoto-21.3 {ImgPhotoParseColor: # suffix, no hex digits} -setup {
- imageCleanup
- image create photo photo1
-} -body {
- photo1 put {{black#}}
-} -cleanup {
- imageCleanup
-} -returnCodes error -result {invalid alpha suffix "#"}
-test imgPhoto-21.4 {ImgPhotoParseColor: # suffix, too many digists} -setup {
- imageCleanup
- image create photo photo1
-} -body {
- photo1 put {{#ABC#123}}
-} -cleanup {
- imageCleanup
-} -returnCodes error -result \
- {invalid alpha suffix "#123"}
-test imgPhoto-21.5 {ImgPhotoParseColor: wrong digit count for color} -setup {
- imageCleanup
- image create photo photo1
-} -body {
- photo1 put {{#00}}
-} -returnCodes error -result {invalid color name "#00"}
-test imgPhoto-21.6 {ImgPhotoParseColor: invalid hex digit #1} -setup {
- imageCleanup
- image create photo photo1
-} -body {
- photo1 put #ABCDEG@.99
-} -cleanup {
- imageCleanup
-} -returnCodes error -result {invalid color name "#ABCDEG"}
-test imgPhoto-21.7 {ImgPhotoParseColor: invalid hex digit #2} -setup {
- imageCleanup
- image create photo photo1
-} -body {
- photo1 put {#ABCZ}
-} -cleanup {
- imageCleanup
-} -returnCodes error -result {invalid color name "#ABCZ"}
-test imgPhoto-21.8 {ImgPhotoParseColor: valid #ARGB color} -setup {
- imageCleanup
- image create photo photo1
-} -body {
- photo1 put {{#0d9bd502 #F7ac}}
- list [photo1 get 0 0] [photo1 get 1 0]
-} -cleanup {
- imageCleanup
-} -result {{155 213 2 13} {119 170 204 255}}
-test imgPhoto-21.9 {ImgPhotoParseColor: empty string} -setup {
- imageCleanup
- 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]
- set result
-} -cleanup {
- unset result
- imageCleanup
-} -result {2 2 {0 0 0 0}}
-test imgPhoto-21.10 {ImgPhotoParsecolor: empty string, mixed} -setup {
- imageCleanup
- image create photo photo1
-} -body {
- photo1 put {{black white} {{} white}}
- list [photo1 get 0 0] [photo1 get 0 1]
-} -cleanup {
- imageCleanup
-} -result {{0 0 0 255} {0 0 0 0}}
-test imgPhoto-21.9 {ImgPhotoParseColor: list form, invalid list} -setup {
- imageCleanup
- image create photo photo1
-} -body {
- photo1 put {{{123 45 67 "}}}
- # "
-} -cleanup {
- imageCleanup
-} -returnCodes error -result {can't parse color "123 45 67 ""}
-test imgPhoto-21.10 {ImgPhotoParseColor: too few elements in list} -setup {
- imageCleanup
- image create photo photo1
-} -body {
- photo1 put {{{0 255}}}
-} -cleanup {
- imageCleanup
-} -returnCodes error -result {can't parse color "0 255"}
-test imgPhoto-21.11 {ImgPhotoParseColor: too many elements in list} -setup {
- imageCleanup
- image create photo photo1
-} -body {
- photo1 put {{{0 100 200 255 0}}}
-} -returnCodes error -result {can't parse color "0 100 200 255 0"}
-test imgPhoto-21.12 {ImgPhotoParseColor: not an integer value} -setup {
- imageCleanup
- image create photo photo1
-} -body {
- photo1 put {{{9 0xf3 87 65} {43 21 10 1.0}}}
-} -cleanup {
- imageCleanup
-} -returnCodes error -result {expected integer but got "1.0"}
-test imgPhoto-21.13 {ImgPhotoParseColor: negative value in list} -setup {
- imageCleanup
- image create photo photo1
-} -body {
- photo1 put {{{121 121 -1}}}
-} -cleanup {
- imageCleanup
-} -returnCodes error -result \
- {invalid color "121 121 -1": expected integers in the range from 0 to 255}
-test imgPhoto-21.14 {ImgPhotoParseColor: value in list too large} -setup {
- imageCleanup
- image create photo photo1
-} -body {
- photo1 put {{{254 255 256}}}
-} -cleanup {
- imageCleanup
-} -returnCodes error -result \
- {invalid color "254 255 256": expected integers in the range from 0 to 255}
-test imgPhoto-21.15 {ImgPhotoParseColor: valid list form} -setup {
- imageCleanup
- 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] [photo1 get 1 0] [photo1 get 0 1] [photo1 get 1 1]
-} -cleanup {
- imageCleanup
-} -result {{0 16 254 255} {0 100 254 255} {30 30 30 0} {1 1 254 1}}
-test imgPhoto-21.16 {ImgPhotoParseColor: suffix not allowed #1} -setup {
- imageCleanup
- image create photo photo1
-} -body {
- photo1 put #ABCD@0.5
-} -cleanup {
- imageCleanup
-} -returnCodes error -result \
- {invalid color "#ABCD@0.5": format does not allow alpha suffix}
-test imgPhoto-21.17 {ImgPhotoParseColor: suffix not allowed #2} -setup {
- imageCleanup
- image create photo photo1
-} -body {
- photo1 put {{{100 100 100#FE}}}
-} -cleanup {
- imageCleanup
-} -returnCodes error -result \
- {invalid color "100 100 100#FE": format does not allow alpha suffix}
-test ImgPoto-21.18 {ImgPhotoParseColor: suffix not allowed #3} -setup {
- imageCleanup
- image create photo photo1
-} -body {
- photo1 put #1111#1
-} -cleanup {
- imageCleanup
-} -returnCodes error -result \
- {invalid color "#1111#1": format does not allow alpha suffix}
-test imgPhoto-21.19 {ImgPhotoParseColor: @A, not a float} -setup {
- imageCleanup
- image create photo photo1
-} -body {
- photo1 put blue@bogus
-} -cleanup {
- imageCleanup
-} -returnCodes error -result \
- {invalid alpha suffix "@bogus": expected floating-point value}
-test imgPhoto-21.20 {ImgPhotoParseColor: @A, value too low} -setup {
- imageCleanup
- image create photo photo1
-} -body {
- photo1 put green@-0.1
-} -cleanup {
- imageCleanup
-} -returnCodes error -result \
- {invalid alpha suffix "@-0.1": value must be in the range from 0 to 1}
-test imgPhoto-21.21 {ImgPhotoParseColor: @A, value too high} -setup {
- imageCleanup
- image create photo photo1
-} -body {
- photo1 put #000000@1.0001
+ set imgData [photo1 data -format ppm]
+ photo2 put $imgData
+ list [image width photo2] [image height photo2]
} -cleanup {
imageCleanup
-} -returnCodes error -result \
- {invalid alpha suffix "@1.0001": value must be in the range from 0 to 1}
-test imgPhoto-21.22 {ImgPhotoParseColor: @A, edge values} -setup {
- imageCleanup
+ unset imgData
+} -result {256 256}
+test imgPhoto-19.5 {MatchStirngFormat: unknown -format} -setup {
image create photo photo1
} -body {
- photo1 put {{yellow@1e-22 yellow@0.12352941 yellow@0.12352942 \
- yellow@0.9999999}}
- list [photo1 get 0 0] [photo1 get 1 0] [photo1 get 2 0] [photo1 get 3 0]
+ photo1 put {} -format bogus
} -cleanup {
imageCleanup
-} -result {{255 255 0 0} {255 255 0 31} {255 255 0 32} {255 255 0 255}}
-test imgPhoto-21.23 {ImgPhotoParseColor: invalid digit in #X suffix} -setup {
- 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 #000#g
+ photo1 put bogus
} -cleanup {
imageCleanup
-} -returnCodes error -result {invalid alpha suffix "#g": expected hex digit}
-test imgPhoto-21.24 {ImgPhotoParseColor: invalid digit in #XX suffix} -setup {
- 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 green#2W
+ photo1 put bogus -format dEFault
} -cleanup {
imageCleanup
-} -returnCodes error -result {invalid alpha suffix "#2W": expected hex digit}
-test imgPhoto-21.25 {ImgPhotoParseColor: overall test - all color / suffix
- combinations} -setup {
- imageCleanup
+} -returnCodes error -result {couldn't recognize image data}
+test imgPhoto-19.8 {MatchStirngFormat: invalid data for gif} -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} #8fee #80fffafa snow}}
- for {set y 0} {$y < 4} {incr y} {
- for {set x 0} {$x < 5} {incr x} {
- lappend result [photo1 get $x $y]
- }
- }
- set result
+ photo1 put bogus -format giF
} -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}}
-
+} -returnCodes error -result {couldn't recognize image data}
+
# ----------------------------------------------------------------------
catch {rename foreachPixel {}}
generated by cgit v0.12 at 2024-11-10 18:29:30 (GMT)