--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/tests/automated/base64-tests.el	Mon Aug 13 11:13:30 2007 +0200
@@ -0,0 +1,242 @@
+;; Copyright (C) 1999 Free Software Foundation, Inc.
+
+;; Author: Hrvoje Niksic <hniksic@srce.hr>
+;; Maintainer: Hrvoje Niksic <hniksic@srce.hr>
+;; Created: 1999
+;; Keywords: tests
+
+;; This file is part of XEmacs.
+
+;; XEmacs is free software; you can redistribute it and/or modify it
+;; under the terms of the GNU General Public License as published by
+;; the Free Software Foundation; either version 2, or (at your option)
+;; any later version.
+
+;; XEmacs is distributed in the hope that it will be useful, but
+;; WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+;; General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with XEmacs; see the file COPYING.  If not, write to the Free
+;; Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
+;; 02111-1307, USA.
+
+;;; Synched up with: Not in FSF.
+
+;;; Commentary:
+
+;; Test base64 functions.
+;; See test-harness.el for instructions on how to run these tests.
+
+(eval-when-compile
+  (condition-case nil
+      (require 'test-harness)
+    (file-error
+     (push "." load-path)
+     (when (and (boundp 'load-file-name) (stringp load-file-name))
+       (push (file-name-directory load-file-name) load-path))
+     (require 'test-harness))))
+
+;; We need to test the buffer and string functions.  We do it by
+;; testing them in various circumstances, asserting the same result,
+;; and returning that result.
+
+(defvar bt-test-buffer (get-buffer-create " *base64-workhorse*"))
+
+(defun bt-base64-encode-string (string &optional no-line-break)
+  (let ((string-result (base64-encode-string string no-line-break))
+	length)
+    (with-current-buffer bt-test-buffer
+      ;; the whole buffer
+      (erase-buffer)
+      (insert string)
+      (setq length (base64-encode-region (point-min) (point-max) no-line-break))
+      (Assert (eq length (- (point-max) (point-min))))
+      (Assert (equal (buffer-string) string-result))
+      ;; partial
+      (erase-buffer)
+      (insert "random junk........\0\0';'eqwrkw[erpqf")
+      (let ((p1 (point)) p2)
+	(insert string)
+	(setq p2 (point-marker))
+	(insert "...more random junk.q,f3/.qrm314.r,m2typ' 2436T@W$^@$#^T@")
+	(setq length (base64-encode-region p1 p2 no-line-break))
+	(Assert (eq length (- p2 p1)))
+	(Assert (equal (buffer-substring p1 p2) string-result))))
+    string-result))
+
+(defun bt-base64-decode-string (string)
+  (let ((string-result (base64-decode-string string))
+	length)
+    (with-current-buffer bt-test-buffer
+      ;; the whole buffer
+      (erase-buffer)
+      (insert string)
+      (setq length (base64-decode-region (point-min) (point-max)))
+      (cond (string-result
+	     (Assert (eq length (- (point-max) (point-min))))
+	     (Assert (equal (buffer-string) string-result)))
+	    (t
+	     (Assert (null length))
+	     ;; The buffer should not have been modified.
+	     (Assert (equal (buffer-string) string))))
+      ;; partial
+      (erase-buffer)
+      (insert "random junk........\0\0';'eqwrkw[erpqf")
+      (let ((p1 (point)) p2)
+	(insert string)
+	(setq p2 (point-marker))
+	(insert "...more random junk.q,f3/.qrm314.\0\0r,m2typ' 2436T@W$^@$#T@")
+	(setq length (base64-decode-region p1 p2))
+	(cond (string-result
+	       (Assert (eq length (- p2 p1)))
+	       (Assert (equal (buffer-substring p1 p2) string-result)))
+	      (t
+	       (Assert (null length))
+	       ;; The buffer should not have been modified.
+	       (Assert (equal (buffer-substring p1 p2) string))))))
+    string-result))
+
+(defun bt-remove-newlines (str)
+  (apply #'string (delete ?\n (mapcar #'identity str))))
+
+(defconst bt-allchars
+  (let ((str (make-string 256 ?\0)))
+    (dotimes (i 256)
+      (aset str i (int-char i)))
+    str))
+
+(defconst bt-test-strings
+  `(("" "")
+    ("foo" "Zm9v")
+    ("ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789"
+     "QUJDREVGR0hJSktMTU5PUFFSU1RVVldYWVphYmNkZWZnaGlqa2xtbm9wcXJzdHV2d3h5ejAx
+MjM0NTY3ODk=")
+    (,bt-allchars
+     "AAECAwQFBgcICQoLDA0ODxAREhMUFRYXGBkaGxwdHh8gISIjJCUmJygpKissLS4vMDEyMzQ1
+Njc4OTo7PD0+P0BBQkNERUZHSElKS0xNTk9QUVJTVFVWV1hZWltcXV5fYGFiY2RlZmdoaWpr
+bG1ub3BxcnN0dXZ3eHl6e3x9fn+AgYKDhIWGh4iJiouMjY6PkJGSk5SVlpeYmZqbnJ2en6Ch
+oqOkpaanqKmqq6ytrq+wsbKztLW2t7i5uru8vb6/wMHCw8TFxsfIycrLzM3Oz9DR0tPU1dbX
+2Nna29zd3t/g4eLj5OXm5+jp6uvs7e7v8PHy8/T19vf4+fr7/P3+/w==")
+    ))
+
+;;-----------------------------------------------------
+;; Encoding base64
+;;-----------------------------------------------------
+
+(loop for (raw encoded) in bt-test-strings do
+  (Assert (equal (bt-base64-encode-string raw) encoded))
+  ;; test the NO-LINE-BREAK flag
+  (Assert (equal (bt-base64-encode-string raw t) (bt-remove-newlines encoded))))
+
+;; When Mule is around, Lisp programmers should make sure that the
+;; buffer contains only characters whose `char-int' is in the [0, 256)
+;; range.  If this condition is not satisfied for any character, an
+;; error is signaled.
+(when (featurep 'mule)
+  ;; #### remove subtraction of 128 -- no longer needed with make-char
+  ;; patch!
+  (let* ((mule-string (format "Hrvoje Nik%ci%c"
+			      ;; scaron == 185 in Latin 2
+			      (make-char 'latin-iso8859-2 (- 185 128))
+			      ;; cacute == 230 in Latin 2
+			      (make-char 'latin-iso8859-2 (- 230 128)))))
+    (Check-Error-Message error "Non-ascii character in base64 input"
+      (bt-base64-encode-string mule-string))))
+
+;;-----------------------------------------------------
+;; Decoding base64
+;;-----------------------------------------------------
+
+(loop for (raw encoded) in bt-test-strings do
+  (Assert (equal (bt-base64-decode-string encoded) raw))
+  (Assert (equal (bt-base64-decode-string (bt-remove-newlines encoded)) raw)))
+
+;; Test errors
+(dolist (str `("foo" "AAC" "foo\0bar" "====" "Zm=9v" ,bt-allchars))
+  (Check-Error error (base64-decode-string str)))
+
+;; base64-decode-string should ignore non-base64 characters anywhere
+;; in the string.  We test this in the cheesiest manner possible, by
+;; inserting non-base64 chars at the beginning, at the end, and in the
+;; middle of the string.
+
+(defconst bt-base64-chars '(?A ?B ?C ?D ?E ?F ?G ?H ?I ?J
+			       ;; sometimes I hate Emacs indentation.
+			       ?K ?L ?M ?N ?O ?P ?Q ?R ?S ?T
+			       ?U ?V ?W ?X ?Y ?Z ?a ?b ?c ?d
+			       ?e ?f ?g ?h ?i ?j ?k ?l ?m ?n
+			       ?o ?p ?q ?r ?s ?t ?u ?v ?w ?x
+			       ?y ?z ?0 ?1 ?2 ?3 ?4 ?5 ?6 ?7
+			       ?8 ?9 ?+ ?/ ?=))
+
+(defconst bt-nonbase64-chars (set-difference (mapcar #'identity bt-allchars)
+					     bt-base64-chars))
+
+(loop for (raw encoded) in bt-test-strings do
+  (unless (equal raw "")
+    (let* ((middlepos (/ (1+ (length encoded)) 2))
+	   (left (substring encoded 0 middlepos))
+	   (right (substring encoded middlepos)))
+      ;; Whitespace at the beginning, end, and middle.
+      (let ((mangled (concat bt-nonbase64-chars left bt-nonbase64-chars right
+			     bt-nonbase64-chars)))
+	(Assert (equal (bt-base64-decode-string mangled) raw)))
+
+      ;; Whitespace between every char.
+      (let ((mangled (concat bt-nonbase64-chars
+			     ;; ENCODED with bt-nonbase64-chars
+			     ;; between every character.
+			     (mapconcat #'char-to-string encoded
+					(apply #'string bt-nonbase64-chars))
+			     bt-nonbase64-chars)))
+	(Assert (equal (bt-base64-decode-string mangled) raw))))))
+
+;;-----------------------------------------------------
+;; Mixed...
+;;-----------------------------------------------------
+
+;; The whole point of base64 is to ensure that an arbitrary sequence
+;; of bytes passes through gateway hellfire unscathed, protected by
+;; the asbestos suit of base64.  Here we test that
+;; (base64-decode-string (base64-decode-string FOO)) equals FOO for
+;; any FOO we can think of.  The following stunts stress-test
+;; practically all aspects of the encoding and decoding process.
+
+(loop for (raw ignored) in bt-test-strings do
+  (Assert (equal (bt-base64-decode-string
+		  (bt-base64-encode-string raw))
+		 raw))
+  (Assert (equal (bt-base64-decode-string
+		  (bt-base64-decode-string
+		   (bt-base64-encode-string
+		    (bt-base64-encode-string raw))))
+		 raw))
+  (Assert (equal (bt-base64-decode-string
+		  (bt-base64-decode-string
+		   (bt-base64-decode-string
+		    (bt-base64-encode-string
+		     (bt-base64-encode-string
+		      (bt-base64-encode-string raw))))))
+		 raw))
+  (Assert (equal (bt-base64-decode-string
+		  (bt-base64-decode-string
+		   (bt-base64-decode-string
+		    (bt-base64-decode-string
+		     (bt-base64-encode-string
+		      (bt-base64-encode-string
+		       (bt-base64-encode-string
+			(bt-base64-encode-string raw))))))))
+		 raw))
+  (Assert (equal (bt-base64-decode-string
+		  (bt-base64-decode-string
+		   (bt-base64-decode-string
+		    (bt-base64-decode-string
+		     (bt-base64-decode-string
+		      (bt-base64-encode-string
+		       (bt-base64-encode-string
+			(bt-base64-encode-string
+			 (bt-base64-encode-string
+			  (bt-base64-encode-string raw))))))))))
+		 raw)))