r4494: Auto commit for Debian build
[cl-base64.git] / base64-tests.lisp
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: base64-tests.lisp,v 1.7 2003/04/15 16:12:01 kevin Exp $
11 ;;;; *************************************************************************
12
13 (in-package :cl-user)
14
15 (defpackage #:base64-test
16     (:use #:cl #:kmrcl #:base64 #:util.test))
17
18 (in-package #:base64-test)
19
20 (defun test-base64 ()
21   (setq *break-on-test-failures* t) 
22   (with-tests (:name "cl-base64 tests")
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 (excl:integer-to-base64-string int))
73     (time-iterations n (string-to-base64-string str))
74     (time-iterations n (excl:usb8-array-to-base64-string usb8))))
75
76 (export 'test-base64)      
77 ;;(test-base64)