Merge commit '60d692811c12788ed4468d5ff680633304e8f641' as 'tkimg'

3 files changed, 82 insertions, 0 deletions

diff --git a/tkimg/sun/tests/all.tcl b/tkimg/sun/tests/all.tcl
new file mode 100755
index 0000000..7010d2d
--- /dev/null
+++ b/tkimg/sun/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/sun/tests/folder.ras b/tkimg/sun/tests/folder.ras
new file mode 100755
index 0000000..b94cde5
--- /dev/null
+++ b/tkimg/sun/tests/folder.ras
diff --git a/tkimg/sun/tests/sun.test b/tkimg/sun/tests/sun.test
new file mode 100755
index 0000000..a1ab4c8
--- /dev/null
+++ b/tkimg/sun/tests/sun.test
@@ -0,0 +1,58 @@
+# This file is a Tcl script to test out SUN reading and writing.

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

+#

+

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

+

+set sundata \

+{WaZqlQAAABAAAAAMAAAAIAAAAwAAAAACAAAAAAAAAAD/gALZ/4AC2f+AAtn/gAIA/4ACAP+A

+AgD/gAIA/4AC2f+AAtn/gALZ/4AC2f+AAtn/gALZ/4AC2f+AAtn/gALZ/4AC2f+AAtn/gAIA

+/4AA//D/gAD/8P+AAP/w/4AA//D/gAIA/4AC2f+AAtn/gALZ/4AC2f+AAtn/gALZ/4AC2f+A

+Atn/gALZ/4ACAP+AAP/w/4AA//D/gAD/8P+AAP/w/4AA//D/gAD/8P+AAgD/gALZ/4AC2f+A

+Atn/gALZ/4AC2f+AAtn/gALZ/4ACAP+AAgD/gAIA/4ACAP+AAgD/gAIA/4ACAP+AAgD/gAIA

+/4ACAP+AAgD/gAIA/4ACAP+AAtn/gALZ/4AC2f+AAgD/gAD/8P+AAP/w/4AA//D/gAD/8P+A

+AP/w/4AA//D/gAD/8P+AAP/w/4AA//D/gAD/8P+AAP/w/4ACAP+AAtn/gALZ/4AC2f+AAgD/

+gAD/8P+AAP/w/4AA//D/gAD/8P+AAP/w/4AA//D/gAD/8P+AAP/w/4AA//D/gAD/8P+AAP/w

+/4ACAP+AAtn/gALZ/4AC2f+AAgD/gAD/8P+AAP/w/4AA//D/gAD/8P+AAP/w/4AA//D/gAD/

+8P+AAP/w/4AA//D/gAD/8P+AAP/w/4ACAP+AAtn/gALZ/4AC2f+AAgD/gAD/8P+AAP/w/4AA

+//D/gAD/8P+AAP/w/4AA//D/gAD/8P+AAP/w/4AA//D/gAD/8P+AAP/w/4ACAP+AAtn/gALZ

+/4AC2f+AAgD/gAD/8P+AAP/w/4AA//D/gAD/8P+AAP/w/4AA//D/gAD/8P+AAP/w/4AA//D/

+gAD/8P+AAP/w/4ACAP+AAtn/gALZ/4AC2f+AAgD/gAD/8P+AAP/w/4AA//D/gAD/8P+AAP/w

+/4AA//D/gAD/8P+AAP/w/4AA//D/gAD/8P+AAP/w/4ACAP+AAtn/gALZ/4AC2f+AAgD/gAD/

+8P+AAP/w/4AA//D/gAD/8P+AAP/w/4AA//D/gAD/8P+AAP/w/4AA//D/gAD/8P+AAP/w/4AC

+AP+AAtn/gALZ/4AC2f+AAgD/gAIA/4ACAP+AAgD/gAIA/4ACAP+AAgD/gAIA/4ACAP+AAgD/

+gAIA/4ACAP+AAgD/gALZ/4AC2f+AAtk=}

+

+test sun-1.1 {} {

+    catch {image delete i}

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

+    i data -format sun

+} $sundata

+test sun-1.2 {} {

+    catch {image delete i}

+    image create photo i -data $sundata

+    set data [i data -format sun]

+} $sundata

+test sun-1.3 {} {

+    i blank

+    i put $data

+    set data [i data -format sun]

+} $sundata

+test sun-1.4 {} {

+    i blank

+    i put $data -format sun

+    set data [i data -format sun]

+} $sundata

+

+if {[info tclversion] < 8.0} {

+    return

+}

+

+test sun-2.0 {Binary I/O with SUN images} {

+    i blank

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

+    fconfigure $f -translation binary

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

+    close $f

+    lappend return $msg

+} {0 {}}