Mercurial > hg > xemacs-beta

comparison tests/automated/base64-tests.el @ 416:ebe98a74bd68 r21-2-16

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Import from CVS: tag r21-2-16
author cvs
date Mon, 13 Aug 2007 11:22:23 +0200
parents da8ed4261e83
children
comparison
equal deleted inserted replaced
415:a27f76b40c83 416:ebe98a74bd68
109 109
110 (defconst bt-test-strings 110 (defconst bt-test-strings
111 `(("" "") 111 `(("" "")
112 ("foo" "Zm9v") 112 ("foo" "Zm9v")
113 ("ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789" 113 ("ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789"
114 "QUJDREVGR0hJSktMTU5PUFFSU1RVVldYWVphYmNkZWZnaGlqa2xtbm9wcXJzdHV2d3h5ejAxMjM0 114 "QUJDREVGR0hJSktMTU5PUFFSU1RVVldYWVphYmNkZWZnaGlqa2xtbm9wcXJzdHV2d3h5ejAx
115 NTY3ODk=") 115 MjM0NTY3ODk=")
116 (,bt-allchars 116 (,bt-allchars
117 "AAECAwQFBgcICQoLDA0ODxAREhMUFRYXGBkaGxwdHh8gISIjJCUmJygpKissLS4vMDEyMzQ1Njc4 117 "AAECAwQFBgcICQoLDA0ODxAREhMUFRYXGBkaGxwdHh8gISIjJCUmJygpKissLS4vMDEyMzQ1
118 OTo7PD0+P0BBQkNERUZHSElKS0xNTk9QUVJTVFVWV1hZWltcXV5fYGFiY2RlZmdoaWprbG1ub3Bx 118 Njc4OTo7PD0+P0BBQkNERUZHSElKS0xNTk9QUVJTVFVWV1hZWltcXV5fYGFiY2RlZmdoaWpr
119 cnN0dXZ3eHl6e3x9fn+AgYKDhIWGh4iJiouMjY6PkJGSk5SVlpeYmZqbnJ2en6ChoqOkpaanqKmq 119 bG1ub3BxcnN0dXZ3eHl6e3x9fn+AgYKDhIWGh4iJiouMjY6PkJGSk5SVlpeYmZqbnJ2en6Ch
120 q6ytrq+wsbKztLW2t7i5uru8vb6/wMHCw8TFxsfIycrLzM3Oz9DR0tPU1dbX2Nna29zd3t/g4eLj 120 oqOkpaanqKmqq6ytrq+wsbKztLW2t7i5uru8vb6/wMHCw8TFxsfIycrLzM3Oz9DR0tPU1dbX
121 5OXm5+jp6uvs7e7v8PHy8/T19vf4+fr7/P3+/w==") 121 2Nna29zd3t/g4eLj5OXm5+jp6uvs7e7v8PHy8/T19vf4+fr7/P3+/w==")
122 )) 122 ))
123 123
124 ;;----------------------------------------------------- 124 ;;-----------------------------------------------------
125 ;; Encoding base64 125 ;; Encoding base64
126 ;;----------------------------------------------------- 126 ;;-----------------------------------------------------
152 (loop for (raw encoded) in bt-test-strings do 152 (loop for (raw encoded) in bt-test-strings do
153 (Assert (equal (bt-base64-decode-string encoded) raw)) 153 (Assert (equal (bt-base64-decode-string encoded) raw))
154 (Assert (equal (bt-base64-decode-string (bt-remove-newlines encoded)) raw))) 154 (Assert (equal (bt-base64-decode-string (bt-remove-newlines encoded)) raw)))
155 155
156 ;; Test errors 156 ;; Test errors
157 (dolist (str `("foo" "AAC" "foo\0bar" ,bt-allchars)) 157 (dolist (str `("foo" "AAC" "foo\0bar" "====" "Zm=9v" ,bt-allchars))
158 (Assert (eq (bt-base64-decode-string str) nil))) 158 (Check-Error error (base64-decode-string str)))
159 159
160 ;; base64-decode-string is supposed to handle whitespaces anywhere in 160 ;; base64-decode-string should ignore non-base64 characters anywhere
161 ;; the string. We test this in the cheesis manner possible, by 161 ;; in the string. We test this in the cheesiest manner possible, by
162 ;; inserting whitespaces at the beginning, at the end, in the middle 162 ;; inserting non-base64 chars at the beginning, at the end, and in the
163 ;; of the string, and mixed. 163 ;; middle of the string.
164 164
165 (defconst bt-whitespace-chars '(?\ ?\t ?\r ?\n ?\f ?\v)) 165 (defconst bt-base64-chars '(?A ?B ?C ?D ?E ?F ?G ?H ?I ?J
166 166 ;; sometimes I hate Emacs indentation.
167 (loop for (raw encoded) in bt-test-strings do 167 ?K ?L ?M ?N ?O ?P ?Q ?R ?S ?T
168 ;; Whitespace at the beginning 168 ?U ?V ?W ?X ?Y ?Z ?a ?b ?c ?d
169 (dolist (char bt-whitespace-chars) 169 ?e ?f ?g ?h ?i ?j ?k ?l ?m ?n
170 ;; One char... 170 ?o ?p ?q ?r ?s ?t ?u ?v ?w ?x
171 (let ((mangled (concat (list char) encoded))) 171 ?y ?z ?0 ?1 ?2 ?3 ?4 ?5 ?6 ?7
172 (Assert (equal (bt-base64-decode-string mangled) raw)))) 172 ?8 ?9 ?+ ?/ ?=))
173 ;; ...all chars. 173
174 (let ((mangled (concat bt-whitespace-chars encoded))) 174 (defconst bt-nonbase64-chars (set-difference (mapcar #'identity bt-allchars)
175 (Assert (equal (bt-base64-decode-string mangled) raw))) 175 bt-base64-chars))
176 176
177 ;; Whitespace at the end 177 (when nil
178 (dolist (char bt-whitespace-chars) 178 ;; This code crashes XEmacs! This requires further investigation.
179 ;; One char... 179 ;; I'm running Linux, and for me, XEmacs crashes in
180 (let ((mangled (concat encoded (list char)))) 180 ;; Fmapconcat()->mapcar1(), after a GC that thrashes the stack.
181 (Assert (equal (bt-base64-decode-string mangled) raw)))) 181 ;; Raymond Toy reports a similar crash under Solaris.
182 ;; ...all chars. 182 (loop for (raw encoded) in bt-test-strings do
183 (let ((mangled (concat encoded bt-whitespace-chars))) 183 (unless (equal raw "")
184 (Assert (equal (bt-base64-decode-string mangled) raw))) 184 (let* ((middlepos (/ (1+ (length encoded)) 2))
185 185 (left (substring encoded 0 middlepos))
186 (unless (equal raw "") 186 (right (substring encoded middlepos)))
187 ;; Whitespace in the middle 187 ;; Whitespace at the beginning, end, and middle.
188 (let* ((middlepos (/ (1+ (length encoded)) 2)) 188 (let ((mangled (concat bt-nonbase64-chars left bt-nonbase64-chars right
189 (left (substring encoded 0 middlepos)) 189 bt-nonbase64-chars)))
190 (right (substring encoded middlepos))) 190 (Assert (equal (bt-base64-decode-string mangled) raw)))
191 (dolist (char bt-whitespace-chars) 191
192 ;; One char... 192 ;; Whitespace between every char.
193 (let ((mangled (concat left (list char) right))) 193 (let ((mangled (concat bt-nonbase64-chars
194 (Assert (equal (bt-base64-decode-string mangled) raw)))) 194 ;; ENCODED with bt-nonbase64-chars
195 ;; ...all chars. 195 ;; between every character.
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 196 (mapconcat #'char-to-string encoded
215 (char-to-string char)) 197 (apply #'string bt-nonbase64-chars))
216 (list char)))) 198 bt-nonbase64-chars)))
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)))))) 199 (Assert (equal (bt-base64-decode-string mangled) raw))))))
200 )
226 201
227 ;;----------------------------------------------------- 202 ;;-----------------------------------------------------
228 ;; Mixed... 203 ;; Mixed...
229 ;;----------------------------------------------------- 204 ;;-----------------------------------------------------
230 205
231 ;; The crux of the whole base64 business is to ensure that 206 ;; The whole point of base64 is to ensure that an arbitrary sequence
232 ;; (base64-decode-string (base64-decode-string FOO)) equals FOO. The 207 ;; of bytes passes through gateway hellfire unscathed, protected by
233 ;; following stunts stress-test practically all aspects of the 208 ;; the asbestos suit of base64. Here we test that
234 ;; encoding and decoding process. 209 ;; (base64-decode-string (base64-decode-string FOO)) equals FOO for
235 210 ;; any FOO we can think of. The following stunts stress-test
236 (loop for (string1 ignored) in bt-test-strings do 211 ;; practically all aspects of the encoding and decoding process.
237 (Assert (equal (bt-base64-decode-string 212
238 (bt-base64-encode-string string1)) 213 (loop for (raw ignored) in bt-test-strings do
239 string1)) 214 (Assert (equal (bt-base64-decode-string
215 (bt-base64-encode-string raw))
216 raw))
240 (Assert (equal (bt-base64-decode-string 217 (Assert (equal (bt-base64-decode-string
241 (bt-base64-decode-string 218 (bt-base64-decode-string
242 (bt-base64-encode-string 219 (bt-base64-encode-string
243 (bt-base64-encode-string string1)))) 220 (bt-base64-encode-string raw))))
244 string1)) 221 raw))
245 (Assert (equal (bt-base64-decode-string 222 (Assert (equal (bt-base64-decode-string
246 (bt-base64-decode-string 223 (bt-base64-decode-string
247 (bt-base64-decode-string 224 (bt-base64-decode-string
248 (bt-base64-encode-string 225 (bt-base64-encode-string
249 (bt-base64-encode-string 226 (bt-base64-encode-string
250 (bt-base64-encode-string string1)))))) 227 (bt-base64-encode-string raw))))))
251 string1)) 228 raw))
252 (Assert (equal (bt-base64-decode-string 229 (Assert (equal (bt-base64-decode-string
253 (bt-base64-decode-string 230 (bt-base64-decode-string
254 (bt-base64-decode-string 231 (bt-base64-decode-string
255 (bt-base64-decode-string 232 (bt-base64-decode-string
256 (bt-base64-encode-string 233 (bt-base64-encode-string
257 (bt-base64-encode-string 234 (bt-base64-encode-string
258 (bt-base64-encode-string 235 (bt-base64-encode-string
259 (bt-base64-encode-string string1)))))))) 236 (bt-base64-encode-string raw))))))))
260 string1)) 237 raw))
261 (Assert (equal (bt-base64-decode-string 238 (Assert (equal (bt-base64-decode-string
262 (bt-base64-decode-string 239 (bt-base64-decode-string
263 (bt-base64-decode-string 240 (bt-base64-decode-string
264 (bt-base64-decode-string 241 (bt-base64-decode-string
265 (bt-base64-decode-string 242 (bt-base64-decode-string
266 (bt-base64-encode-string 243 (bt-base64-encode-string
267 (bt-base64-encode-string 244 (bt-base64-encode-string
268 (bt-base64-encode-string 245 (bt-base64-encode-string
269 (bt-base64-encode-string 246 (bt-base64-encode-string
270 (bt-base64-encode-string string1)))))))))) 247 (bt-base64-encode-string raw))))))))))
271 string1))) 248 raw)))