Add third-party XML processing libraries.

Ignore-this: 5ca28497555bf944858ca2f58bc8a62b

darcs-hash:a0b0f9baa7c9b1259e755435db1fb17123630a6c

3 files changed, 156 insertions, 0 deletions

diff --git a/third-party/s-base64/test/all-tests.lisp b/third-party/s-base64/test/all-tests.lisp
new file mode 100644
index 0000000..ad2fdec
--- /dev/null
+++ b/third-party/s-base64/test/all-tests.lisp
@@ -0,0 +1,15 @@
+;;;; -*- mode: lisp -*-
+;;;;
+;;;; $Id: all-tests.lisp,v 1.2 2004/06/17 19:43:11 rschlatte Exp $
+;;;;
+;;;; Load and execute all unit and functional tests
+;;;;
+;;;; Copyright (C) 2002-2005 Sven Van Caekenberghe, Beta Nine BVBA.
+;;;;
+;;;; You are granted the rights to distribute and use this software
+;;;; as governed by the terms of the Lisp Lesser General Public License
+;;;; (http://opensource.franz.com/preamble.html), also known as the LLGPL.
+
+(load (merge-pathnames "test-base64" *load-pathname*) :verbose t)
+
+;;;; eof
diff --git a/third-party/s-base64/test/test-base64.lisp b/third-party/s-base64/test/test-base64.lisp
new file mode 100644
index 0000000..ae5b50f
--- /dev/null
+++ b/third-party/s-base64/test/test-base64.lisp
@@ -0,0 +1,140 @@
+;;;; -*- mode: lisp -*-
+;;;;
+;;;; $Id: test-base64.lisp,v 1.1.1.1 2004/06/09 09:02:41 scaekenberghe Exp $
+;;;;
+;;;; Unit and functional tests for base64.lisp
+;;;;
+;;;; Copyright (C) 2002-2005 Sven Van Caekenberghe, Beta Nine BVBA.
+;;;;
+;;;; You are granted the rights to distribute and use this software
+;;;; as governed by the terms of the Lisp Lesser General Public License
+;;;; (http://opensource.franz.com/preamble.html), also known as the LLGPL.
+
+(in-package :s-base64)
+
+(assert 
+ (equal (multiple-value-list (core-encode-base64 0 0 0))
+	(list #\A #\A #\A #\A)))
+
+(assert 
+ (equal (multiple-value-list (core-encode-base64 255 255 255))
+	(list #\/ #\/ #\/ #\/)))
+
+(assert 
+ (equal (multiple-value-list (core-encode-base64 1 2 3))
+	(list #\A #\Q #\I #\D)))
+
+(assert 
+ (equal (multiple-value-list (core-encode-base64 10 20 30))
+	(list #\C #\h #\Q #\e)))
+
+(assert
+ (equal (multiple-value-list (core-decode-base64 #\A #\A #\A #\A))
+	(list 0 0 0)))
+
+(assert
+ (equal (multiple-value-list (core-decode-base64 #\/ #\/ #\/ #\/))
+	(list 255 255 255)))
+
+(assert
+ (equal (multiple-value-list (core-decode-base64 #\A #\Q #\I #\D))
+	(list 1 2 3)))
+
+(assert
+ (equal (multiple-value-list (core-decode-base64 #\C #\h #\Q #\e))
+	(list 10 20 30)))
+
+(assert
+ (let* ((string "Hello World!")
+	(bytes (map 'vector #'char-code string))
+	encoded
+	decoded)
+   (setf encoded (with-output-to-string (out)
+		   (encode-base64-bytes bytes out)))
+   (setf decoded (with-input-from-string (in encoded)
+		   (decode-base64-bytes in)))
+   (equal string
+	  (map 'string #'code-char decoded))))
+
+;;; test some known values (from RFC 3548, section 7)
+
+(assert
+    (string= (with-output-to-string (out) 
+               (encode-base64-bytes #(#x14 #xfb #x9c #x03 #xd9 #x7e) out))
+             "FPucA9l+"))
+
+(assert 
+    (string= (with-output-to-string (out) 
+               (encode-base64-bytes #(#x14 #xfb #x9c #x03 #xd9) out))
+             "FPucA9k="))
+
+(assert 
+    (string= (with-output-to-string (out) 
+               (encode-base64-bytes #(#x14 #xfb #x9c #x03) out))
+             "FPucAw=="))
+
+;;; this is more of a functional test
+
+(defun same-character-file (file1 file2)
+  (with-open-file (a file1 :direction :input)
+    (with-open-file (b file2 :direction :input)
+      (loop
+       (let ((char-a (read-char a nil nil nil))
+	     (char-b (read-char b nil nil nil)))
+	 (cond ((not (or (and (null char-a) (null char-b))
+			 (and char-a char-b)))
+		(return-from same-character-file nil))     
+	       ((null char-a)
+		(return-from same-character-file t))
+	       ((char/= char-a char-b)
+		(return-from same-character-file nil))))))))
+
+(defun same-binary-file (file1 file2)
+  (with-open-file (a file1 :direction :input :element-type 'unsigned-byte)
+    (with-open-file (b file2 :direction :input :element-type 'unsigned-byte)
+      (loop
+       (let ((byte-a (read-byte a nil nil))
+	     (byte-b (read-byte b nil nil)))
+	 (cond ((not (or (and (null byte-a) (null byte-b))
+			 (and byte-a byte-b)))
+		(return-from same-binary-file nil))
+	       ((null byte-a)
+		(return-from same-binary-file t))
+	       ((/= byte-a byte-b)
+		(return-from same-binary-file nil))))))))
+
+(let ((original (merge-pathnames "test.b64" *load-pathname*))
+      (first-gif (merge-pathnames "test.gif" *load-pathname*))
+      (b64 (merge-pathnames "test2.b64" *load-pathname*))
+      (second-gif (merge-pathnames "test2.gif" *load-pathname*)))
+  (with-open-file (in original
+		      :direction :input)
+    (with-open-file (out first-gif
+			 :direction :output 
+			 :element-type 'unsigned-byte
+			 :if-does-not-exist :create
+			 :if-exists :supersede)
+      (decode-base64 in out)))
+  (with-open-file (in first-gif
+		      :direction :input
+		      :element-type 'unsigned-byte)
+    (with-open-file (out b64
+			 :direction :output
+			 :if-does-not-exist :create
+			 :if-exists :supersede)
+      (encode-base64 in out nil)))
+  (assert (same-character-file original b64))
+  (with-open-file (in b64
+		      :direction :input)
+    (with-open-file (out second-gif
+			 :direction :output 
+			 :element-type 'unsigned-byte
+			 :if-does-not-exist :create
+			 :if-exists :supersede)
+      (decode-base64 in out)))
+  (assert (same-binary-file first-gif second-gif))
+  (delete-file first-gif)
+  (delete-file b64)
+  (delete-file second-gif))
+
+;;;; eof
\ No newline at end of file
diff --git a/third-party/s-base64/test/test.b64 b/third-party/s-base64/test/test.b64
new file mode 100644
index 0000000..55445dd
--- /dev/null
+++ b/third-party/s-base64/test/test.b64
@@ -0,0 +1 @@
+R0lGODlhNABYAMQAAP////vi5etreuM0SN8ZL+dOYPCIk+56hPi/xPGapPjP1N4EGvHr9PSstMzI6riw4IY+kHsie3lvyVtMu0Y4tN3b8Y+CzX1ast2ftskNNNBdfqGb2so0WeHL4E8spLA0aiH5BAAAAAAALAAAAAA0AFgAQAX/ICCOZGmeaKqeBUEc5WAATbECQnCfyiAWsFIBgfMJFoTOYcAQERYN0SK4KxEUp4FPC/ABXN/oKOCtmh0OxGPj+UAgHmKhIZiZHJLJhMKXNKsMFQAMFnp6EogWFxEWOAsCgw4VfyN5IhKNABMPZhAUe3yhoYiYFmsWiISYlCoMeaJ8ehR5hoektLCjEhCcJGgQqSkKC1BmxscBxEQkBAlOxSMDCzY/ZQAICyPEOwnbCgXgcyQCBeQFWCIHVDXhJN/hkMc0DR0iA80oPXbyI+Vd6CO+RdOxjAWVYz367bPXzciVHjKwGCAwg4AOfiUOEBgg4ICAe08WYCFgQ0aKBtaM/xWSEMuQKA+1WHrIhYpCJgB4KDzYA4BPFQejLAgdSvSB0QoOHgCT4GAEKqSfUuT8ZIHVCAYbWOaaQErSiqoYw4oVkWxBwRETt41RW2KBNWluq5QteCAbiQJxSRATQIDVRisLnJmQ5sLi2MNhP24cUIDxRcRjCAsG0HgHnbEaFRAwAURExxsJHh8jB2CJiQZBOALokHIEgXiqjQks3frcFyRdcKfzonGBaGMDxFzTIgDBMBd4GVN7sQSdAWpiuZQIsJHkCwNQqKOgCBmF2wZu5xj4XUL4MUJcMTlowmANhAgXhGoIIMA5NUKwQIWCcANNIkEMMPDBAWgUmAEGIgwDQ/97u2ByCQVNTdCIBRTssEEfVpUWjwgMpIHKTQCg0oQnguhhBgObPCBBLys4gIoEJVTA0gSCGIPUegBolV8tomwSVgUTiEBhehZsgMB6AZ4Q4JJLcjhIh1ntAeMITamw0ycSbDDJHx0aRdSLuPSIyQM1rnAEMcRc0R0/c7EADUppLgRAAoRtuE0ABvBF3lpmlTCMI9A5shkz1vB1G0AqtNkPEoWx9cwMGllRWEitmTCMSAlCw4ymAFxaz6KWOuqmnGuWaqqpHQTw6almbmSAAqoG8M0AB3XXA0mC/bWCbYjxNQ0JdHY6WQoJZDgaYymhJEICgaKQg1hXgDMYOuKooMD/hvJQx4BmlsYT7GyWGoZRcJRhm44z3HaaFzOD4mXeDglRVitlWMjgghYgJaCZuE8gWkW86ZJgxCOA0iBtp1royk8Zmi1UGAAT4WmSZwREYUClZhzQ7MX3MDqFri4kIK7BY12cxRW+4dNCuSaQNpYW74KHhALgbXawpQP4ixGzWoiD3UZ9HkAqCUKfysA9zx1AJznvrlkBmCuu10AGCFSgDg5Y0CFaIbLAAuIJF86CyAZGbWDKAxwcoEACFbzhgZEWwHEBV0H5oSNLX5eAipSkcDWBB3MjsocHeUhwwQdEoFgmABX4ZCJLrSylCwQfoFHB5RpwIAJ4BehIwQY49tTI/wMVArDTDu1JKRSL2GBBXdMkFNIE5JpMeQOKNYl9i+CFk9KLJIQ0gUpTURmTR+67J5/IA2iQQEhOthvjgH5crT7UUrZsMMIDNa04Vt9i75Ee+KNUiRF6sTDFIfU8toTIWUqm0PgmE5i/QpLyXGh/Ja/4AQHUsciFAGExEzGBhUOIMEF7JDfAUMykgFv5RB/CZ4sHGAsFeABFTJSXvCKFjlUgnA5cMBbCUPXpBBtCQB3yNCwa1OFqIkAADK5lgAOsygQdUMYJiPGWX5mgLo/BRmACooIcnpAZvjLPE2rVjVUxoGKiSoER4beysrQFU2TBohNgUBcSkmCK7piCAS62LlR12QUAC1hIC8aIHU6hAIzaGNYThtWNzbwGWGc04w0uVRAwhDGPufFhplqYnBUIMQB4WiKiREYMG2pjUJ0607A60MaJneBnJayCbjK5HR5y8pNiCQEAOw==
\ No newline at end of file