Mercurial > hg > xemacs-beta
annotate tests/automated/base64-tests.el @ 5602:c9e5612f5424
Support the MP library on recent FreeBSD, have it pass relevant tests.
src/ChangeLog addition:
2011-11-26 Aidan Kehoe <kehoea@parhasard.net>
* number-mp.c (bignum_to_string):
Don't overwrite the accumulator we've just set up for this
function.
* number-mp.c (BIGNUM_TO_TYPE):
mp_itom() doesn't necessarily do what this code used to think with
negative numbers, it can treat them as unsigned ints. Subtract
numbers from bignum_zero instead of multiplying them by -1 to
convert them to their negative equivalents.
* number-mp.c (bignum_to_int):
* number-mp.c (bignum_to_uint):
* number-mp.c (bignum_to_long):
* number-mp.c (bignum_to_ulong):
* number-mp.c (bignum_to_double):
Use the changed BIGNUM_TO_TYPE() in these functions.
* number-mp.c (bignum_ceil):
* number-mp.c (bignum_floor):
In these functions, be more careful about rounding to positive and
negative infinity, respectively. Don't use the sign of QUOTIENT
when working out out whether to add or subtract one, rather use
the sign QUOTIENT would have if arbitrary-precision division were
done.
* number-mp.h:
* number-mp.h (MP_GCD):
Wrap #include <mp.h> in BEGIN_C_DECLS/END_C_DECLS.
* number.c (Fbigfloat_get_precision):
* number.c (Fbigfloat_set_precision):
Don't attempt to call XBIGFLOAT_GET_PREC if this build doesn't
support big floats.
| author | Aidan Kehoe <kehoea@parhasard.net> |
|---|---|
| date | Sat, 26 Nov 2011 17:59:14 +0000 |
| parents | 308d34e9f07d |
| children |
| rev | line source |
|---|---|
| 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 | |
|
5402
308d34e9f07d
Changed bulk of GPLv2 or later files identified by script
Mats Lidell <matsl@xemacs.org>
parents:
5136
diff
changeset
|
10 ;; XEmacs is free software: you can redistribute it and/or modify it |
|
308d34e9f07d
Changed bulk of GPLv2 or later files identified by script
Mats Lidell <matsl@xemacs.org>
parents:
5136
diff
changeset
|
11 ;; under the terms of the GNU General Public License as published by the |
|
308d34e9f07d
Changed bulk of GPLv2 or later files identified by script
Mats Lidell <matsl@xemacs.org>
parents:
5136
diff
changeset
|
12 ;; Free Software Foundation, either version 3 of the License, or (at your |
|
308d34e9f07d
Changed bulk of GPLv2 or later files identified by script
Mats Lidell <matsl@xemacs.org>
parents:
5136
diff
changeset
|
13 ;; option) any later version. |
| 434 | 14 |
|
5402
308d34e9f07d
Changed bulk of GPLv2 or later files identified by script
Mats Lidell <matsl@xemacs.org>
parents:
5136
diff
changeset
|
15 ;; XEmacs is distributed in the hope that it will be useful, but WITHOUT |
|
308d34e9f07d
Changed bulk of GPLv2 or later files identified by script
Mats Lidell <matsl@xemacs.org>
parents:
5136
diff
changeset
|
16 ;; ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or |
|
308d34e9f07d
Changed bulk of GPLv2 or later files identified by script
Mats Lidell <matsl@xemacs.org>
parents:
5136
diff
changeset
|
17 ;; FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License |
|
308d34e9f07d
Changed bulk of GPLv2 or later files identified by script
Mats Lidell <matsl@xemacs.org>
parents:
5136
diff
changeset
|
18 ;; for more details. |
| 434 | 19 |
| 20 ;; You should have received a copy of the GNU General Public License | |
|
5402
308d34e9f07d
Changed bulk of GPLv2 or later files identified by script
Mats Lidell <matsl@xemacs.org>
parents:
5136
diff
changeset
|
21 ;; along with XEmacs. If not, see <http://www.gnu.org/licenses/>. |
| 434 | 22 |
| 23 ;;; Synched up with: Not in FSF. | |
| 24 | |
| 25 ;;; Commentary: | |
| 26 | |
| 27 ;; Test base64 functions. | |
| 28 ;; See test-harness.el for instructions on how to run these tests. | |
| 29 | |
| 30 (eval-when-compile | |
| 31 (condition-case nil | |
| 32 (require 'test-harness) | |
| 33 (file-error | |
| 34 (push "." load-path) | |
| 35 (when (and (boundp 'load-file-name) (stringp load-file-name)) | |
| 36 (push (file-name-directory load-file-name) load-path)) | |
| 37 (require 'test-harness)))) | |
| 38 | |
| 39 ;; We need to test the buffer and string functions. We do it by | |
| 40 ;; testing them in various circumstances, asserting the same result, | |
| 41 ;; and returning that result. | |
| 42 | |
| 43 (defvar bt-test-buffer (get-buffer-create " *base64-workhorse*")) | |
| 44 | |
| 45 (defun bt-base64-encode-string (string &optional no-line-break) | |
| 46 (let ((string-result (base64-encode-string string no-line-break)) | |
| 47 length) | |
| 48 (with-current-buffer bt-test-buffer | |
| 49 ;; the whole buffer | |
| 50 (erase-buffer) | |
| 51 (insert string) | |
| 52 (setq length (base64-encode-region (point-min) (point-max) no-line-break)) | |
|
5136
0f66906b6e37
Undo Assert-equal, Assert=, etc.; make `Assert' handle this automatically
Ben Wing <ben@xemacs.org>
parents:
4855
diff
changeset
|
53 (Assert (eq length (- (point-max) (point-min)))) |
|
0f66906b6e37
Undo Assert-equal, Assert=, etc.; make `Assert' handle this automatically
Ben Wing <ben@xemacs.org>
parents:
4855
diff
changeset
|
54 (Assert (equal (buffer-string) string-result)) |
| 434 | 55 ;; partial |
| 56 (erase-buffer) | |
| 57 (insert "random junk........\0\0';'eqwrkw[erpqf") | |
| 58 (let ((p1 (point)) p2) | |
| 59 (insert string) | |
| 60 (setq p2 (point-marker)) | |
| 61 (insert "...more random junk.q,f3/.qrm314.r,m2typ' 2436T@W$^@$#^T@") | |
| 62 (setq length (base64-encode-region p1 p2 no-line-break)) | |
|
5136
0f66906b6e37
Undo Assert-equal, Assert=, etc.; make `Assert' handle this automatically
Ben Wing <ben@xemacs.org>
parents:
4855
diff
changeset
|
63 (Assert (eq length (- p2 p1))) |
|
0f66906b6e37
Undo Assert-equal, Assert=, etc.; make `Assert' handle this automatically
Ben Wing <ben@xemacs.org>
parents:
4855
diff
changeset
|
64 (Assert (equal (buffer-substring p1 p2) string-result)))) |
| 434 | 65 string-result)) |
| 66 | |
| 67 (defun bt-base64-decode-string (string) | |
| 68 (let ((string-result (base64-decode-string string)) | |
| 69 length) | |
| 70 (with-current-buffer bt-test-buffer | |
| 71 ;; the whole buffer | |
| 72 (erase-buffer) | |
| 73 (insert string) | |
| 74 (setq length (base64-decode-region (point-min) (point-max))) | |
| 75 (cond (string-result | |
|
5136
0f66906b6e37
Undo Assert-equal, Assert=, etc.; make `Assert' handle this automatically
Ben Wing <ben@xemacs.org>
parents:
4855
diff
changeset
|
76 (Assert (eq length (- (point-max) (point-min)))) |
|
0f66906b6e37
Undo Assert-equal, Assert=, etc.; make `Assert' handle this automatically
Ben Wing <ben@xemacs.org>
parents:
4855
diff
changeset
|
77 (Assert (equal (buffer-string) string-result))) |
| 434 | 78 (t |
| 79 (Assert (null length)) | |
| 80 ;; The buffer should not have been modified. | |
|
5136
0f66906b6e37
Undo Assert-equal, Assert=, etc.; make `Assert' handle this automatically
Ben Wing <ben@xemacs.org>
parents:
4855
diff
changeset
|
81 (Assert (equal (buffer-string) string)))) |
| 434 | 82 ;; partial |
| 83 (erase-buffer) | |
| 84 (insert "random junk........\0\0';'eqwrkw[erpqf") | |
| 85 (let ((p1 (point)) p2) | |
| 86 (insert string) | |
| 87 (setq p2 (point-marker)) | |
| 88 (insert "...more random junk.q,f3/.qrm314.\0\0r,m2typ' 2436T@W$^@$#T@") | |
| 89 (setq length (base64-decode-region p1 p2)) | |
| 90 (cond (string-result | |
|
5136
0f66906b6e37
Undo Assert-equal, Assert=, etc.; make `Assert' handle this automatically
Ben Wing <ben@xemacs.org>
parents:
4855
diff
changeset
|
91 (Assert (eq length (- p2 p1))) |
|
0f66906b6e37
Undo Assert-equal, Assert=, etc.; make `Assert' handle this automatically
Ben Wing <ben@xemacs.org>
parents:
4855
diff
changeset
|
92 (Assert (equal (buffer-substring p1 p2) string-result))) |
| 434 | 93 (t |
| 94 (Assert (null length)) | |
| 95 ;; The buffer should not have been modified. | |
|
5136
0f66906b6e37
Undo Assert-equal, Assert=, etc.; make `Assert' handle this automatically
Ben Wing <ben@xemacs.org>
parents:
4855
diff
changeset
|
96 (Assert (equal (buffer-substring p1 p2) string)))))) |
| 434 | 97 string-result)) |
| 98 | |
| 99 (defun bt-remove-newlines (str) | |
| 100 (apply #'string (delete ?\n (mapcar #'identity str)))) | |
| 101 | |
| 102 (defconst bt-allchars | |
| 103 (let ((str (make-string 256 ?\0))) | |
| 104 (dotimes (i 256) | |
| 105 (aset str i (int-char i))) | |
| 106 str)) | |
| 107 | |
| 108 (defconst bt-test-strings | |
| 109 `(("" "") | |
| 110 ("foo" "Zm9v") | |
| 111 ("ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789" | |
| 112 "QUJDREVGR0hJSktMTU5PUFFSU1RVVldYWVphYmNkZWZnaGlqa2xtbm9wcXJzdHV2d3h5ejAx | |
| 113 MjM0NTY3ODk=") | |
| 114 (,bt-allchars | |
| 115 "AAECAwQFBgcICQoLDA0ODxAREhMUFRYXGBkaGxwdHh8gISIjJCUmJygpKissLS4vMDEyMzQ1 | |
| 116 Njc4OTo7PD0+P0BBQkNERUZHSElKS0xNTk9QUVJTVFVWV1hZWltcXV5fYGFiY2RlZmdoaWpr | |
| 117 bG1ub3BxcnN0dXZ3eHl6e3x9fn+AgYKDhIWGh4iJiouMjY6PkJGSk5SVlpeYmZqbnJ2en6Ch | |
| 118 oqOkpaanqKmqq6ytrq+wsbKztLW2t7i5uru8vb6/wMHCw8TFxsfIycrLzM3Oz9DR0tPU1dbX | |
| 119 2Nna29zd3t/g4eLj5OXm5+jp6uvs7e7v8PHy8/T19vf4+fr7/P3+/w==") | |
| 120 )) | |
| 121 | |
| 122 ;;----------------------------------------------------- | |
| 123 ;; Encoding base64 | |
| 124 ;;----------------------------------------------------- | |
| 125 | |
| 126 (loop for (raw encoded) in bt-test-strings do | |
|
5136
0f66906b6e37
Undo Assert-equal, Assert=, etc.; make `Assert' handle this automatically
Ben Wing <ben@xemacs.org>
parents:
4855
diff
changeset
|
127 (Assert (equal (bt-base64-encode-string raw) encoded)) |
| 434 | 128 ;; test the NO-LINE-BREAK flag |
|
5136
0f66906b6e37
Undo Assert-equal, Assert=, etc.; make `Assert' handle this automatically
Ben Wing <ben@xemacs.org>
parents:
4855
diff
changeset
|
129 (Assert (equal (bt-base64-encode-string raw t) (bt-remove-newlines encoded)))) |
| 434 | 130 |
| 131 ;; When Mule is around, Lisp programmers should make sure that the | |
| 132 ;; buffer contains only characters whose `char-int' is in the [0, 256) | |
| 133 ;; range. If this condition is not satisfied for any character, an | |
| 134 ;; error is signaled. | |
| 135 (when (featurep 'mule) | |
| 136 ;; #### remove subtraction of 128 -- no longer needed with make-char | |
| 137 ;; patch! | |
| 138 (let* ((mule-string (format "Hrvoje Nik%ci%c" | |
| 139 ;; scaron == 185 in Latin 2 | |
| 140 (make-char 'latin-iso8859-2 (- 185 128)) | |
| 141 ;; cacute == 230 in Latin 2 | |
| 142 (make-char 'latin-iso8859-2 (- 230 128))))) | |
| 143 (Check-Error-Message error "Non-ascii character in base64 input" | |
| 144 (bt-base64-encode-string mule-string)))) | |
| 145 | |
| 146 ;;----------------------------------------------------- | |
| 147 ;; Decoding base64 | |
| 148 ;;----------------------------------------------------- | |
| 149 | |
| 150 (loop for (raw encoded) in bt-test-strings do | |
|
5136
0f66906b6e37
Undo Assert-equal, Assert=, etc.; make `Assert' handle this automatically
Ben Wing <ben@xemacs.org>
parents:
4855
diff
changeset
|
151 (Assert (equal (bt-base64-decode-string encoded) raw)) |
|
0f66906b6e37
Undo Assert-equal, Assert=, etc.; make `Assert' handle this automatically
Ben Wing <ben@xemacs.org>
parents:
4855
diff
changeset
|
152 (Assert (equal (bt-base64-decode-string (bt-remove-newlines encoded)) raw))) |
| 434 | 153 |
| 154 ;; Test errors | |
| 155 (dolist (str `("foo" "AAC" "foo\0bar" "====" "Zm=9v" ,bt-allchars)) | |
| 156 (Check-Error error (base64-decode-string str))) | |
| 157 | |
| 158 ;; base64-decode-string should ignore non-base64 characters anywhere | |
| 159 ;; in the string. We test this in the cheesiest manner possible, by | |
| 160 ;; inserting non-base64 chars at the beginning, at the end, and in the | |
| 161 ;; middle of the string. | |
| 162 | |
| 163 (defconst bt-base64-chars '(?A ?B ?C ?D ?E ?F ?G ?H ?I ?J | |
| 164 ;; sometimes I hate Emacs indentation. | |
| 165 ?K ?L ?M ?N ?O ?P ?Q ?R ?S ?T | |
| 166 ?U ?V ?W ?X ?Y ?Z ?a ?b ?c ?d | |
| 167 ?e ?f ?g ?h ?i ?j ?k ?l ?m ?n | |
| 168 ?o ?p ?q ?r ?s ?t ?u ?v ?w ?x | |
| 169 ?y ?z ?0 ?1 ?2 ?3 ?4 ?5 ?6 ?7 | |
| 170 ?8 ?9 ?+ ?/ ?=)) | |
| 171 | |
| 172 (defconst bt-nonbase64-chars (set-difference (mapcar #'identity bt-allchars) | |
| 173 bt-base64-chars)) | |
| 174 | |
| 442 | 175 (loop for (raw encoded) in bt-test-strings do |
| 176 (unless (equal raw "") | |
| 177 (let* ((middlepos (/ (1+ (length encoded)) 2)) | |
| 178 (left (substring encoded 0 middlepos)) | |
| 179 (right (substring encoded middlepos))) | |
| 180 ;; Whitespace at the beginning, end, and middle. | |
| 181 (let ((mangled (concat bt-nonbase64-chars left bt-nonbase64-chars right | |
| 182 bt-nonbase64-chars))) | |
|
5136
0f66906b6e37
Undo Assert-equal, Assert=, etc.; make `Assert' handle this automatically
Ben Wing <ben@xemacs.org>
parents:
4855
diff
changeset
|
183 (Assert (equal (bt-base64-decode-string mangled) raw))) |
| 434 | 184 |
| 442 | 185 ;; Whitespace between every char. |
| 186 (let ((mangled (concat bt-nonbase64-chars | |
| 187 ;; ENCODED with bt-nonbase64-chars | |
| 188 ;; between every character. | |
| 189 (mapconcat #'char-to-string encoded | |
| 190 (apply #'string bt-nonbase64-chars)) | |
| 191 bt-nonbase64-chars))) | |
|
5136
0f66906b6e37
Undo Assert-equal, Assert=, etc.; make `Assert' handle this automatically
Ben Wing <ben@xemacs.org>
parents:
4855
diff
changeset
|
192 (Assert (equal (bt-base64-decode-string mangled) raw)))))) |
| 434 | 193 |
| 194 ;;----------------------------------------------------- | |
| 195 ;; Mixed... | |
| 196 ;;----------------------------------------------------- | |
| 197 | |
| 198 ;; The whole point of base64 is to ensure that an arbitrary sequence | |
| 199 ;; of bytes passes through gateway hellfire unscathed, protected by | |
| 200 ;; the asbestos suit of base64. Here we test that | |
| 201 ;; (base64-decode-string (base64-decode-string FOO)) equals FOO for | |
| 202 ;; any FOO we can think of. The following stunts stress-test | |
| 203 ;; practically all aspects of the encoding and decoding process. | |
| 204 | |
| 205 (loop for (raw ignored) in bt-test-strings do | |
|
5136
0f66906b6e37
Undo Assert-equal, Assert=, etc.; make `Assert' handle this automatically
Ben Wing <ben@xemacs.org>
parents:
4855
diff
changeset
|
206 (Assert (equal (bt-base64-decode-string |
| 434 | 207 (bt-base64-encode-string raw)) |
|
5136
0f66906b6e37
Undo Assert-equal, Assert=, etc.; make `Assert' handle this automatically
Ben Wing <ben@xemacs.org>
parents:
4855
diff
changeset
|
208 raw)) |
|
0f66906b6e37
Undo Assert-equal, Assert=, etc.; make `Assert' handle this automatically
Ben Wing <ben@xemacs.org>
parents:
4855
diff
changeset
|
209 (Assert (equal (bt-base64-decode-string |
| 434 | 210 (bt-base64-decode-string |
| 211 (bt-base64-encode-string | |
| 212 (bt-base64-encode-string raw)))) | |
|
5136
0f66906b6e37
Undo Assert-equal, Assert=, etc.; make `Assert' handle this automatically
Ben Wing <ben@xemacs.org>
parents:
4855
diff
changeset
|
213 raw)) |
|
0f66906b6e37
Undo Assert-equal, Assert=, etc.; make `Assert' handle this automatically
Ben Wing <ben@xemacs.org>
parents:
4855
diff
changeset
|
214 (Assert (equal (bt-base64-decode-string |
| 434 | 215 (bt-base64-decode-string |
| 216 (bt-base64-decode-string | |
| 217 (bt-base64-encode-string | |
| 218 (bt-base64-encode-string | |
| 219 (bt-base64-encode-string raw)))))) | |
|
5136
0f66906b6e37
Undo Assert-equal, Assert=, etc.; make `Assert' handle this automatically
Ben Wing <ben@xemacs.org>
parents:
4855
diff
changeset
|
220 raw)) |
|
0f66906b6e37
Undo Assert-equal, Assert=, etc.; make `Assert' handle this automatically
Ben Wing <ben@xemacs.org>
parents:
4855
diff
changeset
|
221 (Assert (equal (bt-base64-decode-string |
| 434 | 222 (bt-base64-decode-string |
| 223 (bt-base64-decode-string | |
| 224 (bt-base64-decode-string | |
| 225 (bt-base64-encode-string | |
| 226 (bt-base64-encode-string | |
| 227 (bt-base64-encode-string | |
| 228 (bt-base64-encode-string raw)))))))) | |
|
5136
0f66906b6e37
Undo Assert-equal, Assert=, etc.; make `Assert' handle this automatically
Ben Wing <ben@xemacs.org>
parents:
4855
diff
changeset
|
229 raw)) |
|
0f66906b6e37
Undo Assert-equal, Assert=, etc.; make `Assert' handle this automatically
Ben Wing <ben@xemacs.org>
parents:
4855
diff
changeset
|
230 (Assert (equal (bt-base64-decode-string |
| 434 | 231 (bt-base64-decode-string |
| 232 (bt-base64-decode-string | |
| 233 (bt-base64-decode-string | |
| 234 (bt-base64-decode-string | |
| 235 (bt-base64-encode-string | |
| 236 (bt-base64-encode-string | |
| 237 (bt-base64-encode-string | |
| 238 (bt-base64-encode-string | |
| 239 (bt-base64-encode-string raw)))))))))) | |
|
5136
0f66906b6e37
Undo Assert-equal, Assert=, etc.; make `Assert' handle this automatically
Ben Wing <ben@xemacs.org>
parents:
4855
diff
changeset
|
240 raw))) |