Mercurial > hg > xemacs-beta

comparison tests/automated/base64-tests.el @ 414:da8ed4261e83 r21-2-15

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Import from CVS: tag r21-2-15
author cvs
date Mon, 13 Aug 2007 11:21:38 +0200
parents
children ebe98a74bd68
comparison
equal deleted inserted replaced
413:901169e5ca31 414:da8ed4261e83
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)))