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      "QUJDREVGR0hJSktMTU5PUFFSU1RVVldYWVphYmNkZWZnaGlqa2xtbm9wcXJzdHV2d3h5ejAxMjM0
 115 NTY3ODk=")
 116     (,bt-allchars
 117      "AAECAwQFBgcICQoLDA0ODxAREhMUFRYXGBkaGxwdHh8gISIjJCUmJygpKissLS4vMDEyMzQ1Njc4
 118 OTo7PD0+P0BBQkNERUZHSElKS0xNTk9QUVJTVFVWV1hZWltcXV5fYGFiY2RlZmdoaWprbG1ub3Bx
 119 cnN0dXZ3eHl6e3x9fn+AgYKDhIWGh4iJiouMjY6PkJGSk5SVlpeYmZqbnJ2en6ChoqOkpaanqKmq
 120 q6ytrq+wsbKztLW2t7i5uru8vb6/wMHCw8TFxsfIycrLzM3Oz9DR0tPU1dbX2Nna29zd3t/g4eLj
 121 5OXm5+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" ,bt-allchars))
 158   (Assert (eq (bt-base64-decode-string str) nil)))
 159
 160 ;; base64-decode-string is supposed to handle whitespaces anywhere in
 161 ;; the string.  We test this in the cheesis manner possible, by
 162 ;; inserting whitespaces at the beginning, at the end, in the middle
 163 ;; of the string, and mixed.
 164
 165 (defconst bt-whitespace-chars '(?\  ?\t ?\r ?\n ?\f ?\v))
 166
 167 (loop for (raw encoded) in bt-test-strings do
 168   ;; Whitespace at the beginning
 169   (dolist (char bt-whitespace-chars)
 170     ;; One char...
 171     (let ((mangled (concat (list char) encoded)))
 172       (Assert (equal (bt-base64-decode-string mangled) raw))))
 173   ;; ...all chars.
 174   (let ((mangled (concat bt-whitespace-chars encoded)))
 175     (Assert (equal (bt-base64-decode-string mangled) raw)))
 176
 177   ;; Whitespace at the end
 178   (dolist (char bt-whitespace-chars)
 179     ;; One char...
 180     (let ((mangled (concat encoded (list char))))
 181       (Assert (equal (bt-base64-decode-string mangled) raw))))
 182   ;; ...all chars.
 183   (let ((mangled (concat encoded bt-whitespace-chars)))
 184     (Assert (equal (bt-base64-decode-string mangled) raw)))
 185
 186   (unless (equal raw "")
 187     ;; Whitespace in the middle
 188     (let* ((middlepos (/ (1+ (length encoded)) 2))
 189            (left (substring encoded 0 middlepos))
 190            (right (substring encoded middlepos)))
 191       (dolist (char bt-whitespace-chars)
 192         ;; One char...
 193         (let ((mangled (concat left (list char) right)))
 194           (Assert (equal (bt-base64-decode-string mangled) raw))))
 195       ;; ...all chars.
 196       (let ((mangled (concat left bt-whitespace-chars right)))
 197         (Assert (equal (bt-base64-decode-string mangled) raw)))
 198
 199       ;; Whitespace at the beginning, end, and middle.
 200       (dolist (char bt-whitespace-chars)
 201         ;; One char...
 202         (let ((mangled (concat (list char) left (list char) right (list char))))
 203           (Assert (equal (bt-base64-decode-string mangled) raw))))
 204       ;; ...all chars.
 205       (let ((mangled (concat bt-whitespace-chars left bt-whitespace-chars right
 206                              bt-whitespace-chars)))
 207         (Assert (equal (bt-base64-decode-string mangled) raw)))
 208
 209       ;; Whitespace between every char.
 210       (dolist (char bt-whitespace-chars)
 211         ;; One char...
 212         (let ((mangled (concat (list char)
 213                                ;; ENCODED with char between every character.
 214                                (mapconcat #'char-to-string encoded
 215                                           (char-to-string char))
 216                                (list char))))
 217           (Assert (equal (bt-base64-decode-string mangled) raw))))
 218       ;; ...all chars.
 219       (let ((mangled (concat bt-whitespace-chars
 220                              ;; ENCODED with bt-whitespace-chars
 221                              ;; between every character.
 222                              (mapconcat #'char-to-string encoded
 223                                         (apply #'string bt-whitespace-chars))
 224                              bt-whitespace-chars)))
 225           (Assert (equal (bt-base64-decode-string mangled) raw))))))
 226
 227 ;;-----------------------------------------------------
 228 ;; Mixed...
 229 ;;-----------------------------------------------------
 230
 231 ;; The crux of the whole base64 business is to ensure that
 232 ;; (base64-decode-string (base64-decode-string FOO)) equals FOO.  The
 233 ;; following stunts stress-test practically all aspects of the
 234 ;; encoding and decoding process.
 235
 236 (loop for (string1 ignored) in bt-test-strings do
 237   (Assert (equal (bt-base64-decode-string
 238                   (bt-base64-encode-string string1))
 239                  string1))
 240   (Assert (equal (bt-base64-decode-string
 241                   (bt-base64-decode-string
 242                    (bt-base64-encode-string
 243                     (bt-base64-encode-string string1))))
 244                  string1))
 245   (Assert (equal (bt-base64-decode-string
 246                   (bt-base64-decode-string
 247                    (bt-base64-decode-string
 248                     (bt-base64-encode-string
 249                      (bt-base64-encode-string
 250                       (bt-base64-encode-string string1))))))
 251                  string1))
 252   (Assert (equal (bt-base64-decode-string
 253                   (bt-base64-decode-string
 254                    (bt-base64-decode-string
 255                     (bt-base64-decode-string
 256                      (bt-base64-encode-string
 257                       (bt-base64-encode-string
 258                        (bt-base64-encode-string
 259                         (bt-base64-encode-string string1))))))))
 260                  string1))
 261   (Assert (equal (bt-base64-decode-string
 262                   (bt-base64-decode-string
 263                    (bt-base64-decode-string
 264                     (bt-base64-decode-string
 265                      (bt-base64-decode-string
 266                       (bt-base64-encode-string
 267                        (bt-base64-encode-string
 268                         (bt-base64-encode-string
 269                          (bt-base64-encode-string
 270                           (bt-base64-encode-string string1))))))))))
 271                  string1)))