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.2 2003/04/15 15:44:07 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
  64
  65 (defun time-routines ()
  66   (let* ((str "abcdefghijklmnopqwertyu1234589jhwf2ff")
  67          (usb8 (string-to-usb8-array str))
  68          (int 12345678901234567890)
  69          (n 50000))
  70     (time-iterations n (integer-to-base64-string int))
  71     (time-iterations n (excl:integer-to-base64-string int))
  72     (time-iterations n (string-to-base64-string str))
  73     (time-iterations n (excl:usb8-array-to-base64-string usb8))))
  74
  75
  76 ;;#+run-test (test-base64)