434
+ − 1 ;; Copyright (C) 1999 Free Software Foundation, Inc.
+ − 2
+ − 3 ;; Author: Hrvoje Niksic <hniksic@srce.hr>
+ − 4 ;; Maintainer: Hrvoje Niksic <hniksic@srce.hr>
+ − 5 ;; Created: 1999
+ − 6 ;; Keywords: tests
+ − 7
+ − 8 ;; This file is part of XEmacs.
+ − 9
+ − 10 ;; XEmacs is free software; you can redistribute it and/or modify it
+ − 11 ;; under the terms of the GNU General Public License as published by
+ − 12 ;; the Free Software Foundation; either version 2, or (at your option)
+ − 13 ;; any later version.
+ − 14
+ − 15 ;; XEmacs is distributed in the hope that it will be useful, but
+ − 16 ;; WITHOUT ANY WARRANTY; without even the implied warranty of
+ − 17 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+ − 18 ;; General Public License for more details.
+ − 19
+ − 20 ;; You should have received a copy of the GNU General Public License
+ − 21 ;; along with XEmacs; see the file COPYING. If not, write to the Free
+ − 22 ;; Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
+ − 23 ;; 02111-1307, USA.
+ − 24
+ − 25 ;;; Synched up with: Not in FSF.
+ − 26
+ − 27 ;;; Commentary:
+ − 28
+ − 29 ;; Test base64 functions.
+ − 30 ;; See test-harness.el for instructions on how to run these tests.
+ − 31
+ − 32 (eval-when-compile
+ − 33 (condition-case nil
+ − 34 (require 'test-harness)
+ − 35 (file-error
+ − 36 (push "." load-path)
+ − 37 (when (and (boundp 'load-file-name) (stringp load-file-name))
+ − 38 (push (file-name-directory load-file-name) load-path))
+ − 39 (require 'test-harness))))
+ − 40
+ − 41 ;; We need to test the buffer and string functions. We do it by
+ − 42 ;; testing them in various circumstances, asserting the same result,
+ − 43 ;; and returning that result.
+ − 44
+ − 45 (defvar bt-test-buffer (get-buffer-create " *base64-workhorse*"))
+ − 46
+ − 47 (defun bt-base64-encode-string (string &optional no-line-break)
+ − 48 (let ((string-result (base64-encode-string string no-line-break))
+ − 49 length)
+ − 50 (with-current-buffer bt-test-buffer
+ − 51 ;; the whole buffer
+ − 52 (erase-buffer)
+ − 53 (insert string)
+ − 54 (setq length (base64-encode-region (point-min) (point-max) no-line-break))
+ − 55 (Assert (eq length (- (point-max) (point-min))))
+ − 56 (Assert (equal (buffer-string) string-result))
+ − 57 ;; partial
+ − 58 (erase-buffer)
+ − 59 (insert "random junk........\0\0';'eqwrkw[erpqf")
+ − 60 (let ((p1 (point)) p2)
+ − 61 (insert string)
+ − 62 (setq p2 (point-marker))
+ − 63 (insert "...more random junk.q,f3/.qrm314.r,m2typ' 2436T@W$^@$#^T@")
+ − 64 (setq length (base64-encode-region p1 p2 no-line-break))
+ − 65 (Assert (eq length (- p2 p1)))
+ − 66 (Assert (equal (buffer-substring p1 p2) string-result))))
+ − 67 string-result))
+ − 68
+ − 69 (defun bt-base64-decode-string (string)
+ − 70 (let ((string-result (base64-decode-string string))
+ − 71 length)
+ − 72 (with-current-buffer bt-test-buffer
+ − 73 ;; the whole buffer
+ − 74 (erase-buffer)
+ − 75 (insert string)
+ − 76 (setq length (base64-decode-region (point-min) (point-max)))
+ − 77 (cond (string-result
+ − 78 (Assert (eq length (- (point-max) (point-min))))
+ − 79 (Assert (equal (buffer-string) string-result)))
+ − 80 (t
+ − 81 (Assert (null length))
+ − 82 ;; The buffer should not have been modified.
+ − 83 (Assert (equal (buffer-string) string))))
+ − 84 ;; partial
+ − 85 (erase-buffer)
+ − 86 (insert "random junk........\0\0';'eqwrkw[erpqf")
+ − 87 (let ((p1 (point)) p2)
+ − 88 (insert string)
+ − 89 (setq p2 (point-marker))
+ − 90 (insert "...more random junk.q,f3/.qrm314.\0\0r,m2typ' 2436T@W$^@$#T@")
+ − 91 (setq length (base64-decode-region p1 p2))
+ − 92 (cond (string-result
+ − 93 (Assert (eq length (- p2 p1)))
+ − 94 (Assert (equal (buffer-substring p1 p2) string-result)))
+ − 95 (t
+ − 96 (Assert (null length))
+ − 97 ;; The buffer should not have been modified.
+ − 98 (Assert (equal (buffer-substring p1 p2) string))))))
+ − 99 string-result))
+ − 100
+ − 101 (defun bt-remove-newlines (str)
+ − 102 (apply #'string (delete ?\n (mapcar #'identity str))))
+ − 103
+ − 104 (defconst bt-allchars
+ − 105 (let ((str (make-string 256 ?\0)))
+ − 106 (dotimes (i 256)
+ − 107 (aset str i (int-char i)))
+ − 108 str))
+ − 109
+ − 110 (defconst bt-test-strings
+ − 111 `(("" "")
+ − 112 ("foo" "Zm9v")
+ − 113 ("ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789"
+ − 114 "QUJDREVGR0hJSktMTU5PUFFSU1RVVldYWVphYmNkZWZnaGlqa2xtbm9wcXJzdHV2d3h5ejAx
+ − 115 MjM0NTY3ODk=")
+ − 116 (,bt-allchars
+ − 117 "AAECAwQFBgcICQoLDA0ODxAREhMUFRYXGBkaGxwdHh8gISIjJCUmJygpKissLS4vMDEyMzQ1
+ − 118 Njc4OTo7PD0+P0BBQkNERUZHSElKS0xNTk9QUVJTVFVWV1hZWltcXV5fYGFiY2RlZmdoaWpr
+ − 119 bG1ub3BxcnN0dXZ3eHl6e3x9fn+AgYKDhIWGh4iJiouMjY6PkJGSk5SVlpeYmZqbnJ2en6Ch
+ − 120 oqOkpaanqKmqq6ytrq+wsbKztLW2t7i5uru8vb6/wMHCw8TFxsfIycrLzM3Oz9DR0tPU1dbX
+ − 121 2Nna29zd3t/g4eLj5OXm5+jp6uvs7e7v8PHy8/T19vf4+fr7/P3+/w==")
+ − 122 ))
+ − 123
+ − 124 ;;-----------------------------------------------------
+ − 125 ;; Encoding base64
+ − 126 ;;-----------------------------------------------------
+ − 127
+ − 128 (loop for (raw encoded) in bt-test-strings do
+ − 129 (Assert (equal (bt-base64-encode-string raw) encoded))
+ − 130 ;; test the NO-LINE-BREAK flag
+ − 131 (Assert (equal (bt-base64-encode-string raw t) (bt-remove-newlines encoded))))
+ − 132
+ − 133 ;; When Mule is around, Lisp programmers should make sure that the
+ − 134 ;; buffer contains only characters whose `char-int' is in the [0, 256)
+ − 135 ;; range. If this condition is not satisfied for any character, an
+ − 136 ;; error is signaled.
+ − 137 (when (featurep 'mule)
+ − 138 ;; #### remove subtraction of 128 -- no longer needed with make-char
+ − 139 ;; patch!
+ − 140 (let* ((mule-string (format "Hrvoje Nik%ci%c"
+ − 141 ;; scaron == 185 in Latin 2
+ − 142 (make-char 'latin-iso8859-2 (- 185 128))
+ − 143 ;; cacute == 230 in Latin 2
+ − 144 (make-char 'latin-iso8859-2 (- 230 128)))))
+ − 145 (Check-Error-Message error "Non-ascii character in base64 input"
+ − 146 (bt-base64-encode-string mule-string))))
+ − 147
+ − 148 ;;-----------------------------------------------------
+ − 149 ;; Decoding base64
+ − 150 ;;-----------------------------------------------------
+ − 151
+ − 152 (loop for (raw encoded) in bt-test-strings do
+ − 153 (Assert (equal (bt-base64-decode-string encoded) raw))
+ − 154 (Assert (equal (bt-base64-decode-string (bt-remove-newlines encoded)) raw)))
+ − 155
+ − 156 ;; Test errors
+ − 157 (dolist (str `("foo" "AAC" "foo\0bar" "====" "Zm=9v" ,bt-allchars))
+ − 158 (Check-Error error (base64-decode-string str)))
+ − 159
+ − 160 ;; base64-decode-string should ignore non-base64 characters anywhere
+ − 161 ;; in the string. We test this in the cheesiest manner possible, by
+ − 162 ;; inserting non-base64 chars at the beginning, at the end, and in the
+ − 163 ;; middle of the string.
+ − 164
+ − 165 (defconst bt-base64-chars '(?A ?B ?C ?D ?E ?F ?G ?H ?I ?J
+ − 166 ;; sometimes I hate Emacs indentation.
+ − 167 ?K ?L ?M ?N ?O ?P ?Q ?R ?S ?T
+ − 168 ?U ?V ?W ?X ?Y ?Z ?a ?b ?c ?d
+ − 169 ?e ?f ?g ?h ?i ?j ?k ?l ?m ?n
+ − 170 ?o ?p ?q ?r ?s ?t ?u ?v ?w ?x
+ − 171 ?y ?z ?0 ?1 ?2 ?3 ?4 ?5 ?6 ?7
+ − 172 ?8 ?9 ?+ ?/ ?=))
+ − 173
+ − 174 (defconst bt-nonbase64-chars (set-difference (mapcar #'identity bt-allchars)
+ − 175 bt-base64-chars))
+ − 176
442
+ − 177 (loop for (raw encoded) in bt-test-strings do
+ − 178 (unless (equal raw "")
+ − 179 (let* ((middlepos (/ (1+ (length encoded)) 2))
+ − 180 (left (substring encoded 0 middlepos))
+ − 181 (right (substring encoded middlepos)))
+ − 182 ;; Whitespace at the beginning, end, and middle.
+ − 183 (let ((mangled (concat bt-nonbase64-chars left bt-nonbase64-chars right
+ − 184 bt-nonbase64-chars)))
+ − 185 (Assert (equal (bt-base64-decode-string mangled) raw)))
434
+ − 186
442
+ − 187 ;; Whitespace between every char.
+ − 188 (let ((mangled (concat bt-nonbase64-chars
+ − 189 ;; ENCODED with bt-nonbase64-chars
+ − 190 ;; between every character.
+ − 191 (mapconcat #'char-to-string encoded
+ − 192 (apply #'string bt-nonbase64-chars))
+ − 193 bt-nonbase64-chars)))
+ − 194 (Assert (equal (bt-base64-decode-string mangled) raw))))))
434
+ − 195
+ − 196 ;;-----------------------------------------------------
+ − 197 ;; Mixed...
+ − 198 ;;-----------------------------------------------------
+ − 199
+ − 200 ;; The whole point of base64 is to ensure that an arbitrary sequence
+ − 201 ;; of bytes passes through gateway hellfire unscathed, protected by
+ − 202 ;; the asbestos suit of base64. Here we test that
+ − 203 ;; (base64-decode-string (base64-decode-string FOO)) equals FOO for
+ − 204 ;; any FOO we can think of. The following stunts stress-test
+ − 205 ;; practically all aspects of the encoding and decoding process.
+ − 206
+ − 207 (loop for (raw ignored) in bt-test-strings do
+ − 208 (Assert (equal (bt-base64-decode-string
+ − 209 (bt-base64-encode-string raw))
+ − 210 raw))
+ − 211 (Assert (equal (bt-base64-decode-string
+ − 212 (bt-base64-decode-string
+ − 213 (bt-base64-encode-string
+ − 214 (bt-base64-encode-string raw))))
+ − 215 raw))
+ − 216 (Assert (equal (bt-base64-decode-string
+ − 217 (bt-base64-decode-string
+ − 218 (bt-base64-decode-string
+ − 219 (bt-base64-encode-string
+ − 220 (bt-base64-encode-string
+ − 221 (bt-base64-encode-string raw))))))
+ − 222 raw))
+ − 223 (Assert (equal (bt-base64-decode-string
+ − 224 (bt-base64-decode-string
+ − 225 (bt-base64-decode-string
+ − 226 (bt-base64-decode-string
+ − 227 (bt-base64-encode-string
+ − 228 (bt-base64-encode-string
+ − 229 (bt-base64-encode-string
+ − 230 (bt-base64-encode-string raw))))))))
+ − 231 raw))
+ − 232 (Assert (equal (bt-base64-decode-string
+ − 233 (bt-base64-decode-string
+ − 234 (bt-base64-decode-string
+ − 235 (bt-base64-decode-string
+ − 236 (bt-base64-decode-string
+ − 237 (bt-base64-encode-string
+ − 238 (bt-base64-encode-string
+ − 239 (bt-base64-encode-string
+ − 240 (bt-base64-encode-string
+ − 241 (bt-base64-encode-string raw))))))))))
+ − 242 raw)))
