diff tests/automated/base64-tests.el @ 414:da8ed4261e83 r21-2-15

Import from CVS: tag r21-2-15
author cvs
date Mon, 13 Aug 2007 11:21:38 +0200
parents
children ebe98a74bd68
line wrap: on
line diff
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/tests/automated/base64-tests.el	Mon Aug 13 11:21:38 2007 +0200
@@ -0,0 +1,271 @@
+;; 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"
+     "QUJDREVGR0hJSktMTU5PUFFSU1RVVldYWVphYmNkZWZnaGlqa2xtbm9wcXJzdHV2d3h5ejAxMjM0
+NTY3ODk=")
+    (,bt-allchars
+     "AAECAwQFBgcICQoLDA0ODxAREhMUFRYXGBkaGxwdHh8gISIjJCUmJygpKissLS4vMDEyMzQ1Njc4
+OTo7PD0+P0BBQkNERUZHSElKS0xNTk9QUVJTVFVWV1hZWltcXV5fYGFiY2RlZmdoaWprbG1ub3Bx
+cnN0dXZ3eHl6e3x9fn+AgYKDhIWGh4iJiouMjY6PkJGSk5SVlpeYmZqbnJ2en6ChoqOkpaanqKmq
+q6ytrq+wsbKztLW2t7i5uru8vb6/wMHCw8TFxsfIycrLzM3Oz9DR0tPU1dbX2Nna29zd3t/g4eLj
+5OXm5+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" ,bt-allchars))
+  (Assert (eq (bt-base64-decode-string str) nil)))
+
+;; base64-decode-string is supposed to handle whitespaces anywhere in
+;; the string.  We test this in the cheesis manner possible, by
+;; inserting whitespaces at the beginning, at the end, in the middle
+;; of the string, and mixed.
+
+(defconst bt-whitespace-chars '(?\  ?\t ?\r ?\n ?\f ?\v))
+
+(loop for (raw encoded) in bt-test-strings do
+  ;; Whitespace at the beginning
+  (dolist (char bt-whitespace-chars)
+    ;; One char...
+    (let ((mangled (concat (list char) encoded)))
+      (Assert (equal (bt-base64-decode-string mangled) raw))))
+  ;; ...all chars.
+  (let ((mangled (concat bt-whitespace-chars encoded)))
+    (Assert (equal (bt-base64-decode-string mangled) raw)))
+
+  ;; Whitespace at the end
+  (dolist (char bt-whitespace-chars)
+    ;; One char...
+    (let ((mangled (concat encoded (list char))))
+      (Assert (equal (bt-base64-decode-string mangled) raw))))
+  ;; ...all chars.
+  (let ((mangled (concat encoded bt-whitespace-chars)))
+    (Assert (equal (bt-base64-decode-string mangled) raw)))
+
+  (unless (equal raw "")
+    ;; Whitespace in the middle
+    (let* ((middlepos (/ (1+ (length encoded)) 2))
+	   (left (substring encoded 0 middlepos))
+	   (right (substring encoded middlepos)))
+      (dolist (char bt-whitespace-chars)
+	;; One char...
+	(let ((mangled (concat left (list char) right)))
+	  (Assert (equal (bt-base64-decode-string mangled) raw))))
+      ;; ...all chars.
+      (let ((mangled (concat left bt-whitespace-chars right)))
+	(Assert (equal (bt-base64-decode-string mangled) raw)))
+
+      ;; Whitespace at the beginning, end, and middle.
+      (dolist (char bt-whitespace-chars)
+	;; One char...
+	(let ((mangled (concat (list char) left (list char) right (list char))))
+	  (Assert (equal (bt-base64-decode-string mangled) raw))))
+      ;; ...all chars.
+      (let ((mangled (concat bt-whitespace-chars left bt-whitespace-chars right
+			     bt-whitespace-chars)))
+	(Assert (equal (bt-base64-decode-string mangled) raw)))
+
+      ;; Whitespace between every char.
+      (dolist (char bt-whitespace-chars)
+	;; One char...
+	(let ((mangled (concat (list char)
+			       ;; ENCODED with char between every character.
+			       (mapconcat #'char-to-string encoded
+					  (char-to-string char))
+			       (list char))))
+	  (Assert (equal (bt-base64-decode-string mangled) raw))))
+      ;; ...all chars.
+      (let ((mangled (concat bt-whitespace-chars
+			     ;; ENCODED with bt-whitespace-chars
+			     ;; between every character.
+			     (mapconcat #'char-to-string encoded
+					(apply #'string bt-whitespace-chars))
+			     bt-whitespace-chars)))
+	  (Assert (equal (bt-base64-decode-string mangled) raw))))))
+
+;;-----------------------------------------------------
+;; Mixed...
+;;-----------------------------------------------------
+
+;; The crux of the whole base64 business is to ensure that
+;; (base64-decode-string (base64-decode-string FOO)) equals FOO.  The
+;; following stunts stress-test practically all aspects of the
+;; encoding and decoding process.
+
+(loop for (string1 ignored) in bt-test-strings do
+  (Assert (equal (bt-base64-decode-string
+		  (bt-base64-encode-string string1))
+		 string1))
+  (Assert (equal (bt-base64-decode-string
+		  (bt-base64-decode-string
+		   (bt-base64-encode-string
+		    (bt-base64-encode-string string1))))
+		 string1))
+  (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 string1))))))
+		 string1))
+  (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 string1))))))))
+		 string1))
+  (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 string1))))))))))
+		 string1)))