X-Git-Url: http://git.kpe.io/?p=kmrcl.git;a=blobdiff_plain;f=tests.lisp;h=0b0daa2d4a709c92720a79a9234a1b3d2b8f6019;hp=9a84a7b67f96eec72ee7ffc5cd45922462cb0b84;hb=888acd079f2e1350ba5f034cb5c93382311e3ff3;hpb=b43594669e466089305948a40cfacd1b63b0767a diff --git a/tests.lisp b/tests.lisp index 9a84a7b..0b0daa2 100644 --- a/tests.lisp +++ b/tests.lisp @@ -9,7 +9,7 @@ ;;;; ;;;; $Id$ ;;;; -;;;; This file is Copyright (c) 2000-2002 by Kevin M. Rosenberg +;;;; This file is Copyright (c) 2000-2006 by Kevin M. Rosenberg ;;;; ;;;; ************************************************************************* @@ -17,7 +17,7 @@ (defpackage #:kmrcl-tests (:use #:kmrcl #:cl #:rtest)) (in-package #:kmrcl-tests) - + (rem-all-tests) @@ -45,9 +45,9 @@ (deftest :str.17 (nstring-trim-last-character "ab") "a") (deftest :str.18 (delimited-string-to-list "ab|cd|ef" #\|) - ("ab" "cd" "ef")) + ("ab" "cd" "ef")) (deftest :str.19 (delimited-string-to-list "ab|cd|ef" #\| t) - ("ab" "cd" "ef")) + ("ab" "cd" "ef")) (deftest :str.20 (delimited-string-to-list "") ("")) (deftest :str.21 (delimited-string-to-list "" #\space t) ("")) (deftest :str.22 (delimited-string-to-list "ab") ("ab")) @@ -64,13 +64,29 @@ (deftest :sdstl.4 (string-delimited-string-to-list "ab|cd|ef" "ab") ("" "|cd|ef")) +(deftest :hexstr.1 (binary-sequence-to-hex-string ()) + "") + +(deftest :hexstr.2 (binary-sequence-to-hex-string #()) + "") + +(deftest :hexstr.3 (binary-sequence-to-hex-string #(165)) + "a5" +) + +(deftest :hexstr.4 (binary-sequence-to-hex-string (list 165)) + "a5") + +(deftest :hexstr.5 (binary-sequence-to-hex-string #(165 86)) + "a556") + (deftest :apsl.1 (append-sublists '((a b) (c d))) (a b c d)) (deftest :apsl.2 (append-sublists nil) nil) (deftest :apsl.3 (append-sublists '((a b))) (a b)) (deftest :apsl.4 (append-sublists '((a))) (a)) (deftest :apsl.5 (append-sublists '((a) (b) (c d (e f g)))) (a b c d (e f g))) -(deftest :pss.0 (with-output-to-string (s) (print-separated-strings s "|" nil)) +(deftest :pss.0 (with-output-to-string (s) (print-separated-strings s "|" nil)) "") (deftest :pss.1 @@ -103,9 +119,9 @@ (deftest :css.5 (concat-separated-strings "|" '("ab" "cd") nil '("ef")) "ab|cd|ef") (deftest :f.1 (map-and-remove-nils #'(lambda (x) (when (oddp x) (* x x))) - '(0 1 2 3 4 5 6 7 8 9)) (1 9 25 49 81)) + '(0 1 2 3 4 5 6 7 8 9)) (1 9 25 49 81)) (deftest :f.2 (filter #'(lambda (x) (when (oddp x) (* x x))) - '(0 1 2 3 4 5 6 7 8 9)) (1 3 5 7 9)) + '(0 1 2 3 4 5 6 7 8 9)) (1 3 5 7 9)) (deftest :an.1 (appendnew '(a b c d) '(c c e f)) (a b c d e f)) @@ -186,6 +202,15 @@ (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) @@ -197,7 +222,7 @@ (multiple-value-bind (r g b) (hsv->rgb h s v) (multiple-value-bind (h2 s2 v2) (rgb->hsv r g b) (unless (hsv-equal h s v h2 s2 v2) - (warn "Colors not equal: ~4D ~4D ~4D | ~6D:~6D ~6D:~6D ~6D:~6D~%" + (warn "Colors not equal: ~4D ~4D ~4D | ~6D:~6D ~6D:~6D ~6D:~6D~%" (float r) (float g) (float b) (when (typep h 'number) (float h)) (when (typep h2 'number) (float h2)) @@ -220,7 +245,7 @@ (unless (hsv-similar h s v h2 (/ s2 255) (/ v2 255) :hue-range 10 :saturation-range .1 :value-range 1 :black-limit 0 :gray-limit 0) - (warn "Colors not equal: ~4D ~4D ~4D | ~6D:~6D ~6D:~6D ~6D:~6D~%" + (warn "Colors not equal: ~4D ~4D ~4D | ~6D:~6D ~6D:~6D ~6D:~6D~%" r g b (when (typep h 'number) (float h)) (when (typep h2 'number) (float h2)) @@ -245,14 +270,14 @@ (unless (hsv-similar h s v h2 s2 v2 :hue-range 10 :saturation-range .1 :value-range 1 :black-limit 0 :gray-limit 0) - (warn "Colors not equal: ~4D ~4D ~4D | ~6D:~6D ~6D:~6D ~6D:~6D~%" + (warn "Colors not equal: ~4D ~4D ~4D | ~6D:~6D ~6D:~6D ~6D:~6D~%" r g b (when (typep h 'number) (float h)) (when (typep h2 'number) (float h2)) (float s) (float (/ s2 255)) (float v) (float (/ v2 255))) (return-from test-color-conversion-255-float nil)))))))) t) - + (defun test-color-conversion-255 () (dotimes (ih 11) (dotimes (is 11) @@ -265,7 +290,7 @@ (unless (hsv255-similar h s v h2 s2 v2 :hue-range 10 :saturation-range 5 :value-range 5 :black-limit 0 :gray-limit 0) (warn "Colors not equal: ~D ~D ~D |~ - ~3,'0D:~3,'0D ~3,'0D:~3,'0D ~3,'0D:~3,'0D~%" + ~3,'0D:~3,'0D ~3,'0D:~3,'0D ~3,'0D:~3,'0D~%" r g b h h2 s s2 v v2) (return-from test-color-conversion-255 nil)))))))) @@ -274,7 +299,7 @@ (deftest :color.conv (test-color-conversion) t) (deftest :color.conv.float.255 (test-color-conversion-float-255) t) (deftest :color.conv.255.float (test-color-conversion-255-float) t) -(deftest :color.conv.255 (test-color-conversion-255) t) +(deftest :color.conv.255 (test-color-conversion-255) t) (deftest :hue.diff.1 (hue-difference 10 10) 0) (deftest :hue.diff.2 (hue-difference 10 9) -1) @@ -382,12 +407,12 @@ (defclass test-unique () ((a :initarg :a) (b :initarg :b))) - + (deftest :unique.1 (let ((list (list (make-instance 'test-unique :a 1 :b 1) - (make-instance 'test-unique :a 2 :b 2) - (make-instance 'test-unique :a 3 :b 2)))) + (make-instance 'test-unique :a 2 :b 2) + (make-instance 'test-unique :a 3 :b 2)))) (values (unique-slot-values list 'a) (unique-slot-values list 'b))) @@ -397,15 +422,22 @@ (unique-slot-values nil 'a) nil) -(deftest :nwp.1 - (number-within-percentage 1. 1.1 9) +(deftest :nwp.1 + (numbers-within-percentage 1. 1.1 9) nil) (deftest :nwp.2 - (number-within-percentage 1. 1.1 11) + (numbers-within-percentage 1. 1.1 11) t) - - + +(deftest :pfs.1 (prefixed-fixnum-string 0 #\A 5) "A00000") + +(deftest :pfs.2 (prefixed-fixnum-string 1 #\A 5) "A00001") + +(deftest :pfs.3 (prefixed-fixnum-string 21 #\B 3) "B021") + +(deftest :pis.4 (prefixed-integer-string 234134 #\C 7) "C0234134") + ;;; MOP Testing ;; Disable attrib class until understand changes in sbcl/cmucl @@ -422,7 +454,7 @@ (setf (find-class 'monitored-credit-rating) nil) #+kmrtest-mop (setf (find-class 'credit-rating) nil) - + #+kmrtest-mop (defclass credit-rating () ((level :attributes (date-set time-set)) @@ -430,7 +462,7 @@ #+lispworks (:optimize-slot-access nil) (:metaclass attributes-class)) - + #+kmrtest-mop (defclass monitored-credit-rating () ((level :attributes (last-checked interval date-set)) @@ -452,7 +484,7 @@ (setf (slot-attribute cr 'level 'date-set) nil) result)) "12/15/1990") - + #+kmrtest-mop (deftest :attrib.mop.3 (let ((mcr (make-instance 'monitored-credit-rating))) @@ -460,8 +492,8 @@ (let ((result (slot-attribute mcr 'level 'date-set))) (setf (slot-attribute mcr 'level 'date-set) nil) result)) - "01/05/2002") - + "01/05/2002") + #+kmrtest-mop (eval-when (:compile-toplevel :load-toplevel :execute)