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 (when nil
 178   ;; This code crashes XEmacs!  This requires further investigation.
 179   ;; I'm running Linux, and for me, XEmacs crashes in
 180   ;; Fmapconcat()->mapcar1(), after a GC that thrashes the stack.
 181   ;; Raymond Toy reports a similar crash under Solaris.
 182   (loop for (raw encoded) in bt-test-strings do
 183     (unless (equal raw "")
 184       (let* ((middlepos (/ (1+ (length encoded)) 2))
 185              (left (substring encoded 0 middlepos))
 186              (right (substring encoded middlepos)))
 187         ;; Whitespace at the beginning, end, and middle.
 188         (let ((mangled (concat bt-nonbase64-chars left bt-nonbase64-chars right
 189                                bt-nonbase64-chars)))
 190           (Assert (equal (bt-base64-decode-string mangled) raw)))
 191
 192         ;; Whitespace between every char.
 193         (let ((mangled (concat bt-nonbase64-chars
 194                                ;; ENCODED with bt-nonbase64-chars
 195                                ;; between every character.
 196                                (mapconcat #'char-to-string encoded
 197                                           (apply #'string bt-nonbase64-chars))
 198                                bt-nonbase64-chars)))
 199           (Assert (equal (bt-base64-decode-string mangled) raw))))))
 200   )
 201
 202 ;;-----------------------------------------------------
 203 ;; Mixed...
 204 ;;-----------------------------------------------------
 205
 206 ;; The whole point of base64 is to ensure that an arbitrary sequence
 207 ;; of bytes passes through gateway hellfire unscathed, protected by
 208 ;; the asbestos suit of base64.  Here we test that
 209 ;; (base64-decode-string (base64-decode-string FOO)) equals FOO for
 210 ;; any FOO we can think of.  The following stunts stress-test
 211 ;; practically all aspects of the encoding and decoding process.
 212
 213 (loop for (raw ignored) in bt-test-strings do
 214   (Assert (equal (bt-base64-decode-string
 215                   (bt-base64-encode-string raw))
 216                  raw))
 217   (Assert (equal (bt-base64-decode-string
 218                   (bt-base64-decode-string
 219                    (bt-base64-encode-string
 220                     (bt-base64-encode-string raw))))
 221                  raw))
 222   (Assert (equal (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 raw))))))
 228                  raw))
 229   (Assert (equal (bt-base64-decode-string
 230                   (bt-base64-decode-string
 231                    (bt-base64-decode-string
 232                     (bt-base64-decode-string
 233                      (bt-base64-encode-string
 234                       (bt-base64-encode-string
 235                        (bt-base64-encode-string
 236                         (bt-base64-encode-string raw))))))))
 237                  raw))
 238   (Assert (equal (bt-base64-decode-string
 239                   (bt-base64-decode-string
 240                    (bt-base64-decode-string
 241                     (bt-base64-decode-string
 242                      (bt-base64-decode-string
 243                       (bt-base64-encode-string
 244                        (bt-base64-encode-string
 245                         (bt-base64-encode-string
 246                          (bt-base64-encode-string
 247                           (bt-base64-encode-string raw))))))))))
 248                  raw)))