Merge commit '60d692811c12788ed4468d5ff680633304e8f641' as 'tkimg'

3 files changed, 97 insertions, 0 deletions

diff --git a/tkimg/jpeg/tests/all.tcl b/tkimg/jpeg/tests/all.tcl
new file mode 100755
index 0000000..7010d2d
--- /dev/null
+++ b/tkimg/jpeg/tests/all.tcl
@@ -0,0 +1,24 @@
+# all.tcl -- -*- tcl -*-

+#

+# Import common functionality, then run the tests in this directory.

+#

+# Copyright (c) 2002         Andreas Kupries <andreas_kupries@users.sourceforge.net>

+# All rights reserved.

+#

+# RCS: @(#) $Id: all.tcl 224 2009-07-27 08:47:46Z nijtmans $

+

+set _pwd  [pwd]

+cd  [file dirname [file join [pwd] [info script]]]

+set _here [pwd]

+cd $_pwd

+source [file join [file dirname [file dirname $_here]] tests all.tcl]

+unset _pwd _here

+

+set ::tcltest::testSingleFile false

+set ::tcltest::testsDirectory [file dirname [info script]]

+

+# We need to ensure that the testsDirectory is absolute

+::tcltest::normalizePath ::tcltest::testsDirectory

+

+run_tests

+exit

diff --git a/tkimg/jpeg/tests/folder.jpg b/tkimg/jpeg/tests/folder.jpg
new file mode 100755
index 0000000..87a0a38
--- /dev/null
+++ b/tkimg/jpeg/tests/folder.jpg
diff --git a/tkimg/jpeg/tests/jpeg.test b/tkimg/jpeg/tests/jpeg.test
new file mode 100755
index 0000000..874ad8d
--- /dev/null
+++ b/tkimg/jpeg/tests/jpeg.test
@@ -0,0 +1,73 @@
+# This file is a Tcl script to test out GIF reading and writing.

+# It is organized in the standard fashion for Tcl tests.

+#

+

+puts "img::jpeg [package require img::jpeg]"

+

+set jpegdata \

+{/9j/4AAQSkZJRgABAQAAAQABAAD/2wBDAAgGBgcGBQgHBwcJCQgKDBQNDAsLDBkSEw8UHRof

+Hh0aHBwgJC4nICIsIxwcKDcpLDAxNDQ0Hyc5PTgyPC4zNDL/2wBDAQkJCQwLDBgNDRgyIRwh

+MjIyMjIyMjIyMjIyMjIyMjIyMjIyMjIyMjIyMjIyMjIyMjIyMjIyMjIyMjIyMjIyMjL/wAAR

+CAAMABADASIAAhEBAxEB/8QAHwAAAQUBAQEBAQEAAAAAAAAAAAECAwQFBgcICQoL/8QAtRAA

+AgEDAwIEAwUFBAQAAAF9AQIDAAQRBRIhMUEGE1FhByJxFDKBkaEII0KxwRVS0fAkM2JyggkK

+FhcYGRolJicoKSo0NTY3ODk6Q0RFRkdISUpTVFVWV1hZWmNkZWZnaGlqc3R1dnd4eXqDhIWG

+h4iJipKTlJWWl5iZmqKjpKWmp6ipqrKztLW2t7i5usLDxMXGx8jJytLT1NXW19jZ2uHi4+Tl

+5ufo6erx8vP09fb3+Pn6/8QAHwEAAwEBAQEBAQEBAQAAAAAAAAECAwQFBgcICQoL/8QAtREA

+AgECBAQDBAcFBAQAAQJ3AAECAxEEBSExBhJBUQdhcRMiMoEIFEKRobHBCSMzUvAVYnLRChYk

+NOEl8RcYGRomJygpKjU2Nzg5OkNERUZHSElKU1RVVldYWVpjZGVmZ2hpanN0dXZ3eHl6goOE

+hYaHiImKkpOUlZaXmJmaoqOkpaanqKmqsrO0tba3uLm6wsPExcbHyMnK0tPU1dbX2Nna4uPk

+5ebn6Onq8vP09fb3+Pn6/9oADAMBAAIRAxEAPwDpdJ8Naj4g0ay1q9uNDnu763S5E0+kyPNA

+HUMqRyC4BQJnClNpyN33iWOxaHWtN1ux0vU9QtL9J7GaXzorNoJN8TQrlv3jKc+aScAcjj0r

+xTTvjd4l0fSbHTYLLSXitbaOGN5IZCxVVAGcSAZwPSuw+Hnj7VfHfjgDU4LOH7Hps5j+yoy5

+3SQZzuZv7g6Y71wUKeK9t7z913/rYLo//9k=}

+

+set jpegdata2 \

+{/9j/4AAQSkZJRgABAQAAAQABAAD/2wBDAAgGBgcGBQgHBwcJCQgKDBQNDAsLDBkSEw8UHRof

+Hh0aHBwgJC4nICIsIxwcKDcpLDAxNDQ0Hyc5PTgyPC4zNDL/2wBDAQkJCQwLDBgNDRgyIRwh

+MjIyMjIyMjIyMjIyMjIyMjIyMjIyMjIyMjIyMjIyMjIyMjIyMjIyMjIyMjIyMjIyMjL/wAAR

+CAAMABADASIAAhEBAxEB/8QAHwAAAQUBAQEBAQEAAAAAAAAAAAECAwQFBgcICQoL/8QAtRAA

+AgEDAwIEAwUFBAQAAAF9AQIDAAQRBRIhMUEGE1FhByJxFDKBkaEII0KxwRVS0fAkM2JyggkK

+FhcYGRolJicoKSo0NTY3ODk6Q0RFRkdISUpTVFVWV1hZWmNkZWZnaGlqc3R1dnd4eXqDhIWG

+h4iJipKTlJWWl5iZmqKjpKWmp6ipqrKztLW2t7i5usLDxMXGx8jJytLT1NXW19jZ2uHi4+Tl

+5ufo6erx8vP09fb3+Pn6/8QAHwEAAwEBAQEBAQEBAQAAAAAAAAECAwQFBgcICQoL/8QAtREA

+AgECBAQDBAcFBAQAAQJ3AAECAxEEBSExBhJBUQdhcRMiMoEIFEKRobHBCSMzUvAVYnLRChYk

+NOEl8RcYGRomJygpKjU2Nzg5OkNERUZHSElKU1RVVldYWVpjZGVmZ2hpanN0dXZ3eHl6goOE

+hYaHiImKkpOUlZaXmJmaoqOkpaanqKmqsrO0tba3uLm6wsPExcbHyMnK0tPU1dbX2Nna4uPk

+5ebn6Onq8vP09fb3+Pn6/9oADAMBAAIRAxEAPwDpdJ8Nah4g0ay1q9n0Se7vrdLkTT6VI80A

+dQypHILgFAmcKU2nI3feJY7Foda07WrHS9T1C0v0nsZpfOis2gk3xNCuW/eMpz5pJwByOPSv

+FdP+NviXR9KsNNgstJeK2to4UeSKQttVQBnEgGcD0rsPh3481Xx343I1OCzh+xadcGP7KjLn

+dJBnO5m/uDpjvXFRhinW95+67/1sF0f/2Q==}

+

+test jpeg-1.1 {} {

+    catch {image delete i}

+    image create photo i -file [file join $tcltest::testsDirectory folder.jpg]

+    i data -format jpeg

+} $jpegdata

+test jpeg-1.2 {} {

+    image delete i

+    image create photo i -data $jpegdata

+    set data [i data -format jpeg]

+} $jpegdata2

+test jpeg-1.3 {} {

+    i blank

+    i put $jpegdata

+    set data [i data -format jpeg]

+} $jpegdata2

+test jpeg-1.4 {} {

+    i blank

+    i put $jpegdata -format jpeg

+    set data [i data -format jpeg]

+} $jpegdata2

+

+if {[info tclversion] < 8.0} {

+    return

+}

+

+test jpeg-2.0 {Binary I/O with JPEG images} {

+    i blank

+    set f [open [file join $tcltest::testsDirectory folder.jpg] r]

+    fconfigure $f -translation binary

+    set return [catch {i put [read $f]} msg]

+    close $f

+    lappend return $msg

+} {0 {}}