| 1 |
;;;; -*- Mode: LISP; Syntax: ANSI-Common-Lisp; Base: 10 -*- |
|---|
| 2 |
;;;; ************************************************************************* |
|---|
| 3 |
;;;; FILE IDENTIFICATION |
|---|
| 4 |
;;;; |
|---|
| 5 |
;;;; Name: test.lisp |
|---|
| 6 |
;;;; Purpose: Regression tests for cl-base64 |
|---|
| 7 |
;;;; Programmer: Kevin M. Rosenberg |
|---|
| 8 |
;;;; Date Started: Jan 2003 |
|---|
| 9 |
;;;; |
|---|
| 10 |
;;;; $Id: tests.lisp 9055 2004-04-18 16:49:36Z kevin $ |
|---|
| 11 |
;;;; ************************************************************************* |
|---|
| 12 |
|
|---|
| 13 |
(in-package #:cl-user) |
|---|
| 14 |
|
|---|
| 15 |
(defpackage #:cl-base64-tests |
|---|
| 16 |
(:use #:cl #:kmrcl #:cl-base64 #:ptester)) |
|---|
| 17 |
|
|---|
| 18 |
(in-package #:cl-base64-tests) |
|---|
| 19 |
|
|---|
| 20 |
(defun do-tests () |
|---|
| 21 |
(with-tests (:name "cl-base64 tests") |
|---|
| 22 |
(let ((*break-on-test-failures* t)) |
|---|
| 23 |
(do* ((length 0 (+ 3 length)) |
|---|
| 24 |
(string (make-string length) (make-string length)) |
|---|
| 25 |
(usb8 (make-usb8-array length) (make-usb8-array length)) |
|---|
| 26 |
(integer (random (expt 10 length)) (random (expt 10 length)))) |
|---|
| 27 |
((>= length 300)) |
|---|
| 28 |
(dotimes (i length) |
|---|
| 29 |
(declare (fixnum i)) |
|---|
| 30 |
(let ((code (random 256))) |
|---|
| 31 |
(setf (schar string i) (code-char code)) |
|---|
| 32 |
(setf (aref usb8 i) code))) |
|---|
| 33 |
|
|---|
| 34 |
(do* ((columns 0 (+ columns 4))) |
|---|
| 35 |
((> columns length)) |
|---|
| 36 |
;; Test against cl-base64 routines |
|---|
| 37 |
(test integer (base64-string-to-integer |
|---|
| 38 |
(integer-to-base64-string integer :columns columns))) |
|---|
| 39 |
(test string (base64-string-to-string |
|---|
| 40 |
(string-to-base64-string string :columns columns)) |
|---|
| 41 |
:test #'string=) |
|---|
| 42 |
|
|---|
| 43 |
;; Test against AllegroCL built-in routines |
|---|
| 44 |
#+allegro |
|---|
| 45 |
(progn |
|---|
| 46 |
(test integer (excl:base64-string-to-integer |
|---|
| 47 |
(integer-to-base64-string integer :columns columns))) |
|---|
| 48 |
(test integer (base64-string-to-integer |
|---|
| 49 |
(excl:integer-to-base64-string integer))) |
|---|
| 50 |
(test (string-to-base64-string string :columns columns) |
|---|
| 51 |
(excl:usb8-array-to-base64-string usb8 |
|---|
| 52 |
(if (zerop columns) |
|---|
| 53 |
nil |
|---|
| 54 |
columns)) |
|---|
| 55 |
:test #'string=) |
|---|
| 56 |
(test string (base64-string-to-string |
|---|
| 57 |
(excl:usb8-array-to-base64-string |
|---|
| 58 |
usb8 |
|---|
| 59 |
(if (zerop columns) |
|---|
| 60 |
nil |
|---|
| 61 |
columns))) |
|---|
| 62 |
:test #'string=)))))) |
|---|
| 63 |
t) |
|---|
| 64 |
|
|---|
| 65 |
|
|---|
| 66 |
(defun time-routines () |
|---|
| 67 |
(let* ((str "abcdefghijklmnopqwertyu1234589jhwf2ff") |
|---|
| 68 |
(usb8 (string-to-usb8-array str)) |
|---|
| 69 |
(int 12345678901234567890) |
|---|
| 70 |
(n 50000)) |
|---|
| 71 |
(time-iterations n (integer-to-base64-string int)) |
|---|
| 72 |
(time-iterations n (string-to-base64-string str)) |
|---|
| 73 |
#+allego |
|---|
| 74 |
(progn |
|---|
| 75 |
(time-iterations n (excl:integer-to-base64-string int)) |
|---|
| 76 |
(time-iterations n (excl:usb8-array-to-base64-string usb8))))) |
|---|
| 77 |
|
|---|
| 78 |
|
|---|
| 79 |
;;#+run-test (test-base64) |
|---|