1 ;;;; -*- Mode: LISP; Syntax: ANSI-Common-Lisp; Base: 10 -*-
2 ;;;; *************************************************************************
3 ;;;; FILE IDENTIFICATION
6 ;;;; Purpose: Regression tests for cl-base64
7 ;;;; Programmer: Kevin M. Rosenberg
8 ;;;; Date Started: Jan 2003
11 ;;;; *************************************************************************
13 (in-package #:cl-user)
15 (defpackage #:cl-base64/test
16 (:use #:cl #:kmrcl #:cl-base64 #:ptester))
18 (in-package #:cl-base64/test)
20 (defun test-valid-input (exp input)
21 (test exp (base64-string-to-usb8-array input) :test #'equalp))
23 (defun test-broken-input (arg)
24 (let ((.hole. (make-broadcast-stream)))
25 (test-error (base64-string-to-usb8-array arg)
26 :condition-type 'base64-error
28 (test-error (base64-string-to-string arg)
29 :condition-type 'base64-error
31 (test-error (base64-string-to-integer arg)
32 :condition-type 'base64-error
34 (test-error (base64-string-to-stream arg :stream .hole.)
35 :condition-type 'base64-error
37 (test-error (with-input-from-string (in arg)
38 (base64-stream-to-usb8-array in))
39 :condition-type 'base64-error
41 (test-error (with-input-from-string (in arg)
42 (base64-stream-to-string in))
43 :condition-type 'base64-error
45 (test-error (with-input-from-string (in arg)
46 (base64-stream-to-stream in :stream .hole.))
47 :condition-type 'base64-error
49 (test-error (with-input-from-string (in arg)
50 (base64-stream-to-integer in))
51 :condition-type 'base64-error
52 :include-subtypes t)))
55 (test-valid-input #(0) "AA==")
56 (test-valid-input #(0 0) "AAA=")
57 (test-valid-input #(0 0 0) "AAAA")
58 (test-valid-input #(0) " A A = = ")
59 (test-valid-input #(0 0) " A A A = ")
60 (test-valid-input #(0 0 0) " A A A A "))
62 (defun test-broken-1 ()
63 (test-broken-input "A")
64 (test-broken-input "AA")
65 (test-broken-input "AAA")
66 (test-broken-input "AA=")
67 (test-broken-input "A==")
68 (test-broken-input "A===")
69 (test-broken-input "AA===")
70 (test-broken-input "AAA===")
71 (test-broken-input "AAA==")
72 (test-broken-input "A=A")
73 (test-broken-input "AA=A")
74 (test-broken-input "AAA=A")
75 (test-broken-input "A==A"))
77 (defun test-broken-2 ()
78 (flet ((test-invalid-char (char)
79 (test-broken-input (format nil "~C" char))
80 (test-broken-input (format nil "A~C" char))
81 (test-broken-input (format nil "AA~C" char))
82 (test-broken-input (format nil "AAA~C" char))
83 (test-broken-input (format nil "AAAA~C" char))
84 (test-broken-input (format nil "AAA=~C" char))
85 (test-broken-input (format nil "AA==~C" char))))
86 (test-invalid-char #\$)
87 (test-invalid-char (code-char 0))
88 (test-invalid-char (code-char 256))))
90 (defun do-tests (&key ((:break-on-failures *break-on-test-failures*) nil))
91 (with-tests (:name "cl-base64 tests")
95 (do* ((length 0 (+ 3 length))
96 (string (make-string length) (make-string length))
97 (usb8 (make-usb8-array length) (make-usb8-array length))
98 (integer (random (expt 10 length)) (random (expt 10 length))))
102 (let ((code (random 256)))
103 (setf (schar string i) (code-char code))
104 (setf (aref usb8 i) code)))
106 (do* ((columns 0 (+ columns 4)))
108 ;; Test against cl-base64 routines
109 (test integer (base64-string-to-integer
110 (integer-to-base64-string integer :columns columns)))
111 (test string (base64-string-to-string
112 (string-to-base64-string string :columns columns))
114 (test usb8 (base64-string-to-usb8-array
115 (usb8-array-to-base64-string usb8))
118 ;; Test against AllegroCL built-in routines
121 (test integer (excl:base64-string-to-integer
122 (integer-to-base64-string integer :columns columns)))
123 (test integer (base64-string-to-integer
124 (excl:integer-to-base64-string integer)))
125 (test (string-to-base64-string string :columns columns)
126 (excl:usb8-array-to-base64-string usb8
131 (test string (base64-string-to-string
132 (excl:usb8-array-to-base64-string
141 (defun time-routines (&key (iterations nil)
144 (assert (zerop (rem length 4)) (length))
145 (assert (<= 0 padding 2) (padding))
146 (let* ((str (make-string length :initial-element #\q))
147 (usb8 (map '(simple-array (unsigned-byte 8) (*)) #'char-code str))
148 (int 12345678901234567890)
149 (n (or iterations (ceiling (* 32 1024 1024) length))))
150 (loop for i downfrom (1- length)
152 do (setf (aref str i) #\=))
153 (time-iterations 50000 (integer-to-base64-string int))
154 (time-iterations n (string-to-base64-string str))
155 (time-iterations n (usb8-array-to-base64-string usb8))
157 (let ((displaced (make-array (length str)
159 :element-type (array-element-type str)))
160 (base (coerce str 'simple-base-string)))
161 (time-iterations n (base64-string-to-usb8-array displaced))
162 (time-iterations n (base64-string-to-usb8-array str))
163 (time-iterations n (base64-string-to-usb8-array base)))
167 (time-iterations n (excl:integer-to-base64-string int))
168 (time-iterations n (excl:usb8-array-to-base64-string usb8)))))
171 ;;#+run-test (test-base64)