-;;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Package: kmrcl-tests -*-
+;;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp -*-
;;;; *************************************************************************
;;;; FILE IDENTIFICATION
;;;;
;;;; Author: Kevin M. Rosenberg
;;;; Date Started: Apr 2003
;;;;
-;;;; $Id$
-;;;;
-;;;; This file is Copyright (c) 2000-2006 by Kevin M. Rosenberg
+;;;; This file is Copyright (c) 2000-2010 by Kevin M. Rosenberg
;;;;
;;;; *************************************************************************
(deftest :sse.4 (string-strip-ending "abc" '("ab")) "abc")
(deftest :sse.5 (string-strip-ending "abcd" '("a" "cd")) "ab")
+(deftest :rcs.1 (remove-char-string #\space "") "")
+(deftest :rcs.2 (remove-char-string #\space "a") "a")
+(deftest :rcs.3 (remove-char-string #\space "ab") "ab")
+(deftest :rcs.4 (remove-char-string #\space "a b") "ab")
+(deftest :rcs.5 (remove-char-string #\space " a b") "ab")
+(deftest :rcs.6 (remove-char-string #\space "a b ") "ab")
+(deftest :rcs.7 (remove-char-string #\space "a b c ") "abc")
+(deftest :rcs.8 (remove-char-string #\space "a b c d") "abcd")
+
(defun test-color-conversion ()
(dotimes (ih 11)
(deftest :pis.4 (prefixed-integer-string 234134 #\C 7) "C0234134")
- ;;; MOP Testing
+;;; Binary tree search tests
+
+(defvar *btree-vector*)
+
+(defun init-btree-vector (len)
+ (make-random-state t)
+ (setq *btree-vector* (make-array (list len)
+ :element-type 'fixnum
+ :initial-element 0))
+ (dotimes (i (length *btree-vector*))
+ (do ((rand (random most-positive-fixnum) (random most-positive-fixnum)))
+ ((not (find rand *btree-vector* :end i))
+ (setf (aref *btree-vector* i) rand))))
+ (setq *btree-vector* (sort *btree-vector* #'<)))
+
+(defun test-btree-vector (len)
+ (init-btree-vector len)
+ (dotimes (i (length *btree-vector*) t)
+ (let ((stored (aref *btree-vector* i)))
+ (multiple-value-bind (pos value last-pos count)
+ (sorted-vector-find stored *btree-vector*)
+ (declare (ignore last-pos))
+ (when (or (not (eql i pos)) (not (eql stored value)))
+ (format t "~&Error: btree value ~D at pos ~D: found ~D at pos ~D [count ~D].~%"
+ stored i value pos count)
+ (return nil))))))
+
+(deftest :btree.1
+ (dotimes (i 1000 t)
+ (test-btree-vector i))
+ t)
+
+(defun time-btree (&optional (fn #'sorted-vector-find) (return-on-error nil))
+ (time
+ (let ((total-count 0))
+ (declare (fixnum total-count))
+ (dotimes (i (length *btree-vector*) t)
+ (let ((stored (aref *btree-vector* i)))
+ (multiple-value-bind (value pos count)
+ (funcall fn stored *btree-vector*)
+ (incf total-count count)
+ (when (or (/= i pos) (/= stored value))
+ (format t "~&Error: btree value ~D at pos ~D: found ~D at pos ~D [count ~D].~%"
+ stored i value pos count)
+ (when return-on-error
+ (return-from time-btree nil))))))
+ (float (/ total-count (length *btree-vector*))))))
+
+;;; MOP Testing
;; Disable attrib class until understand changes in sbcl/cmucl
;; using COMPUTE-SLOT-ACCESSOR-INFO and defining method