update tkimg 1.4.7

1 files changed, 78 insertions, 0 deletions

diff --git a/tkimg/tests/xpm.test b/tkimg/tests/xpm.test
new file mode 100644
index 0000000..a05b0cb
--- /dev/null
+++ b/tkimg/tests/xpm.test
@@ -0,0 +1,78 @@
+# This file is a Tcl script to test out XPM reading and writing.
+# It is organized in the standard fashion for Tcl tests.
+
+package require Tk
+
+package require tcltest
+tcltest::configure {*}$argv
+source [file join [file dirname [info script]] constraints.tcl]
+
+package require Img
+
+imageInit
+
+namespace eval ::xpm::test {
+    namespace import ::tcltest::*
+
+    set fmt  "xpm"
+    set ext  "xpm"
+    set file "testimgs/img.$ext"
+
+    # Encoded image content.
+    source $file.base64
+
+    test xpm-1.1 {} -setup {
+        catch {image delete i}
+    } -body {
+        image create photo i -file $file
+        i data -format $fmt
+    } -cleanup {
+        image delete i
+    } -result $imgdata
+
+    test xpm-1.2 {} -setup {
+        catch {image delete i}
+    } -body {
+        image create photo i -data $imgdata
+        i data -format $fmt
+    } -cleanup {
+        image delete i
+    } -result $imgdata
+
+    test xpm-1.3 {} -setup {
+        catch {image delete i}
+    } -body {
+        image create photo i
+        i put $imgdata
+        i data -format $fmt
+    } -cleanup {
+        image delete i
+    } -result $imgdata
+
+    test xpm-1.4 {} -setup {
+        catch {image delete i}
+    } -body {
+        image create photo i
+        i put $imgdata -format $fmt
+        i data -format $fmt
+    } -cleanup {
+        image delete i
+    } -result $imgdata
+
+
+    test xpm-2.0 {Binary I/O with XPM images} -setup {
+        catch {image delete i}
+    } -body {
+        image create photo i
+        set f [open $file r]
+        fconfigure $f -translation binary
+        set return [catch {i put [read $f]} msg]
+        close $f
+        lappend return $msg
+    } -cleanup {
+        image delete i
+    } -result {0 {}}
+}
+
+imageFinish
+namespace delete ::xpm::test