summaryrefslogtreecommitdiffstats
path: root/tests/imgPhoto.test
diff options
context:
space:
mode:
Diffstat (limited to 'tests/imgPhoto.test')
-rw-r--r--tests/imgPhoto.test105
1 files changed, 45 insertions, 60 deletions
diff --git a/tests/imgPhoto.test b/tests/imgPhoto.test
index b5a91fe..8acf2bc 100644
--- a/tests/imgPhoto.test
+++ b/tests/imgPhoto.test
@@ -2,10 +2,10 @@
# procedures in the file tkImgPhoto.c. It is organized in the standard fashion
# for Tcl tests.
#
-# Copyright (c) 1994 The Australian National University
-# Copyright (c) 1994-1997 Sun Microsystems, Inc.
-# Copyright (c) 1998-1999 by Scriptics Corporation.
-# Copyright (c) 2002-2008 Donal K. Fellows
+# Copyright © 1994 The Australian National University
+# Copyright © 1994-1997 Sun Microsystems, Inc.
+# Copyright © 1998-1999 by Scriptics Corporation.
+# Copyright © 2002-2008 Donal K. Fellows
# All rights reserved.
#
# Author: Paul Mackerras (paulus@cs.anu.edu.au)
@@ -32,7 +32,7 @@
# ImgPhotoCmd imgPhoto-4.*, imgPhoto-17.*
# GetExtension: no tests
# ParseSubcommandOptions: imgPhoto-1.*
-# ImgPhotoConfigureMaster: imgPhoto-3.*, imgPhoto-15.*
+# ImgPhotoConfigureModel: imgPhoto-3.*, imgPhoto-15.*
# toggleComplexAlphaIfNeeded: no tests
# ImgPhotoDelete: imgPhoto-8.*
# ImgPhotoCmdDeleteProc: imgPhoto-9.*
@@ -129,14 +129,8 @@ 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 needsTcl867 [package vsatisfies [package provide Tcl] 8.6.7-]
-testConstraint base64PackageNeeded [base64ok]
test imgPhoto-1.1 {options for photo images} -body {
image create photo photo1 -width 79 -height 83
@@ -193,7 +187,7 @@ test imgPhoto-1.12 {option -alpha, normal use} -setup {
photo1 transparency get 0 0 -alpha
} -cleanup {
imageCleanup
-} -result {255}
+} -result 255
test imgPhoto-1.13 {option -withalpha, normal use} -setup {
image create photo photo1
} -body {
@@ -226,7 +220,7 @@ test imgPhoto-2.2 {ImgPhotoCreate procedure} -setup {
# set msg
# } {couldn't open "bogus.img": no such file or directory}
-test imgPhoto-3.1 {ImgPhotoConfigureMaster procedure} -constraints {
+test imgPhoto-3.1 {ImgPhotoConfigureModel procedure} -constraints {
hasTeapotPhoto
} -body {
image create photo photo1 -file $teapotPhotoFile
@@ -234,7 +228,7 @@ test imgPhoto-3.1 {ImgPhotoConfigureMaster procedure} -constraints {
} -cleanup {
image delete photo1
} -result {}
-test imgPhoto-3.2 {ImgPhotoConfigureMaster procedure} -constraints {
+test imgPhoto-3.2 {ImgPhotoConfigureModel procedure} -constraints {
hasTeapotPhoto
} -body {
image create photo photo1 -file $teapotPhotoFile
@@ -243,7 +237,7 @@ test imgPhoto-3.2 {ImgPhotoConfigureMaster procedure} -constraints {
} -cleanup {
image delete photo1
} -result {1 {couldn't open "bogus": no such file or directory} 256 256}
-test imgPhoto-3.3 {ImgPhotoConfigureMaster procedure} -constraints {
+test imgPhoto-3.3 {ImgPhotoConfigureModel procedure} -constraints {
hasTeapotPhoto
} -setup {
destroy .c
@@ -261,7 +255,7 @@ 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 {
+test imgPhoto-3.4 {ImgPhotoConfigureModel: -data <ppm>} -constraints {
hasTeapotPhoto
} -setup {
image create photo photo1 -file $teapotPhotoFile
@@ -272,8 +266,9 @@ test imgPhoto-3.4 {ImgPhotoConfigureMaster: -data <ppm>} -constraints {
} -cleanup {
imageCleanup
} -result {20 20}
-test imgPhoto-3.5 {ImgPhotoConfigureMaster: -data <png>} -constraints {
- hasTeapotPhoto
+# This testcase fails with Tcl < 8.6.7, due to [25842c]
+test imgPhoto-3.5 {ImgPhotoConfigureModel: -data <png>} -constraints {
+ hasTeapotPhoto needsTcl867
} -setup {
image create photo photo1 -file $teapotPhotoFile
image create photo photo2
@@ -283,7 +278,7 @@ test imgPhoto-3.5 {ImgPhotoConfigureMaster: -data <png>} -constraints {
} -cleanup {
imageCleanup
} -result {20 20}
-test imgPhoto-3.6 {ImgPhotoConfigureMaster: -data <default>} -constraints {
+test imgPhoto-3.6 {ImgPhotoConfigureModel: -data <default>} -constraints {
hasTeapotPhoto
} -setup {
image create photo photo1 -file $teapotPhotoFile
@@ -959,7 +954,7 @@ test imgPhoto-4.75 {<photo> read command: filename starting with '-'} -constrain
image delete photo1
file delete ./-teapotPhotoFile
} -result {}
-test imgPhoto-4.76 {ImgPhotoCmd procedure: copy to same image} -constraints {
+test imgPhoto-4.75.1 {ImgPhotoCmd procedure: copy to same image} -constraints {
hasTeapotPhoto
} -setup {
imageCleanup
@@ -971,7 +966,7 @@ test imgPhoto-4.76 {ImgPhotoCmd procedure: copy to same image} -constraints {
} -cleanup {
imageCleanup
} -result {}
-test imgPhoto-4.76 {ImgPhotoCmd, transparancy get: too many options} -setup {
+test imgPhoto-4.76 {ImgPhotoCmd, transparency get: too many options} -setup {
image create photo photo1
} -body {
photo1 put white -to 0 0 1 1
@@ -1211,7 +1206,7 @@ test imgPhoto-4.100 {ImgPhotoCmd put: no changes on empty data} -setup {
string equal $imgData [photo1 data]
} -cleanup {
imageCleanup
-} -result {1}
+} -result 1
test imgPhoto-4.101 {ImgPhotoCmd get: too many args} -setup {
image create photo photo1
} -body {
@@ -1340,10 +1335,10 @@ test imgPhoto-4.117 {ImgPhotoCmd data: list colorformat} -setup {
} -body {
photo1 data -format {default -colorformat list}
} -result {{{255 0 0 170} {0 128 0 255}} {{0 0 255 204} {255 255 255 221}}}
+# This testcase fails with Tcl < 8.6.7, due to [25842c]
test imgPhoto-4.118 {ImgPhotoCmd data: using data for new image
results in same image as orignial } -constraints {
- hasTeapotPhoto
- hasTranspTeapotPhoto
+ hasTeapotPhoto hasTranspTeapotPhoto needsTcl867
} -setup {
image create photo teapot -file $teapotPhotoFile
teapot copy teapot -from 50 60 70 80 -shrink
@@ -1503,8 +1498,8 @@ test imgPhoto-9.1 {ImgPhotoCmdDeletedProc procedure} -constraints {
} -body {
image create photo photo2 -file $teapotPhotoFile
rename photo2 {}
- list [lsearch -exact [imageNames] photo2] [catch {photo2 foo} msg] $msg
-} -result {-1 1 {invalid command name "photo2"}}
+ list [expr {"photo2" in [imageNames]}] [catch {photo2 foo} msg] $msg
+} -result {0 1 {invalid command name "photo2"}}
test imgPhoto-10.1 {Tk_ImgPhotoPutBlock procedure} -setup {
imageCleanup
@@ -1527,7 +1522,7 @@ test imgPhoto-10.2 {Tk_ImgPhotoPutBlock, same source and dest img} -constraints
string equal [photo1 data] [photo2 data]
} -cleanup {
imageCleanup
-} -result {1}
+} -result 1
test imgPhoto-10.3 {Tk_ImgPhotoPutBlock, same source and dest img} -constraints {
hasTeapotPhoto
} -setup {
@@ -1541,7 +1536,7 @@ test imgPhoto-10.3 {Tk_ImgPhotoPutBlock, same source and dest img} -constraints
string equal [photo1 data] [photo2 data]
} -cleanup {
imageCleanup
-} -result {1}
+} -result 1
test imgPhoto-10.4 {Tk_ImgPhotoPutBlock, empty image} -setup {
imageCleanup
} -body {
@@ -1583,7 +1578,7 @@ test imgPhoto-12.2 {Tk_ImgPhotoPutZoomedBlock, same source and dest img} -constr
string equal [photo1 data] [photo2 data]
} -cleanup {
imageCleanup
-} -result {1}
+} -result 1
test imgPhoto-12.3 {Tk_ImgPhotoPutZoomedBlock, same source and dest img} -setup {
imageCleanup
} -body {
@@ -1595,7 +1590,7 @@ test imgPhoto-12.3 {Tk_ImgPhotoPutZoomedBlock, same source and dest img} -setup
string equal [photo1 data] [photo2 data]
} -cleanup {
imageCleanup
-} -result {1}
+} -result 1
test imgPhoto-12.4 {Tk_ImgPhotoPutZoomedBlock, empty image} -setup {
imageCleanup
} -body {
@@ -1949,13 +1944,10 @@ test imgPhoto-19.8 {MatchStirngFormat: invalid data for gif} -setup {
} -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,
+# WARNING - tests 20.1-20.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 {
+test imgPhoto-20.1 {Reject corrupted GIF (binary string)} -setup {
+ set data [binary decode base64 {
R0lGODlhAAQABP8zM/8z/zP/MzP/////M////yH5CiwheLrcLTBCd6Tv2qW16tdK4jhV
5qpraXIvM1JlNyAgOw==
}]
@@ -1964,7 +1956,7 @@ test imgPhoto-18.1 {Reject corrupted GIF (binary string)} -constraints {
} -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 {
+test imgPhoto-20.2 {Reject corrupted GIF (base 64 string)} -setup {
set data {
R0lGODlhAAQABP8zM/8z/zP/MzP/////M////yH5CiwheLrcLTBCd6Tv2qW16tdK4jhV
5qpraXIvM1JlNyAgOw==
@@ -1974,18 +1966,15 @@ test imgPhoto-18.2 {Reject corrupted GIF (base 64 string)} -setup {
} -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 {
+test imgPhoto-20.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 {
+test imgPhoto-20.4 {Reject truncated GIF (binary string)} -setup {
+ set data [binary decode base64 {
R0lGODlhEAAQAMIHAAAAADMz//8zM/8z/zP/MzP///8=
}]
} -body {
@@ -1993,7 +1982,7 @@ test imgPhoto-18.4 {Reject truncated GIF (binary string)} -constraints {
} -cleanup {
catch {image delete gif1}
} -returnCodes error -result {error reading color map}
-test imgPhoto-18.5 {Reject truncated GIF (base 64 string)} -setup {
+test imgPhoto-20.5 {Reject truncated GIF (base 64 string)} -setup {
set data {
R0lGODlhEAAQAMIHAAAAADMz//8zM/8z/zP/MzP///8=
}
@@ -2002,22 +1991,21 @@ test imgPhoto-18.5 {Reject truncated GIF (base 64 string)} -setup {
} -cleanup {
catch {image delete gif1}
} -returnCodes error -result {error reading color map}
-test imgPhoto-18.6 {Reject truncated GIF (file)} -setup {
+test imgPhoto-20.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
+test imgPhoto-20.7 {Reject corrupted GIF (> 4Gb) (binary 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.
- package require base64
- set data [base64::decode {
+ set data [binary decode base64 {
R0lGODlhwmYz//8zM/8z/zP/MzP/////M////yH5Ciwhe
LrcLTBCd6Tv2qW16tdK4jhV5qpraXIvM1JlNyAgOw==
}]
@@ -2026,7 +2014,7 @@ test imgPhoto-18.7 {Reject corrupted GIF (> 4Gb) (binary string)} -constraints {
} -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 {
+test imgPhoto-20.8 {Reject corrupted GIF (> 4Gb) (base 64 string)} -constraints {
nonPortable
} -setup {
# About the non portability constraint of this test: see ticket [cc42cc18a5]
@@ -2042,7 +2030,7 @@ test imgPhoto-18.8 {Reject corrupted GIF (> 4Gb) (base 64 string)} -constraints
} -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 {
+test imgPhoto-20.9 {Reject corrupted GIF (> 4Gb) (file)} -constraints {
nonPortable
} -setup {
# About the non portability constraint of this test: see ticket [cc42cc18a5]
@@ -2055,14 +2043,11 @@ test imgPhoto-18.9 {Reject corrupted GIF (> 4Gb) (file)} -constraints {
} -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 imgPhoto-20.10 {Valid GIF (binary string)} -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 {
+ # Tests 20.11, 20.12, with matching data, are included for completeness.
+ set data [binary decode base64 {
R0lGODlhEAAQAMIHAAAAADMz//8zM/8z/zP/MzP/////M////yH5BAEKAAcALAAA
AAAQABAAAAMheLrcLTBCd6QV79qlterXB0riOFXmmapraXIvM1IdZTcJADs=
}]
@@ -2071,7 +2056,7 @@ test imgPhoto-18.10 {Valid GIF (binary string)} -constraints {
} -cleanup {
catch {image delete gif1}
} -result gif1
-test imgPhoto-18.11 {Valid GIF (base 64 string)} -setup {
+test imgPhoto-20.11 {Valid GIF (base 64 string)} -setup {
set data {
R0lGODlhEAAQAMIHAAAAADMz//8zM/8z/zP/MzP/////M////yH5BAEKAAcALAAA
AAAQABAAAAMheLrcLTBCd6QV79qlterXB0riOFXmmapraXIvM1IdZTcJADs=
@@ -2081,7 +2066,7 @@ test imgPhoto-18.11 {Valid GIF (base 64 string)} -setup {
} -cleanup {
catch {image delete gif1}
} -result gif1
-test imgPhoto-18.12 {Valid GIF (file)} -setup {
+test imgPhoto-20.12 {Valid GIF (file)} -setup {
set fileName [file join [file dirname [info script]] red.gif]
} -body {
image create photo gif1 -file $fileName
generated by cgit v0.12 at 2024-11-10 12:50:13 (GMT)