Skip to content
Snippets Groups Projects
Commit e5062989 authored by Kevin M. Rosenberg's avatar Kevin M. Rosenberg
Browse files

r5554: *** empty log message ***

parent 4c36b6fb
No related branches found
No related tags found
No related merge requests found
...@@ -7,7 +7,7 @@ ...@@ -7,7 +7,7 @@
;;;; Programmer: Kevin M. Rosenberg ;;;; Programmer: Kevin M. Rosenberg
;;;; Date Started: Dec 2002 ;;;; Date Started: Dec 2002
;;;; ;;;;
;;;; $Id: base64.asd,v 1.22 2003/08/24 20:38:08 kevin Exp $ ;;;; $Id: base64.asd,v 1.23 2003/08/25 16:27:23 kevin Exp $
;;;; ************************************************************************* ;;;; *************************************************************************
(in-package #:cl-user) (in-package #:cl-user)
...@@ -37,12 +37,12 @@ ...@@ -37,12 +37,12 @@
(operate 'test-op 'base64-tests :force t)) (operate 'test-op 'base64-tests :force t))
(defsystem base64-tests (defsystem base64-tests
:depends-on (base64) :depends-on (base64 ptester)
:components :components
((:file "tests"))) ((:file "tests")))
(defmethod perform ((o test-op) (c (eql (find-system 'base64-tests)))) (defmethod perform ((o test-op) (c (eql (find-system 'base64-tests))))
(operate 'load-op 'base64-tests) (operate 'load-op 'base64-tests)
(or (funcall (intern (symbol-name '#:test-base64) (or (funcall (intern (symbol-name '#:do-tests)
(find-package 'base64-test))) (find-package 'base64-test)))
(error "test-op failed"))) (error "test-op failed")))
;;;; -*- Mode: LISP; Syntax: ANSI-Common-Lisp; Base: 10 -*-
;;;; *************************************************************************
;;;; FILE IDENTIFICATION
;;;;
;;;; Name: test.lisp
;;;; Purpose: Regression tests for cl-base64
;;;; Programmer: Kevin M. Rosenberg
;;;; Date Started: Jan 2003
;;;;
;;;; $Id: test.lisp,v 1.3 2003/06/12 14:05:11 kevin Exp $
;;;; *************************************************************************
(in-package #:cl-user)
(defpackage #:base64-test
(:use #:cl #:kmrcl #:base64 #:util.test))
(in-package #:base64-test)
(defun test-base64 ()
(with-tests (:name "cl-base64 tests")
(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=))))))
(defun time-routines ()
(let* ((str "abcdefghijklmnopqwertyu1234589jhwf2ff")
(usb8 (string-to-usb8-array str))
(int 12345678901234567890)
(n 50000))
(time-iterations n (integer-to-base64-string int))
(time-iterations n (excl:integer-to-base64-string int))
(time-iterations n (string-to-base64-string str))
(time-iterations n (excl:usb8-array-to-base64-string usb8))))
;;#+run-test (test-base64)
...@@ -7,56 +7,59 @@ ...@@ -7,56 +7,59 @@
;;;; Programmer: Kevin M. Rosenberg ;;;; Programmer: Kevin M. Rosenberg
;;;; Date Started: Jan 2003 ;;;; Date Started: Jan 2003
;;;; ;;;;
;;;; $Id: tests.lisp,v 1.1 2003/08/24 20:38:08 kevin Exp $ ;;;; $Id: tests.lisp,v 1.2 2003/08/25 16:27:23 kevin Exp $
;;;; ************************************************************************* ;;;; *************************************************************************
(in-package #:cl-user) (in-package #:cl-user)
(defpackage #:base64-test (defpackage #:base64-test
(:use #:cl #:kmrcl #:base64) (:use #:cl #:kmrcl #:base64 #:ptester))
(:export #:test-base64))
(in-package #:base64-test) (in-package #:base64-test)
(defun test-base64 () (defun do-tests ()
(do* ((length 0 (+ 3 length)) (with-tests (:name "cl-base64 tests")
(string (make-string length) (make-string length)) (let ((*break-on-test-failures* t))
(usb8 (make-usb8-array length) (make-usb8-array length)) (do* ((length 0 (+ 3 length))
(integer (random (expt 10 length)) (random (expt 10 length)))) (string (make-string length) (make-string length))
((>= length 300)) (usb8 (make-usb8-array length) (make-usb8-array length))
(dotimes (i length) (integer (random (expt 10 length)) (random (expt 10 length))))
(declare (fixnum i)) ((>= length 300))
(let ((code (random 256))) (dotimes (i length)
(setf (schar string i) (code-char code)) (declare (fixnum i))
(let ((code (random 256)))
(setf (schar string i) (code-char code))
(setf (aref usb8 i) code))) (setf (aref usb8 i) code)))
(do* ((columns 0 (+ columns 4))) (do* ((columns 0 (+ columns 4)))
((> columns length)) ((> columns length))
;; Test against cl-base64 routines ;; Test against cl-base64 routines
(assert (= integer (test integer (base64-string-to-integer
(base64-string-to-integer (integer-to-base64-string integer :columns columns)))
(integer-to-base64-string integer :columns columns)))) (test string (base64-string-to-string
(assert (string= string (string-to-base64-string string :columns columns))
(base64-string-to-string :test #'string=)
(string-to-base64-string string :columns columns))))
;; Test against AllegroCL built-in routines
;; Test against AllegroCL built-in routines #+allegro
#+allegro (progn
(progn (test integer (excl:base64-string-to-integer
(assert (= integer (excl:base64-string-to-integer (integer-to-base64-string integer :columns columns)))
(integer-to-base64-string integer :columns columns)))) (test integer (base64-string-to-integer
(assert (= integer (base64-string-to-integer (excl:integer-to-base64-string integer)))
(excl:integer-to-base64-string integer)))) (test (string-to-base64-string string :columns columns)
(assert (string= (string-to-base64-string string :columns columns) (excl:usb8-array-to-base64-string usb8
(excl:usb8-array-to-base64-string usb8 (if (zerop columns)
(if (zerop columns) nil
nil columns))
columns)))) :test #'string=)
(assert (string= string (base64-string-to-string (test string (base64-string-to-string
(excl:usb8-array-to-base64-string (excl:usb8-array-to-base64-string
usb8 usb8
(if (zerop columns) (if (zerop columns)
nil nil
columns)))))))) columns)))
(format t "~&All tests passed~%") :test #'string=))))))
t) t)
...@@ -66,10 +69,11 @@ ...@@ -66,10 +69,11 @@
(int 12345678901234567890) (int 12345678901234567890)
(n 50000)) (n 50000))
(time-iterations n (integer-to-base64-string int)) (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)) (time-iterations n (string-to-base64-string str))
#+allegro #+allego
(time-iterations n (excl:usb8-array-to-base64-string usb8)))) (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)
0% Loading or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment