Mercurial > hg > xemacs-beta
diff tests/automated/base64-tests.el @ 416:ebe98a74bd68 r21-2-16
Import from CVS: tag r21-2-16
author | cvs |
---|---|
date | Mon, 13 Aug 2007 11:22:23 +0200 |
parents | da8ed4261e83 |
children |
line wrap: on
line diff
--- a/tests/automated/base64-tests.el Mon Aug 13 11:21:40 2007 +0200 +++ b/tests/automated/base64-tests.el Mon Aug 13 11:22:23 2007 +0200 @@ -111,14 +111,14 @@ `(("" "") ("foo" "Zm9v") ("ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789" - "QUJDREVGR0hJSktMTU5PUFFSU1RVVldYWVphYmNkZWZnaGlqa2xtbm9wcXJzdHV2d3h5ejAxMjM0 -NTY3ODk=") + "QUJDREVGR0hJSktMTU5PUFFSU1RVVldYWVphYmNkZWZnaGlqa2xtbm9wcXJzdHV2d3h5ejAx +MjM0NTY3ODk=") (,bt-allchars - "AAECAwQFBgcICQoLDA0ODxAREhMUFRYXGBkaGxwdHh8gISIjJCUmJygpKissLS4vMDEyMzQ1Njc4 -OTo7PD0+P0BBQkNERUZHSElKS0xNTk9QUVJTVFVWV1hZWltcXV5fYGFiY2RlZmdoaWprbG1ub3Bx -cnN0dXZ3eHl6e3x9fn+AgYKDhIWGh4iJiouMjY6PkJGSk5SVlpeYmZqbnJ2en6ChoqOkpaanqKmq -q6ytrq+wsbKztLW2t7i5uru8vb6/wMHCw8TFxsfIycrLzM3Oz9DR0tPU1dbX2Nna29zd3t/g4eLj -5OXm5+jp6uvs7e7v8PHy8/T19vf4+fr7/P3+/w==") + "AAECAwQFBgcICQoLDA0ODxAREhMUFRYXGBkaGxwdHh8gISIjJCUmJygpKissLS4vMDEyMzQ1 +Njc4OTo7PD0+P0BBQkNERUZHSElKS0xNTk9QUVJTVFVWV1hZWltcXV5fYGFiY2RlZmdoaWpr +bG1ub3BxcnN0dXZ3eHl6e3x9fn+AgYKDhIWGh4iJiouMjY6PkJGSk5SVlpeYmZqbnJ2en6Ch +oqOkpaanqKmqq6ytrq+wsbKztLW2t7i5uru8vb6/wMHCw8TFxsfIycrLzM3Oz9DR0tPU1dbX +2Nna29zd3t/g4eLj5OXm5+jp6uvs7e7v8PHy8/T19vf4+fr7/P3+/w==") )) ;;----------------------------------------------------- @@ -154,101 +154,78 @@ (Assert (equal (bt-base64-decode-string (bt-remove-newlines encoded)) raw))) ;; Test errors -(dolist (str `("foo" "AAC" "foo\0bar" ,bt-allchars)) - (Assert (eq (bt-base64-decode-string str) nil))) +(dolist (str `("foo" "AAC" "foo\0bar" "====" "Zm=9v" ,bt-allchars)) + (Check-Error error (base64-decode-string str))) -;; base64-decode-string is supposed to handle whitespaces anywhere in -;; the string. We test this in the cheesis manner possible, by -;; inserting whitespaces at the beginning, at the end, in the middle -;; of the string, and mixed. - -(defconst bt-whitespace-chars '(?\ ?\t ?\r ?\n ?\f ?\v)) +;; base64-decode-string should ignore non-base64 characters anywhere +;; in the string. We test this in the cheesiest manner possible, by +;; inserting non-base64 chars at the beginning, at the end, and in the +;; middle of the string. -(loop for (raw encoded) in bt-test-strings do - ;; Whitespace at the beginning - (dolist (char bt-whitespace-chars) - ;; One char... - (let ((mangled (concat (list char) encoded))) - (Assert (equal (bt-base64-decode-string mangled) raw)))) - ;; ...all chars. - (let ((mangled (concat bt-whitespace-chars encoded))) - (Assert (equal (bt-base64-decode-string mangled) raw))) +(defconst bt-base64-chars '(?A ?B ?C ?D ?E ?F ?G ?H ?I ?J + ;; sometimes I hate Emacs indentation. + ?K ?L ?M ?N ?O ?P ?Q ?R ?S ?T + ?U ?V ?W ?X ?Y ?Z ?a ?b ?c ?d + ?e ?f ?g ?h ?i ?j ?k ?l ?m ?n + ?o ?p ?q ?r ?s ?t ?u ?v ?w ?x + ?y ?z ?0 ?1 ?2 ?3 ?4 ?5 ?6 ?7 + ?8 ?9 ?+ ?/ ?=)) - ;; Whitespace at the end - (dolist (char bt-whitespace-chars) - ;; One char... - (let ((mangled (concat encoded (list char)))) - (Assert (equal (bt-base64-decode-string mangled) raw)))) - ;; ...all chars. - (let ((mangled (concat encoded bt-whitespace-chars))) - (Assert (equal (bt-base64-decode-string mangled) raw))) +(defconst bt-nonbase64-chars (set-difference (mapcar #'identity bt-allchars) + bt-base64-chars)) - (unless (equal raw "") - ;; Whitespace in the middle - (let* ((middlepos (/ (1+ (length encoded)) 2)) - (left (substring encoded 0 middlepos)) - (right (substring encoded middlepos))) - (dolist (char bt-whitespace-chars) - ;; One char... - (let ((mangled (concat left (list char) right))) - (Assert (equal (bt-base64-decode-string mangled) raw)))) - ;; ...all chars. - (let ((mangled (concat left bt-whitespace-chars right))) - (Assert (equal (bt-base64-decode-string mangled) raw))) +(when nil + ;; This code crashes XEmacs! This requires further investigation. + ;; I'm running Linux, and for me, XEmacs crashes in + ;; Fmapconcat()->mapcar1(), after a GC that thrashes the stack. + ;; Raymond Toy reports a similar crash under Solaris. + (loop for (raw encoded) in bt-test-strings do + (unless (equal raw "") + (let* ((middlepos (/ (1+ (length encoded)) 2)) + (left (substring encoded 0 middlepos)) + (right (substring encoded middlepos))) + ;; Whitespace at the beginning, end, and middle. + (let ((mangled (concat bt-nonbase64-chars left bt-nonbase64-chars right + bt-nonbase64-chars))) + (Assert (equal (bt-base64-decode-string mangled) raw))) - ;; Whitespace at the beginning, end, and middle. - (dolist (char bt-whitespace-chars) - ;; One char... - (let ((mangled (concat (list char) left (list char) right (list char)))) - (Assert (equal (bt-base64-decode-string mangled) raw)))) - ;; ...all chars. - (let ((mangled (concat bt-whitespace-chars left bt-whitespace-chars right - bt-whitespace-chars))) - (Assert (equal (bt-base64-decode-string mangled) raw))) - - ;; Whitespace between every char. - (dolist (char bt-whitespace-chars) - ;; One char... - (let ((mangled (concat (list char) - ;; ENCODED with char between every character. + ;; Whitespace between every char. + (let ((mangled (concat bt-nonbase64-chars + ;; ENCODED with bt-nonbase64-chars + ;; between every character. (mapconcat #'char-to-string encoded - (char-to-string char)) - (list char)))) - (Assert (equal (bt-base64-decode-string mangled) raw)))) - ;; ...all chars. - (let ((mangled (concat bt-whitespace-chars - ;; ENCODED with bt-whitespace-chars - ;; between every character. - (mapconcat #'char-to-string encoded - (apply #'string bt-whitespace-chars)) - bt-whitespace-chars))) + (apply #'string bt-nonbase64-chars)) + bt-nonbase64-chars))) (Assert (equal (bt-base64-decode-string mangled) raw)))))) + ) ;;----------------------------------------------------- ;; Mixed... ;;----------------------------------------------------- -;; The crux of the whole base64 business is to ensure that -;; (base64-decode-string (base64-decode-string FOO)) equals FOO. The -;; following stunts stress-test practically all aspects of the -;; encoding and decoding process. +;; The whole point of base64 is to ensure that an arbitrary sequence +;; of bytes passes through gateway hellfire unscathed, protected by +;; the asbestos suit of base64. Here we test that +;; (base64-decode-string (base64-decode-string FOO)) equals FOO for +;; any FOO we can think of. The following stunts stress-test +;; practically all aspects of the encoding and decoding process. -(loop for (string1 ignored) in bt-test-strings do +(loop for (raw ignored) in bt-test-strings do (Assert (equal (bt-base64-decode-string - (bt-base64-encode-string string1)) - string1)) + (bt-base64-encode-string raw)) + raw)) (Assert (equal (bt-base64-decode-string (bt-base64-decode-string (bt-base64-encode-string - (bt-base64-encode-string string1)))) - string1)) + (bt-base64-encode-string raw)))) + raw)) (Assert (equal (bt-base64-decode-string (bt-base64-decode-string (bt-base64-decode-string (bt-base64-encode-string (bt-base64-encode-string - (bt-base64-encode-string string1)))))) - string1)) + (bt-base64-encode-string raw)))))) + raw)) (Assert (equal (bt-base64-decode-string (bt-base64-decode-string (bt-base64-decode-string @@ -256,8 +233,8 @@ (bt-base64-encode-string (bt-base64-encode-string (bt-base64-encode-string - (bt-base64-encode-string string1)))))))) - string1)) + (bt-base64-encode-string raw)))))))) + raw)) (Assert (equal (bt-base64-decode-string (bt-base64-decode-string (bt-base64-decode-string @@ -267,5 +244,5 @@ (bt-base64-encode-string (bt-base64-encode-string (bt-base64-encode-string - (bt-base64-encode-string string1)))))))))) - string1))) + (bt-base64-encode-string raw)))))))))) + raw)))