X-Git-Url: http://git.kpe.io/?p=kmrcl.git;a=blobdiff_plain;f=tests.lisp;h=4cbc915f430f61d6e8f4079c79672b1e769b748e;hp=b33befd2bb140d1a3fc51bd086e2eb48f9869c96;hb=03712fbb06acbb103602bae10f41aeae7fa05127;hpb=739b14ee8844dc777b174105646df3abcb865282 diff --git a/tests.lisp b/tests.lisp index b33befd..4cbc915 100644 --- a/tests.lisp +++ b/tests.lisp @@ -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")) @@ -86,7 +86,7 @@ (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 @@ -119,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)) @@ -213,7 +213,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)) @@ -236,7 +236,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)) @@ -261,14 +261,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) @@ -281,7 +281,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)))))))) @@ -290,7 +290,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) @@ -398,12 +398,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))) @@ -413,7 +413,7 @@ (unique-slot-values nil 'a) nil) -(deftest :nwp.1 +(deftest :nwp.1 (numbers-within-percentage 1. 1.1 9) nil) @@ -426,9 +426,9 @@ (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 @@ -445,7 +445,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)) @@ -453,7 +453,7 @@ #+lispworks (:optimize-slot-access nil) (:metaclass attributes-class)) - + #+kmrtest-mop (defclass monitored-credit-rating () ((level :attributes (last-checked interval date-set)) @@ -475,7 +475,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))) @@ -483,8 +483,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)