From 40f51c2182326f9cf8305d984c71000f9a37fa1e Mon Sep 17 00:00:00 2001 From: "Thomas M. Hermann" Date: Mon, 13 Sep 2010 22:08:41 -0500 Subject: [PATCH] Copyright refresh, mild formatting, and comments. --- defpackage.lisp | 54 +++++++++++++------------- floating-point.lisp | 106 +++++++++++++++++++++++++++++----------------------- lisp-unit.asd | 80 +++++++++++++++++++-------------------- rational.lisp | 52 +++++++++++++------------- 4 files changed, 153 insertions(+), 139 deletions(-) rewrite lisp-unit.asd (86%) diff --git a/defpackage.lisp b/defpackage.lisp index 42e8068..da994b5 100644 --- a/defpackage.lisp +++ b/defpackage.lisp @@ -26,38 +26,38 @@ OTHER DEALINGS IN THE SOFTWARE. ;;; Packages ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; -(common-lisp:defpackage #:lisp-unit - (:use #:common-lisp) - (:export #:define-test #:run-all-tests #:run-tests - #:assert-eq #:assert-eql #:assert-equal #:assert-equalp - #:assert-error #:assert-expands #:assert-false - #:assert-equality #:assert-prints #:assert-true - #:get-test-code #:get-tests - #:remove-all-tests #:remove-tests - #:logically-equal #:set-equal - #:use-debugger - #:with-test-listener +(defpackage :lisp-unit + (:use :common-lisp) + (:export :define-test :run-all-tests :run-tests + :assert-eq :assert-eql :assert-equal :assert-equalp + :assert-error :assert-expands :assert-false + :assert-equality :assert-prints :assert-true + :get-test-code :get-tests + :remove-all-tests :remove-tests + :logically-equal :set-equal + :use-debugger + :with-test-listener ;; Rational predicates and assertions - #:rational-equal #:assert-rational-equal + :rational-equal :assert-rational-equal ;; Floating point parameters - #:*measure* #:*epsilon* #:*significant-figures* + :*measure* :*epsilon* :*significant-figures* ;; Floating point functions - #:default-epsilon #:relative-error - #:sumsq #:sump #:norm - #:relative-error-norm + :default-epsilon :relative-error + :sumsq :sump :norm + :relative-error-norm ;; Floating point predicates and assertions - #:float-equal #:assert-float-equal - #:sigfig-equal #:assert-sigfig-equal - #:norm-equal #:assert-norm-equal - #:number-equal #:assert-number-equal - #:numerical-equal #:assert-numerical-equal + :float-equal :assert-float-equal + :sigfig-equal :assert-sigfig-equal + :norm-equal :assert-norm-equal + :number-equal :assert-number-equal + :numerical-equal :assert-numerical-equal ;; Floating point diagnostic functions - #:sequence-error #:array-error + :sequence-error :array-error ;; Floating point data functions - #:make-2d-list - #:complex-random - #:make-random-list - #:make-random-2d-list - #:make-random-2d-array)) + :make-2d-list + :complex-random + :make-random-list + :make-random-2d-list + :make-random-2d-array)) (pushnew :lisp-unit common-lisp:*features*) diff --git a/floating-point.lisp b/floating-point.lisp index 802204a..74b95de 100644 --- a/floating-point.lisp +++ b/floating-point.lisp @@ -1,33 +1,36 @@ ;;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp -*- -;;; -;;; Floating tests and assertions for LISP-UNIT -;;; -;;; Copyright (c) 2009 Thomas M. Hermann -;;; -;;; Permission is hereby granted, free of charge, to any person obtaining -;;; a copy of this software and associated documentation files (the "Software"), -;;; to deal in the Software without restriction, including without limitation -;;; the rights to use, copy, modify, merge, publish, distribute, sublicense, -;;; and/or sell copies of the Software, and to permit persons to whom the -;;; Software is furnished to do so, subject to the following conditions: -;;; -;;; The above copyright notice and this permission notice shall be included -;;; in all copies or substantial portions of the Software. -;;; -;;; THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS -;;; OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, -;;; FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL -;;; THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR -;;; OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, -;;; ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR -;;; OTHER DEALINGS IN THE SOFTWARE. -;;; -;;; References -;;; [NumAlgoC] Gisela Engeln-Mullges and Frank Uhlig "Numerical -;;; Algorithms with C", Springer, 1996 -;;; ISBN: 3-540-60530-4 +#| + + Floating tests and assertions for LISP-UNIT + + Copyright (c) 2009-2010, Thomas M. Hermann + + Permission is hereby granted, free of charge, to any person obtaining + a copy of this software and associated documentation files (the "Software"), + to deal in the Software without restriction, including without limitation + the rights to use, copy, modify, merge, publish, distribute, sublicense, + and/or sell copies of the Software, and to permit persons to whom the + Software is furnished to do so, subject to the following conditions: -(common-lisp:in-package :lisp-unit) + The above copyright notice and this permission notice shall be included + in all copies or substantial portions of the Software. + + THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS + OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, + FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL + THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR + OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, + ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR + OTHER DEALINGS IN THE SOFTWARE. + + References + [NumAlgoC] Gisela Engeln-Mullges and Frank Uhlig "Numerical + Algorithms with C", Springer, 1996 + ISBN: 3-540-60530-4 + +|# + +(in-package :lisp-unit) (defparameter *measure* 1) @@ -83,30 +86,33 @@ (defmethod default-epsilon ((value float)) "Return a default epsilon value based on the floating point type." (typecase value - (short-float (* 2.0s0 short-float-epsilon)) - (single-float (* 2.0f0 single-float-epsilon)) - (double-float (* 2.0d0 double-float-epsilon)) - (long-float (* 2.0l0 long-float-epsilon)))) + (short-float (* 2S0 short-float-epsilon)) + (single-float (* 2F0 single-float-epsilon)) + (double-float (* 2D0 double-float-epsilon)) + (long-float (* 2L0 long-float-epsilon)))) (defmethod default-epsilon ((value complex)) "Return a default epsilon value based on the complex type." (typecase value - ((complex short-float) (* 2.0s0 short-float-epsilon)) - ((complex single-float) (* 2.0f0 single-float-epsilon)) - ((complex double-float) (* 2.0d0 double-float-epsilon)) - ((complex long-float) (* 2.0l0 long-float-epsilon)) + ((complex short-float) (* 2S0 short-float-epsilon)) + ((complex single-float) (* 2F0 single-float-epsilon)) + ((complex double-float) (* 2D0 double-float-epsilon)) + ((complex long-float) (* 2L0 long-float-epsilon)) (t 0))) +;;; FIXME : Use the LOOP (defmethod default-epsilon ((value list)) "Return the default epsilon based on contents of the list." (reduce (lambda (x y) (max x (default-epsilon y))) value :initial-value 0)) +;;; FIXME : Use the LOOP (defmethod default-epsilon ((value vector)) "Return the default epsilon based on the contents of the vector." (reduce (lambda (x y) (max x (default-epsilon y))) value :initial-value 0)) +;;; FIXME : Use the LOOP (defmethod default-epsilon ((value array)) "Return the default epsilon based on the contents of the array." (reduce (lambda (x y) (max x (default-epsilon y))) @@ -115,16 +121,18 @@ :displaced-to value) :initial-value 0)) -;;; (RELATIVE-ERROR x y) => float -;;; [NumAlgoC] : Definition 1.3, pg. 2 -;;; modified with Definition 1.1, pg. 1 -;;; -;;; The definition of relative error in this routine is modified from -;;; the Definition 1.3 in [NumAlgoC] for cases when either the exact -;;; or the approximate value equals zero. According to Definition 1.3, -;;; the relative error is identically equal to 1 in those cases. This -;;; function returns the absolue error in those cases. This is more -;;; useful for testing. +#| + (RELATIVE-ERROR x y) => float + [NumAlgoC] : Definition 1.3, pg. 2 + modified with Definition 1.1, pg. 1 + + The definition of relative error in this routine is modified from + the Definition 1.3 in [NumAlgoC] for cases when either the exact + or the approximate value equals zero. According to Definition 1.3, + the relative error is identically equal to 1 in those cases. This + function returns the absolue error in those cases. This is more + useful for testing. +|# (defun %relative-error (exact approximate) "Return the relative error of the numbers." (abs (if (or (zerop exact) (zerop approximate)) @@ -327,6 +335,7 @@ comparison of the relative error is less than epsilon." ;;; (NORM data) => float (defun %seq-1-norm (data) "Return the Taxicab norm of the sequence." + ;; FIXME : Use the LOOP. (reduce (lambda (x y) (+ x (abs y))) data :initial-value 0)) @@ -344,6 +353,7 @@ comparison of the relative error is less than epsilon." (defun %seq-inf-norm (data) "Return the infinity, or maximum, norm of the sequence." + ;; FIXME : Use the LOOP. (reduce (lambda (x y) (max x (abs y))) data :initial-value 0)) @@ -490,6 +500,7 @@ error norm is less than epsilon." ;;; return, scale 0.1 <= significand < 1. (defun %normalize-float (significand &optional (exponent 0)) "Return the normalized floating point number and exponent." + ;;; FIXME : Use the LOOP. (cond ((zerop significand) (values significand 0)) @@ -639,6 +650,9 @@ is equal according to :TEST." (defmacro assert-numerical-equal (expected form &rest extras) (expand-assert :equal form form expected extras :test #'numerical-equal)) +;;; FIXME : Audit and move the diagnostic functions to a separate +;;; file. + ;;; Diagnostic functions ;;; Failing a unit test is only half the problem. diff --git a/lisp-unit.asd b/lisp-unit.asd dissimilarity index 86% index 5c5b38d..16b94e3 100644 --- a/lisp-unit.asd +++ b/lisp-unit.asd @@ -1,41 +1,39 @@ -;;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp -*- -;;; -;;; Copyright (c) 2009 Thomas M. Hermann -;;; -;;; Permission is hereby granted, free of charge, to any person obtaining -;;; a copy of this software and associated documentation files (the "Software"), -;;; to deal in the Software without restriction, including without limitation -;;; the rights to use, copy, modify, merge, publish, distribute, sublicense, -;;; and/or sell copies of the Software, and to permit persons to whom the -;;; Software is furnished to do so, subject to the following conditions: -;;; -;;; The above copyright notice and this permission notice shall be included -;;; in all copies or substantial portions of the Software. -;;; -;;; THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS -;;; OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, -;;; FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL -;;; THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR -;;; OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, -;;; ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR -;;; OTHER DEALINGS IN THE SOFTWARE. -;;; - -(common-lisp:defpackage #:lisp-unit-system - (:use #:common-lisp #:asdf)) - -(common-lisp:in-package #:lisp-unit-system) - -(defsystem :lisp-unit - :description "Common Lisp library that supports unit testing." - :version "Draft" - :author "Christopher K. Riesbeck " - :license "MIT" - :components ((:file "defpackage") - (:file "lisp-unit" - :depends-on ("defpackage")) - (:file "rational" - :depends-on ("defpackage")) - (:file "floating-point" - :depends-on ("defpackage" - "lisp-unit")))) +;;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp -*- +#| + Copyright (c) 2009-2010, Thomas M. Hermann + + Permission is hereby granted, free of charge, to any person obtaining + a copy of this software and associated documentation files (the "Software"), + to deal in the Software without restriction, including without limitation + the rights to use, copy, modify, merge, publish, distribute, sublicense, + and/or sell copies of the Software, and to permit persons to whom the + Software is furnished to do so, subject to the following conditions: + + The above copyright notice and this permission notice shall be included + in all copies or substantial portions of the Software. + + THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS + OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, + FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL + THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR + OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, + ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR + OTHER DEALINGS IN THE SOFTWARE. + +|# + +(defpackage :lisp-unit-system + (:use :common-lisp :asdf)) + +(in-package :lisp-unit-system) + +(defsystem :lisp-unit + :description "Common Lisp library that supports unit testing." + :version "Draft" + :author "Christopher K. Riesbeck " + :license "MIT" + :components + ((:file "defpackage") + (:file "lisp-unit" :depends-on ("defpackage")) + (:file "rational" :depends-on ("defpackage")) + (:file "floating-point" :depends-on ("defpackage" "lisp-unit")))) diff --git a/rational.lisp b/rational.lisp index 058d9e0..c2aa1db 100644 --- a/rational.lisp +++ b/rational.lisp @@ -1,29 +1,31 @@ ;;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp -*- -;;; -;;; Rational tests and assertions for LISP-UNIT -;;; -;;; Copyright (c) 2009 Thomas M. Hermann -;;; -;;; Permission is hereby granted, free of charge, to any person obtaining -;;; a copy of this software and associated documentation files (the "Software"), -;;; to deal in the Software without restriction, including without limitation -;;; the rights to use, copy, modify, merge, publish, distribute, sublicense, -;;; and/or sell copies of the Software, and to permit persons to whom the -;;; Software is furnished to do so, subject to the following conditions: -;;; -;;; The above copyright notice and this permission notice shall be included -;;; in all copies or substantial portions of the Software. -;;; -;;; THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS -;;; OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, -;;; FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL -;;; THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR -;;; OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, -;;; ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR -;;; OTHER DEALINGS IN THE SOFTWARE. -;;; - -(common-lisp:in-package :lisp-unit) +#| + + Rational tests and assertions for LISP-UNIT + + Copyright (c) 2009-2010, Thomas M. Hermann + + Permission is hereby granted, free of charge, to any person obtaining + a copy of this software and associated documentation files (the "Software"), + to deal in the Software without restriction, including without limitation + the rights to use, copy, modify, merge, publish, distribute, sublicense, + and/or sell copies of the Software, and to permit persons to whom the + Software is furnished to do so, subject to the following conditions: + + The above copyright notice and this permission notice shall be included + in all copies or substantial portions of the Software. + + THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS + OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, + FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL + THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR + OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, + ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR + OTHER DEALINGS IN THE SOFTWARE. + +|# + +(in-package :lisp-unit) (defgeneric rational-equal (data1 data2) (:documentation -- 2.11.4.GIT