;;;; Programmer: Kevin M. Rosenberg
;;;; Date Started: Jan 2003
;;;;
-;;;; $Id: tests.lisp,v 1.1 2003/08/24 20:38:08 kevin Exp $
+;;;; $Id$
;;;; *************************************************************************
(in-package #:cl-user)
-(defpackage #:base64-test
- (:use #:cl #:kmrcl #:base64)
- (:export #:test-base64))
-(in-package #:base64-test)
-
-(defun test-base64 ()
- (do* ((length 0 (+ 3 length))
- (string (make-string length) (make-string length))
- (usb8 (make-usb8-array length) (make-usb8-array length))
- (integer (random (expt 10 length)) (random (expt 10 length))))
- ((>= length 300))
- (dotimes (i length)
- (declare (fixnum i))
- (let ((code (random 256)))
- (setf (schar string i) (code-char code))
- (setf (aref usb8 i) code)))
-
- (do* ((columns 0 (+ columns 4)))
- ((> columns length))
- ;; Test against cl-base64 routines
- (assert (= integer
- (base64-string-to-integer
- (integer-to-base64-string integer :columns columns))))
- (assert (string= string
- (base64-string-to-string
- (string-to-base64-string string :columns columns))))
-
- ;; Test against AllegroCL built-in routines
- #+allegro
- (progn
- (assert (= integer (excl:base64-string-to-integer
- (integer-to-base64-string integer :columns columns))))
- (assert (= integer (base64-string-to-integer
- (excl:integer-to-base64-string integer))))
- (assert (string= (string-to-base64-string string :columns columns)
- (excl:usb8-array-to-base64-string usb8
- (if (zerop columns)
- nil
- columns))))
- (assert (string= string (base64-string-to-string
- (excl:usb8-array-to-base64-string
- usb8
- (if (zerop columns)
- nil
- columns))))))))
- (format t "~&All tests passed~%")
+
+(defpackage #:cl-base64/test
+ (:use #:cl #:kmrcl #:cl-base64 #:ptester))
+
+(in-package #:cl-base64/test)
+
+(defun test-valid-input (exp input)
+ (test exp (base64-string-to-usb8-array input) :test #'equalp))
+
+(defun test-broken-input (arg)
+ (let ((.hole. (make-broadcast-stream)))
+ (test-error (base64-string-to-usb8-array arg)
+ :condition-type 'base64-error
+ :include-subtypes t)
+ (test-error (base64-string-to-string arg)
+ :condition-type 'base64-error
+ :include-subtypes t)
+ (test-error (base64-string-to-integer arg)
+ :condition-type 'base64-error
+ :include-subtypes t)
+ (test-error (base64-string-to-stream arg :stream .hole.)
+ :condition-type 'base64-error
+ :include-subtypes t)
+ (test-error (with-input-from-string (in arg)
+ (base64-stream-to-usb8-array in))
+ :condition-type 'base64-error
+ :include-subtypes t)
+ (test-error (with-input-from-string (in arg)
+ (base64-stream-to-string in))
+ :condition-type 'base64-error
+ :include-subtypes t)
+ (test-error (with-input-from-string (in arg)
+ (base64-stream-to-stream in :stream .hole.))
+ :condition-type 'base64-error
+ :include-subtypes t)
+ (test-error (with-input-from-string (in arg)
+ (base64-stream-to-integer in))
+ :condition-type 'base64-error
+ :include-subtypes t)))
+
+(defun test-valid ()
+ (test-valid-input #(0) "AA==")
+ (test-valid-input #(0 0) "AAA=")
+ (test-valid-input #(0 0 0) "AAAA")
+ (test-valid-input #(0) " A A = = ")
+ (test-valid-input #(0 0) " A A A = ")
+ (test-valid-input #(0 0 0) " A A A A "))
+
+(defun test-broken-1 ()
+ (test-broken-input "A")
+ (test-broken-input "AA")
+ (test-broken-input "AAA")
+ (test-broken-input "AA=")
+ (test-broken-input "A==")
+ (test-broken-input "A===")
+ (test-broken-input "AA===")
+ (test-broken-input "AAA===")
+ (test-broken-input "AAA==")
+ (test-broken-input "A=A")
+ (test-broken-input "AA=A")
+ (test-broken-input "AAA=A")
+ (test-broken-input "A==A"))
+
+(defun test-broken-2 ()
+ (flet ((test-invalid-char (char)
+ (test-broken-input (format nil "~C" char))
+ (test-broken-input (format nil "A~C" char))
+ (test-broken-input (format nil "AA~C" char))
+ (test-broken-input (format nil "AAA~C" char))
+ (test-broken-input (format nil "AAAA~C" char))
+ (test-broken-input (format nil "AAA=~C" char))
+ (test-broken-input (format nil "AA==~C" char))))
+ (test-invalid-char #\$)
+ (test-invalid-char (code-char 0))
+ (test-invalid-char (code-char 256))))
+
+(defun do-tests (&key ((:break-on-failures *break-on-test-failures*) nil))
+ (with-tests (:name "cl-base64 tests")
+ (test-valid)
+ (test-broken-1)
+ (test-broken-2)
+ (do* ((length 0 (+ 3 length))
+ (string (make-string length) (make-string length))
+ (usb8 (make-usb8-array length) (make-usb8-array length))
+ (integer (random (expt 10 length)) (random (expt 10 length))))
+ ((>= length 300))
+ (dotimes (i length)
+ (declare (fixnum i))
+ (let ((code (random 256)))
+ (setf (schar string i) (code-char code))
+ (setf (aref usb8 i) code)))
+
+ (do* ((columns 0 (+ columns 4)))
+ ((> columns length))
+ ;; Test against cl-base64 routines
+ (test integer (base64-string-to-integer
+ (integer-to-base64-string integer :columns columns)))
+ (test string (base64-string-to-string
+ (string-to-base64-string string :columns columns))
+ :test #'string=)
+ (test usb8 (base64-string-to-usb8-array
+ (usb8-array-to-base64-string usb8))
+ :test #'equalp)
+
+ ;; Test against AllegroCL built-in routines
+ #+allegro
+ (progn
+ (test integer (excl:base64-string-to-integer
+ (integer-to-base64-string integer :columns columns)))
+ (test integer (base64-string-to-integer
+ (excl:integer-to-base64-string integer)))
+ (test (string-to-base64-string string :columns columns)
+ (excl:usb8-array-to-base64-string usb8
+ (if (zerop columns)
+ nil
+ columns))
+ :test #'string=)
+ (test string (base64-string-to-string
+ (excl:usb8-array-to-base64-string
+ usb8
+ (if (zerop columns)
+ nil
+ columns)))
+ :test #'string=)))))
t)
-(defun time-routines ()
- (let* ((str "abcdefghijklmnopqwertyu1234589jhwf2ff")
- (usb8 (string-to-usb8-array str))
- (int 12345678901234567890)
- (n 50000))
- (time-iterations n (integer-to-base64-string int))
- #+allegro
- (time-iterations n (excl:integer-to-base64-string int))
+(defun time-routines (&key (iterations nil)
+ (length 256)
+ (padding 0))
+ (assert (zerop (rem length 4)) (length))
+ (assert (<= 0 padding 2) (padding))
+ (let* ((str (make-string length :initial-element #\q))
+ (usb8 (map '(simple-array (unsigned-byte 8) (*)) #'char-code str))
+ (int 12345678901234567890)
+ (n (or iterations (ceiling (* 32 1024 1024) length))))
+ (loop for i downfrom (1- length)
+ repeat padding
+ do (setf (aref str i) #\=))
+ (time-iterations 50000 (integer-to-base64-string int))
(time-iterations n (string-to-base64-string str))
+ (time-iterations n (usb8-array-to-base64-string usb8))
+
+ (let ((displaced (make-array (length str)
+ :displaced-to str
+ :element-type (array-element-type str)))
+ (base (coerce str 'simple-base-string)))
+ (time-iterations n (base64-string-to-usb8-array displaced))
+ (time-iterations n (base64-string-to-usb8-array str))
+ (time-iterations n (base64-string-to-usb8-array base)))
+
#+allegro
- (time-iterations n (excl:usb8-array-to-base64-string usb8))))
+ (progn
+ (time-iterations n (excl:integer-to-base64-string int))
+ (time-iterations n (excl:usb8-array-to-base64-string usb8)))))
+
-;;(test-base64)
+;;#+run-test (test-base64)
projects / cl-base64.git / blobdiff