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$
  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)