|
434
|
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 "QUJDREVGR0hJSktMTU5PUFFSU1RVVldYWVphYmNkZWZnaGlqa2xtbm9wcXJzdHV2d3h5ejAx
|
|
|
115 MjM0NTY3ODk=")
|
|
|
116 (,bt-allchars
|
|
|
117 "AAECAwQFBgcICQoLDA0ODxAREhMUFRYXGBkaGxwdHh8gISIjJCUmJygpKissLS4vMDEyMzQ1
|
|
|
118 Njc4OTo7PD0+P0BBQkNERUZHSElKS0xNTk9QUVJTVFVWV1hZWltcXV5fYGFiY2RlZmdoaWpr
|
|
|
119 bG1ub3BxcnN0dXZ3eHl6e3x9fn+AgYKDhIWGh4iJiouMjY6PkJGSk5SVlpeYmZqbnJ2en6Ch
|
|
|
120 oqOkpaanqKmqq6ytrq+wsbKztLW2t7i5uru8vb6/wMHCw8TFxsfIycrLzM3Oz9DR0tPU1dbX
|
|
|
121 2Nna29zd3t/g4eLj5OXm5+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" "====" "Zm=9v" ,bt-allchars))
|
|
|
158 (Check-Error error (base64-decode-string str)))
|
|
|
159
|
|
|
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.
|
|
|
164
|
|
|
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
|
|
|
172 ?8 ?9 ?+ ?/ ?=))
|
|
|
173
|
|
|
174 (defconst bt-nonbase64-chars (set-difference (mapcar #'identity bt-allchars)
|
|
|
175 bt-base64-chars))
|
|
|
176
|
|
|
177 (when t
|
|
|
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)))
|
|
|
192
|
|
|
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))))))
|
|
|
201 )
|
|
|
202
|
|
|
203 ;;-----------------------------------------------------
|
|
|
204 ;; Mixed...
|
|
|
205 ;;-----------------------------------------------------
|
|
|
206
|
|
|
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.
|
|
|
213
|
|
|
214 (loop for (raw ignored) in bt-test-strings do
|
|
|
215 (Assert (equal (bt-base64-decode-string
|
|
|
216 (bt-base64-encode-string raw))
|
|
|
217 raw))
|
|
|
218 (Assert (equal (bt-base64-decode-string
|
|
|
219 (bt-base64-decode-string
|
|
|
220 (bt-base64-encode-string
|
|
|
221 (bt-base64-encode-string raw))))
|
|
|
222 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))))))
|
|
|
229 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))))))))
|
|
|
238 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))))))))))
|
|
|
249 raw)))
|
