|
414
|
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 "QUJDREVGR0hJSktMTU5PUFFSU1RVVldYWVphYmNkZWZnaGlqa2xtbm9wcXJzdHV2d3h5ejAxMjM0
|
|
|
115 NTY3ODk=")
|
|
|
116 (,bt-allchars
|
|
|
117 "AAECAwQFBgcICQoLDA0ODxAREhMUFRYXGBkaGxwdHh8gISIjJCUmJygpKissLS4vMDEyMzQ1Njc4
|
|
|
118 OTo7PD0+P0BBQkNERUZHSElKS0xNTk9QUVJTVFVWV1hZWltcXV5fYGFiY2RlZmdoaWprbG1ub3Bx
|
|
|
119 cnN0dXZ3eHl6e3x9fn+AgYKDhIWGh4iJiouMjY6PkJGSk5SVlpeYmZqbnJ2en6ChoqOkpaanqKmq
|
|
|
120 q6ytrq+wsbKztLW2t7i5uru8vb6/wMHCw8TFxsfIycrLzM3Oz9DR0tPU1dbX2Nna29zd3t/g4eLj
|
|
|
121 5OXm5+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" ,bt-allchars))
|
|
|
158 (Assert (eq (bt-base64-decode-string str) nil)))
|
|
|
159
|
|
|
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.
|
|
|
164
|
|
|
165 (defconst bt-whitespace-chars '(?\ ?\t ?\r ?\n ?\f ?\v))
|
|
|
166
|
|
|
167 (loop for (raw encoded) in bt-test-strings do
|
|
|
168 ;; Whitespace at the beginning
|
|
|
169 (dolist (char bt-whitespace-chars)
|
|
|
170 ;; One char...
|
|
|
171 (let ((mangled (concat (list char) encoded)))
|
|
|
172 (Assert (equal (bt-base64-decode-string mangled) raw))))
|
|
|
173 ;; ...all chars.
|
|
|
174 (let ((mangled (concat bt-whitespace-chars encoded)))
|
|
|
175 (Assert (equal (bt-base64-decode-string mangled) raw)))
|
|
|
176
|
|
|
177 ;; Whitespace at the end
|
|
|
178 (dolist (char bt-whitespace-chars)
|
|
|
179 ;; One char...
|
|
|
180 (let ((mangled (concat encoded (list char))))
|
|
|
181 (Assert (equal (bt-base64-decode-string mangled) raw))))
|
|
|
182 ;; ...all chars.
|
|
|
183 (let ((mangled (concat encoded bt-whitespace-chars)))
|
|
|
184 (Assert (equal (bt-base64-decode-string mangled) raw)))
|
|
|
185
|
|
|
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)
|
|
|
192 ;; One char...
|
|
|
193 (let ((mangled (concat left (list char) right)))
|
|
|
194 (Assert (equal (bt-base64-decode-string mangled) raw))))
|
|
|
195 ;; ...all chars.
|
|
|
196 (let ((mangled (concat left bt-whitespace-chars right)))
|
|
|
197 (Assert (equal (bt-base64-decode-string mangled) raw)))
|
|
|
198
|
|
|
199 ;; Whitespace at the beginning, end, and middle.
|
|
|
200 (dolist (char bt-whitespace-chars)
|
|
|
201 ;; One char...
|
|
|
202 (let ((mangled (concat (list char) left (list char) right (list char))))
|
|
|
203 (Assert (equal (bt-base64-decode-string mangled) raw))))
|
|
|
204 ;; ...all chars.
|
|
|
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)))
|
|
|
208
|
|
|
209 ;; Whitespace between every char.
|
|
|
210 (dolist (char bt-whitespace-chars)
|
|
|
211 ;; One char...
|
|
|
212 (let ((mangled (concat (list char)
|
|
|
213 ;; ENCODED with char between every character.
|
|
|
214 (mapconcat #'char-to-string encoded
|
|
|
215 (char-to-string char))
|
|
|
216 (list char))))
|
|
|
217 (Assert (equal (bt-base64-decode-string mangled) raw))))
|
|
|
218 ;; ...all chars.
|
|
|
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))))))
|
|
|
226
|
|
|
227 ;;-----------------------------------------------------
|
|
|
228 ;; Mixed...
|
|
|
229 ;;-----------------------------------------------------
|
|
|
230
|
|
|
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.
|
|
|
235
|
|
|
236 (loop for (string1 ignored) in bt-test-strings do
|
|
|
237 (Assert (equal (bt-base64-decode-string
|
|
|
238 (bt-base64-encode-string string1))
|
|
|
239 string1))
|
|
|
240 (Assert (equal (bt-base64-decode-string
|
|
|
241 (bt-base64-decode-string
|
|
|
242 (bt-base64-encode-string
|
|
|
243 (bt-base64-encode-string string1))))
|
|
|
244 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))))))
|
|
|
251 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))))))))
|
|
|
260 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))))))))))
|
|
|
271 string1)))
|
