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 "QUJDREVGR0hJSktMTU5PUFFSU1RVVldYWVphYmNkZWZnaGlqa2xtbm9wcXJzdHV2d3h5ejAx
117 "AAECAwQFBgcICQoLDA0ODxAREhMUFRYXGBkaGxwdHh8gISIjJCUmJygpKissLS4vMDEyMzQ1
118 Njc4OTo7PD0+P0BBQkNERUZHSElKS0xNTk9QUVJTVFVWV1hZWltcXV5fYGFiY2RlZmdoaWpr
119 bG1ub3BxcnN0dXZ3eHl6e3x9fn+AgYKDhIWGh4iJiouMjY6PkJGSk5SVlpeYmZqbnJ2en6Ch
120 oqOkpaanqKmqq6ytrq+wsbKztLW2t7i5uru8vb6/wMHCw8TFxsfIycrLzM3Oz9DR0tPU1dbX
121 2Nna29zd3t/g4eLj5OXm5+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" "====" "Zm=9v" ,bt-allchars))
158 (Check-Error error (base64-decode-string str)))
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.
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
174 (defconst bt-nonbase64-chars (set-difference (mapcar #'identity bt-allchars)
178 ;; This code crashes some versions of XEmacs 21.2! This requires
179 ;; further investigation. I (hniksic) am running Linux, and for me,
180 ;; XEmacs used to crash in Fmapconcat()->mapcar1(), after a GC that
181 ;; thrashes the stack. Raymond Toy reported a similar crash under
182 ;; Solaris. I can no longer repeat the bug, so I cannot fix it now.
183 (loop for (raw encoded) in bt-test-strings do
184 (unless (equal raw "")
185 (let* ((middlepos (/ (1+ (length encoded)) 2))
186 (left (substring encoded 0 middlepos))
187 (right (substring encoded middlepos)))
188 ;; Whitespace at the beginning, end, and middle.
189 (let ((mangled (concat bt-nonbase64-chars left bt-nonbase64-chars right
190 bt-nonbase64-chars)))
191 (Assert (equal (bt-base64-decode-string mangled) raw)))
193 ;; Whitespace between every char.
194 (let ((mangled (concat bt-nonbase64-chars
195 ;; ENCODED with bt-nonbase64-chars
196 ;; between every character.
197 (mapconcat #'char-to-string encoded
198 (apply #'string bt-nonbase64-chars))
199 bt-nonbase64-chars)))
200 (Assert (equal (bt-base64-decode-string mangled) raw))))))
203 ;;-----------------------------------------------------
205 ;;-----------------------------------------------------
207 ;; The whole point of base64 is to ensure that an arbitrary sequence
208 ;; of bytes passes through gateway hellfire unscathed, protected by
209 ;; the asbestos suit of base64. Here we test that
210 ;; (base64-decode-string (base64-decode-string FOO)) equals FOO for
211 ;; any FOO we can think of. The following stunts stress-test
212 ;; practically all aspects of the encoding and decoding process.
214 (loop for (raw ignored) in bt-test-strings do
215 (Assert (equal (bt-base64-decode-string
216 (bt-base64-encode-string raw))
218 (Assert (equal (bt-base64-decode-string
219 (bt-base64-decode-string
220 (bt-base64-encode-string
221 (bt-base64-encode-string raw))))
223 (Assert (equal (bt-base64-decode-string
224 (bt-base64-decode-string
225 (bt-base64-decode-string
226 (bt-base64-encode-string
227 (bt-base64-encode-string
228 (bt-base64-encode-string raw))))))
230 (Assert (equal (bt-base64-decode-string
231 (bt-base64-decode-string
232 (bt-base64-decode-string
233 (bt-base64-decode-string
234 (bt-base64-encode-string
235 (bt-base64-encode-string
236 (bt-base64-encode-string
237 (bt-base64-encode-string raw))))))))
239 (Assert (equal (bt-base64-decode-string
240 (bt-base64-decode-string
241 (bt-base64-decode-string
242 (bt-base64-decode-string
243 (bt-base64-decode-string
244 (bt-base64-encode-string
245 (bt-base64-encode-string
246 (bt-base64-encode-string
247 (bt-base64-encode-string
248 (bt-base64-encode-string raw))))))))))