git.chise.org Git - chise/xemacs-chise.git.1/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 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 (loop for (raw encoded) in bt-test-strings do
 178   (unless (equal raw "")
 179     (let* ((middlepos (/ (1+ (length encoded)) 2))
 180            (left (substring encoded 0 middlepos))
 181            (right (substring encoded middlepos)))
 182       ;; Whitespace at the beginning, end, and middle.
 183       (let ((mangled (concat bt-nonbase64-chars left bt-nonbase64-chars right
 184                              bt-nonbase64-chars)))
 185         (Assert (equal (bt-base64-decode-string mangled) raw)))
 186
 187       ;; Whitespace between every char.
 188       (let ((mangled (concat bt-nonbase64-chars
 189                              ;; ENCODED with bt-nonbase64-chars
 190                              ;; between every character.
 191                              (mapconcat #'char-to-string encoded
 192                                         (apply #'string bt-nonbase64-chars))
 193                              bt-nonbase64-chars)))
 194         (Assert (equal (bt-base64-decode-string mangled) raw))))))
 195
 196 ;;-----------------------------------------------------
 197 ;; Mixed...
 198 ;;-----------------------------------------------------
 199
 200 ;; The whole point of base64 is to ensure that an arbitrary sequence
 201 ;; of bytes passes through gateway hellfire unscathed, protected by
 202 ;; the asbestos suit of base64.  Here we test that
 203 ;; (base64-decode-string (base64-decode-string FOO)) equals FOO for
 204 ;; any FOO we can think of.  The following stunts stress-test
 205 ;; practically all aspects of the encoding and decoding process.
 206
 207 (loop for (raw ignored) in bt-test-strings do
 208   (Assert (equal (bt-base64-decode-string
 209                   (bt-base64-encode-string raw))
 210                  raw))
 211   (Assert (equal (bt-base64-decode-string
 212                   (bt-base64-decode-string
 213                    (bt-base64-encode-string
 214                     (bt-base64-encode-string raw))))
 215                  raw))
 216   (Assert (equal (bt-base64-decode-string
 217                   (bt-base64-decode-string
 218                    (bt-base64-decode-string
 219                     (bt-base64-encode-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-decode-string
 227                      (bt-base64-encode-string
 228                       (bt-base64-encode-string
 229                        (bt-base64-encode-string
 230                         (bt-base64-encode-string raw))))))))
 231                  raw))
 232   (Assert (equal (bt-base64-decode-string
 233                   (bt-base64-decode-string
 234                    (bt-base64-decode-string
 235                     (bt-base64-decode-string
 236                      (bt-base64-decode-string
 237                       (bt-base64-encode-string
 238                        (bt-base64-encode-string
 239                         (bt-base64-encode-string
 240                          (bt-base64-encode-string
 241                           (bt-base64-encode-string raw))))))))))
 242                  raw)))