1 ;; Copyright (C) 1999 Free Software Foundation, Inc.
3 ;; Author: Hrvoje Niksic <hniksic@srce.hr>
4 ;; Maintainer: Hrvoje Niksic <hniksic@srce.hr>
8 ;; This file is part of XEmacs.
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)
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.
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
25 ;;; Synched up with: Not in FSF.
29 ;; Test base64 functions.
30 ;; See test-harness.el for instructions on how to run these tests.
34 (require 'test-harness)
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))))
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.
45 (defvar bt-test-buffer (get-buffer-create " *base64-workhorse*"))
47 (defun bt-base64-encode-string (string &optional no-line-break)
48 (let ((string-result (base64-encode-string string no-line-break))
50 (with-current-buffer bt-test-buffer
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))
59 (insert "random junk........
\0\0';'eqwrkw[erpqf")
60 (let ((p1 (point)) p2)
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))))
69 (defun bt-base64-decode-string (string)
70 (let ((string-result (base64-decode-string string))
72 (with-current-buffer bt-test-buffer
76 (setq length (base64-decode-region (point-min) (point-max)))
78 (Assert (eq length (- (point-max) (point-min))))
79 (Assert (equal (buffer-string) string-result)))
81 (Assert (null length))
82 ;; The buffer should not have been modified.
83 (Assert (equal (buffer-string) string))))
86 (insert "random junk........
\0\0';'eqwrkw[erpqf")
87 (let ((p1 (point)) p2)
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))
93 (Assert (eq length (- p2 p1)))
94 (Assert (equal (buffer-substring p1 p2) string-result)))
96 (Assert (null length))
97 ;; The buffer should not have been modified.
98 (Assert (equal (buffer-substring p1 p2) string))))))
101 (defun bt-remove-newlines (str)
102 (apply #'string (delete ?\n (mapcar #'identity str))))
104 (defconst bt-allchars
105 (let ((str (make-string 256 ?\0)))
107 (aset str i (int-char i)))
110 (defconst bt-test-strings
113 ("ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789"
114 "QUJDREVGR0hJSktMTU5PUFFSU1RVVldYWVphYmNkZWZnaGlqa2xtbm9wcXJzdHV2d3h5ejAxMjM0
117 "AAECAwQFBgcICQoLDA0ODxAREhMUFRYXGBkaGxwdHh8gISIjJCUmJygpKissLS4vMDEyMzQ1Njc4
118 OTo7PD0+P0BBQkNERUZHSElKS0xNTk9QUVJTVFVWV1hZWltcXV5fYGFiY2RlZmdoaWprbG1ub3Bx
119 cnN0dXZ3eHl6e3x9fn+AgYKDhIWGh4iJiouMjY6PkJGSk5SVlpeYmZqbnJ2en6ChoqOkpaanqKmq
120 q6ytrq+wsbKztLW2t7i5uru8vb6/wMHCw8TFxsfIycrLzM3Oz9DR0tPU1dbX2Nna29zd3t/g4eLj
121 5OXm5+jp6uvs7e7v8PHy8/T19vf4+fr7/P3+/w==")
124 ;;-----------------------------------------------------
126 ;;-----------------------------------------------------
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))))
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
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))))
148 ;;-----------------------------------------------------
150 ;;-----------------------------------------------------
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)))
157 (dolist (str `("foo" "AAC" "foo
\0bar" ,bt-allchars))
158 (Assert (eq (bt-base64-decode-string str) nil)))
160 ;; base64-decode-string is supposed to handle whitespaces anywhere in
161 ;; the string. We test this in the cheesis manner possible, by
162 ;; inserting whitespaces at the beginning, at the end, in the middle
163 ;; of the string, and mixed.
165 (defconst bt-whitespace-chars '(?\ ?\t ?\r ?\n ?\f ?\v))
167 (loop for (raw encoded) in bt-test-strings do
168 ;; Whitespace at the beginning
169 (dolist (char bt-whitespace-chars)
171 (let ((mangled (concat (list char) encoded)))
172 (Assert (equal (bt-base64-decode-string mangled) raw))))
174 (let ((mangled (concat bt-whitespace-chars encoded)))
175 (Assert (equal (bt-base64-decode-string mangled) raw)))
177 ;; Whitespace at the end
178 (dolist (char bt-whitespace-chars)
180 (let ((mangled (concat encoded (list char))))
181 (Assert (equal (bt-base64-decode-string mangled) raw))))
183 (let ((mangled (concat encoded bt-whitespace-chars)))
184 (Assert (equal (bt-base64-decode-string mangled) raw)))
186 (unless (equal raw "")
187 ;; Whitespace in the middle
188 (let* ((middlepos (/ (1+ (length encoded)) 2))
189 (left (substring encoded 0 middlepos))
190 (right (substring encoded middlepos)))
191 (dolist (char bt-whitespace-chars)
193 (let ((mangled (concat left (list char) right)))
194 (Assert (equal (bt-base64-decode-string mangled) raw))))
196 (let ((mangled (concat left bt-whitespace-chars right)))
197 (Assert (equal (bt-base64-decode-string mangled) raw)))
199 ;; Whitespace at the beginning, end, and middle.
200 (dolist (char bt-whitespace-chars)
202 (let ((mangled (concat (list char) left (list char) right (list char))))
203 (Assert (equal (bt-base64-decode-string mangled) raw))))
205 (let ((mangled (concat bt-whitespace-chars left bt-whitespace-chars right
206 bt-whitespace-chars)))
207 (Assert (equal (bt-base64-decode-string mangled) raw)))
209 ;; Whitespace between every char.
210 (dolist (char bt-whitespace-chars)
212 (let ((mangled (concat (list char)
213 ;; ENCODED with char between every character.
214 (mapconcat #'char-to-string encoded
215 (char-to-string char))
217 (Assert (equal (bt-base64-decode-string mangled) raw))))
219 (let ((mangled (concat bt-whitespace-chars
220 ;; ENCODED with bt-whitespace-chars
221 ;; between every character.
222 (mapconcat #'char-to-string encoded
223 (apply #'string bt-whitespace-chars))
224 bt-whitespace-chars)))
225 (Assert (equal (bt-base64-decode-string mangled) raw))))))
227 ;;-----------------------------------------------------
229 ;;-----------------------------------------------------
231 ;; The crux of the whole base64 business is to ensure that
232 ;; (base64-decode-string (base64-decode-string FOO)) equals FOO. The
233 ;; following stunts stress-test practically all aspects of the
234 ;; encoding and decoding process.
236 (loop for (string1 ignored) in bt-test-strings do
237 (Assert (equal (bt-base64-decode-string
238 (bt-base64-encode-string string1))
240 (Assert (equal (bt-base64-decode-string
241 (bt-base64-decode-string
242 (bt-base64-encode-string
243 (bt-base64-encode-string string1))))
245 (Assert (equal (bt-base64-decode-string
246 (bt-base64-decode-string
247 (bt-base64-decode-string
248 (bt-base64-encode-string
249 (bt-base64-encode-string
250 (bt-base64-encode-string string1))))))
252 (Assert (equal (bt-base64-decode-string
253 (bt-base64-decode-string
254 (bt-base64-decode-string
255 (bt-base64-decode-string
256 (bt-base64-encode-string
257 (bt-base64-encode-string
258 (bt-base64-encode-string
259 (bt-base64-encode-string string1))))))))
261 (Assert (equal (bt-base64-decode-string
262 (bt-base64-decode-string
263 (bt-base64-decode-string
264 (bt-base64-decode-string
265 (bt-base64-decode-string
266 (bt-base64-encode-string
267 (bt-base64-encode-string
268 (bt-base64-encode-string
269 (bt-base64-encode-string
270 (bt-base64-encode-string string1))))))))))