X-Git-Url: http://git.kpe.io/?p=cl-base64.git;a=blobdiff_plain;f=tests.lisp;h=927e4b8c606c4bd270e58f236b3b42137d394068;hp=dbe0741720db6c952f1f3fbe756e41f5e26bba83;hb=refs%2Ftags%2Fdebian-3.3.3-2;hpb=4c36b6fb82218be5911fb8aebc99d507e73cbdd6 diff --git a/tests.lisp b/tests.lisp index dbe0741..927e4b8 100644 --- a/tests.lisp +++ b/tests.lisp @@ -7,69 +7,73 @@ ;;;; 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-tests + (:use #:cl #:kmrcl #:cl-base64 #:ptester)) + +(in-package #:cl-base64-tests) + +(defun do-tests () + (with-tests (:name "cl-base64 tests") + (let ((*break-on-test-failures* t)) + (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 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)) + (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)) (time-iterations n (string-to-base64-string str)) - #+allegro - (time-iterations n (excl:usb8-array-to-base64-string usb8)))) + #+allego + (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)