diff options
Diffstat (limited to 'third-party/s-xml-rpc/test/test-base64.lisp')
| -rw-r--r-- | third-party/s-xml-rpc/test/test-base64.lisp | 123 |
1 files changed, 123 insertions, 0 deletions
diff --git a/third-party/s-xml-rpc/test/test-base64.lisp b/third-party/s-xml-rpc/test/test-base64.lisp new file mode 100644 index 0000000..c263788 --- /dev/null +++ b/third-party/s-xml-rpc/test/test-base64.lisp @@ -0,0 +1,123 @@ +;;;; -*- 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, 2004 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)))) + +;;; 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 |