TIP 529 image metadata: make gif comment parsing work and start with tests. Also eliminate the base64 from the tests.

1 files changed, 116 insertions, 26 deletions

diff --git a/tests/imgPhoto.test b/tests/imgPhoto.test
index 5fc86bd..13070e2 100644
--- a/tests/imgPhoto.test
+++ b/tests/imgPhoto.test
@@ -57,6 +57,8 @@
 # Tk_PhotoPutBlock_Panic                no tests, probably none needed
 # Tk_PhotoPutZoomedBlock_Panic          no tests, probably none needed
 # Tk_PhotoSetSize_Panic                 no tests, probably none needed
+# Tk_PhotoGetMetadata:                  imgPhoto-19.*
+# Tk_PhotoSetMetadata:                  imgPhoto-20.*
 #--------------------------------------------------------------------------
 #
 
@@ -130,14 +132,6 @@ testConstraint hasTeapotPhoto [file exists $teapotPhotoFile]
 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
     list [photo1 cget -width] [photo1 cget -height] \
@@ -202,6 +196,9 @@ test imgPhoto-1.13 {option -withalpha, normal use} -setup {
 } -cleanup {
     imageCleanup
 } -result {0 128 0 255}
+test imgPhoto-1.14 {options for photo images - error case} -body {
+    image create photo photo1 -metadata
+} -returnCodes error -result {value for "-metadata" missing}
 
 test imgPhoto-2.1 {ImgPhotoCreate procedure} -setup {
     imageCleanup
@@ -1951,11 +1948,8 @@ test imgPhoto-19.8 {MatchStirngFormat: invalid data for gif} -setup {
 # 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 {
+test imgPhoto-18.1 {Reject corrupted GIF (binary string)} -setup {
+    set data [binary decode base64 {
 	R0lGODlhAAQABP8zM/8z/zP/MzP/////M////yH5CiwheLrcLTBCd6Tv2qW16tdK4jhV
 	5qpraXIvM1JlNyAgOw==
     }]
@@ -1981,11 +1975,8 @@ test imgPhoto-18.3 {Reject corrupted GIF (file)} -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.4 {Reject truncated GIF (binary string)} -constraints {
-    base64PackageNeeded
-} -setup {
-    package require base64
-    set data [base64::decode {
+test imgPhoto-18.4 {Reject truncated GIF (binary string)} -setup {
+    set data [binary decode base64 {
 	R0lGODlhEAAQAMIHAAAAADMz//8zM/8z/zP/MzP///8=
     }]
 } -body {
@@ -2010,14 +2001,13 @@ test imgPhoto-18.6 {Reject truncated GIF (file)} -setup {
     catch {image delete gif1}
 } -returnCodes error -result {error reading color map}
 test imgPhoto-18.7 {Reject corrupted GIF (> 4Gb) (binary string)} -constraints {
-    base64PackageNeeded nonPortable
+    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==
     }]
@@ -2055,14 +2045,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-18.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 {
+    set data [binary decode base64 {
 	R0lGODlhEAAQAMIHAAAAADMz//8zM/8z/zP/MzP/////M////yH5BAEKAAcALAAA
 	AAAQABAAAAMheLrcLTBCd6QV79qlterXB0riOFXmmapraXIvM1IdZTcJADs=
     }]
@@ -2089,6 +2076,109 @@ test imgPhoto-18.12 {Valid GIF (file)} -setup {
     catch {image delete gif1}
 } -result gif1
 
+# imgPhoto-21.x : Tk_PhotoGetMetadata
+
+test imgPhoto-21.1 {option -metadata, get configure list} -setup {
+    image create photo photo1 -metadata {dpi 100}
+} -body {
+    photo1 configure -metadata
+} -cleanup {
+    catch {image delete photo1}
+} -result {-metadata {} {} {} {dpi 100}}
+
+test imgPhoto-21.2 {option -metadata, get value} -setup {
+    image create photo photo1 -metadata {dpi 100}
+} -body {
+    photo1 cget -metadata
+} -cleanup {
+    catch {image delete photo1}
+} -result {dpi 100}
+
+test imgPhoto-21.3 {option -metadata, get default value} -setup {
+    image create photo photo1
+} -body {
+    photo1 cget -metadata
+} -cleanup {
+    catch {image delete photo1}
+} -result {}
+
+# imgPhoto-22.x : Tk_PhotoSetMetadata
+
+test imgPhoto-22.1 {option -metadata, set value} -setup {
+    image create photo photo1
+} -body {
+    photo1 configure -metadata {dpi 100}
+    photo1 cget -metadata
+} -cleanup {
+    catch {image delete photo1}
+} -result {dpi 100}
+
+test imgPhoto-22.2 {option -metadata, change value} -setup {
+    image create photo photo1 -metadata {dpi 200}
+} -body {
+    photo1 configure -metadata {dpi 100}
+    photo1 cget -metadata
+} -cleanup {
+    catch {image delete photo1}
+} -result {dpi 100}
+
+test imgPhoto-22.3 {option -metadata, clear value} -setup {
+    image create photo photo1 -metadata {dpi 200}
+} -body {
+    photo1 configure -metadata {}
+    photo1 cget -metadata
+} -cleanup {
+    catch {image delete photo1}
+} -result {}
+
+# 23.x GIF images with metadata
+
+# The following gif prefix data is used by the following data.
+# The trailer \x3b is missing
+# N.B. this is the same image as test imgPhoto-18.10
+
+# size 16x16, global color table size: 8
+set gifstart "GIF89a\x10\x00\x10\x00\xc2\x07\x00"
+# color table
+append gifstart "\x00\x00\x00\x33\x33\xff\xff\x33\x33\xff\x33\xff\x33\xff\x33\x33\xff\xff\xff\xff\x33\xff\xff\xff"
+# Graphic control extension: Transparent color index: 7 (not needed here)
+# append gifdata "\x21\xf9\x04\x01\x0a\x00\x07\x00"
+# Image descriptor: 16x16, no local color table
+set gifdata "\x2c\x00\x00\x00\x00\x10\x00\x10\x00\x00"
+# Image data
+append gifdata "\x03\x21\x78\xba\xdc\x2d\x30\x42\x77\xa4\x15\xef\xda\xa5\xb5\xea\xd7\x07\x4a\xe2\x38\x55\xe6\x99\xaa\x6b\x69\x72\x2f\x33\x52\x1d\x65\x37\x09\x00"
+set gifend "\x3b"
+
+test imgPhoto-23.1 {GIF comment before image data} -setup {
+    set data $::gifstart
+	# Append a comment extension block with data "ABCD"
+	append data "\x21\xfe\x04" "ABCD" "\x0"
+	# Trailer
+	append data $::gifdata $::gifend
+} -body {
+    image create photo gif1 -data $data
+	gif1 cget -metadata
+} -cleanup {
+    catch {image delete gif1}
+} -result {Comment ABCD}
+
+test imgPhoto-23.2 {GIF comment after image data} -setup {
+    set data $::gifstart
+	append data $::gifdata
+	# Append a comment extension block with data "ABCD"
+	append data "\x21\xfe\x04" "ABCD" "\x0"
+	# Trailer
+	append data $::gifend
+} -body {
+    image create photo gif1 -data $data
+	gif1 cget -metadata
+} -cleanup {
+    catch {image delete gif1}
+} -result {Comment ABCD}
+
+unset -nocomplain gifstart gifdata gifend
+
+
 catch {rename foreachPixel {}}
 catch {rename checkImgTrans {}}
 catch {rename checkImgTransLoop {}}