cgit.sxemacs.org Git - sxemacs/blob - tests/automated/base64-tests.el

   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 SXEmacs.
   9
  10 ;; SXEmacs is free software: you can redistribute it and/or modify it
  11 ;; under the terms of the GNU General Public License as published by the
  12 ;; Free Software Foundation, either version 3 of the License, or (at your
  13 ;; option) any later version.
  14
  15 ;; SXEmacs is distributed in the hope that it will be
  16 ;; useful, but 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 this program.  If not, see <http://www.gnu.org/licenses/>.
  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))
  53       (Assert (eq length (- (point-max) (point-min))))
  54       (Assert-Equal (buffer-string) string-result)
  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))
  63         (Assert (eq length (- p2 p1)))
  64         (Assert-Equal (buffer-substring p1 p2) string-result)))
  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
  76              (Assert (eq length (- (point-max) (point-min))))
  77              (Assert-Equal (buffer-string) string-result))
  78             (t
  79              (Assert (null length))
  80              ;; The buffer should not have been modified.
  81              (Assert-Equal (buffer-string) string)))
  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
  91                (Assert (eq length (- p2 p1)))
  92                (Assert-Equal (buffer-substring p1 p2) string-result))
  93               (t
  94                (Assert (null length))
  95                ;; The buffer should not have been modified.
  96                (Assert-Equal (buffer-substring p1 p2) string)))))
  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
 127   (Assert-Equal (bt-base64-encode-string raw) encoded)
 128   ;; test the NO-LINE-BREAK flag
 129   (Assert-Equal (bt-base64-encode-string raw t) (bt-remove-newlines encoded)))
 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
 151   (Assert-Equal (bt-base64-decode-string encoded) raw)
 152   (Assert-Equal (bt-base64-decode-string (bt-remove-newlines encoded)) raw))
 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
 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)))
 183         (Assert-Equal (bt-base64-decode-string mangled) raw))
 184
 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)))
 192         (Assert-Equal (bt-base64-decode-string mangled) raw)))))
 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
 206   (Assert-Equal (bt-base64-decode-string
 207                   (bt-base64-encode-string raw))
 208                  raw)
 209   (Assert-Equal (bt-base64-decode-string
 210                   (bt-base64-decode-string
 211                    (bt-base64-encode-string
 212                     (bt-base64-encode-string raw))))
 213                  raw)
 214   (Assert-Equal (bt-base64-decode-string
 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))))))
 220                  raw)
 221   (Assert-Equal (bt-base64-decode-string
 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))))))))
 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-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))))))))))
 240                  raw))