X-Git-Url: http://git.kpe.io/?p=kmrcl.git;a=blobdiff_plain;f=tests.lisp;h=11c7f98758850225bb2a74de7a0be4d068395f7e;hp=0b0daa2d4a709c92720a79a9234a1b3d2b8f6019;hb=54cd6cb1b9550ac2310e2c6dffc9cdecd2bdccd3;hpb=e54afedd9e96a83521d3eb023e1a22051f387ded

diff --git a/tests.lisp b/tests.lisp
index 0b0daa2..11c7f98 100644
--- a/tests.lisp
+++ b/tests.lisp
@@ -1,4 +1,4 @@
-;;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Package: kmrcl-tests -*-
+;;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp -*-
 ;;;; *************************************************************************
 ;;;; FILE IDENTIFICATION
 ;;;;
@@ -7,9 +7,7 @@
 ;;;; 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
 ;;;;
 ;;;; *************************************************************************
 
@@ -362,6 +360,27 @@
      (encode-universal-time 0 0 0 1 11 2000)) nil)
 )
 
+(deftest :sts.1
+    (seconds-to-condensed-time-string 0) "0s")
+(deftest :sts.2
+    (seconds-to-condensed-time-string 60) "1m0s")
+(deftest :sts.3
+    (seconds-to-condensed-time-string 65) "1m5s")
+(deftest :sts.4
+    (seconds-to-condensed-time-string 3600) "1h0m0s")
+(deftest :sts.5
+    (seconds-to-condensed-time-string 36000) "10h0m0s")
+(deftest :sts.6
+    (seconds-to-condensed-time-string 86400) "1d0h0m0s")
+(deftest :sts.7
+    (seconds-to-condensed-time-string (* 7 86400)) "1w0d0h0m0s")
+(deftest :sts.8
+    (seconds-to-condensed-time-string (* 21 86400)) "3w0d0h0m0s")
+(deftest :sts.9
+    (seconds-to-condensed-time-string (+ 86400 7200 120 50 (* 21 86400))) "3w1d2h2m50s")
+(deftest :sts.10
+    (seconds-to-condensed-time-string (+ .1 86400 7200 120 50 (* 21 86400))
+                                      :dp-digits 1) "3w1d2h2m50.1s")
 
 (deftest :ekdc.1
     (ensure-keyword-default-case (read-from-string "TYPE")) :type)
@@ -438,7 +457,55 @@
 
 (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