internal-test/example-tests.lisp

   1 #|
   2
   3  LISP-UNIT Example Tests
   4
   5  Copyright (c) 2010-2012, Thomas M. Hermann
   6  All rights reserved.
   7
   8  Redistribution and  use  in  source  and  binary  forms, with or without
   9  modification, are permitted  provided  that the following conditions are
  10  met:
  11
  12    o  Redistributions of  source  code  must  retain  the above copyright
  13       notice, this list of conditions and the following disclaimer.
  14    o  Redistributions in binary  form  must reproduce the above copyright
  15       notice, this list of  conditions  and  the  following disclaimer in
  16       the  documentation  and/or   other   materials  provided  with  the
  17       distribution.
  18    o  The names of the contributors may not be used to endorse or promote
  19       products derived from this software without  specific prior written
  20       permission.
  21
  22  THIS SOFTWARE IS  PROVIDED  BY  THE  COPYRIGHT  HOLDERS AND CONTRIBUTORS
  23  "AS IS"  AND  ANY  EXPRESS  OR  IMPLIED  WARRANTIES, INCLUDING,  BUT NOT
  24  LIMITED TO, THE IMPLIED WARRANTIES  OF MERCHANTABILITY AND FITNESS FOR A
  25  PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER
  26  OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL,
  27  EXEMPLARY, OR  CONSEQUENTIAL  DAMAGES  (INCLUDING,  BUT  NOT LIMITED TO,
  28  PROCUREMENT OF  SUBSTITUTE  GOODS  OR  SERVICES;  LOSS  OF USE, DATA, OR
  29  PROFITS; OR BUSINESS INTERRUPTION)  HOWEVER  CAUSED AND ON ANY THEORY OF
  30  LIABILITY, WHETHER  IN  CONTRACT,  STRICT  LIABILITY, OR TORT (INCLUDING
  31  NEGLIGENCE OR  OTHERWISE)  ARISING  IN  ANY  WAY  OUT OF THE USE OF THIS
  32  SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
  33
  34 |#
  35
  36 (in-package :lisp-unit)
  37
  38 (defun my-max (x y)
  39   "Deliberately wrong"
  40   (declare (ignore y))
  41   x)
  42
  43 (define-test test-my-max
  44   ;; Wrong
  45   (assert-equal 5 (my-max 2 5))
  46   (assert-equal 5 (my-max 5 2))
  47   (assert-equal 10 (my-max 10 10))
  48   (assert-equal 0 (my-max -5 0))
  49   ;; Error
  50   (assert-equal 5 (my-max-err 2 5)))
  51
  52 (defun my-sqrt (n)
  53   "Not really."
  54   (/ n 2))
  55
  56 (define-test my-sqrt
  57   (dotimes (i 5)
  58     (assert-equal i (my-sqrt (* i i)) i)))
  59
  60 (define-test cl-user::my-sqrt
  61   (dotimes (i 5)
  62     (assert-equal i (my-sqrt (* i i)) i)))
  63
  64 ;;; Macro
  65
  66 (defmacro my-macro (arg1 arg2)
  67   (let ((g1 (gensym))
  68         (g2 (gensym)))
  69     `(let ((,g1 ,arg1)
  70            (,g2 ,arg2))
  71        "Start"
  72        (+ ,g1 ,g2 3))))
  73
  74 (define-test test-macro
  75   (assert-expands
  76    (let ((#:G1 A) (#:G2 B)) "Start" (+ #:G1 #:G2 3))
  77    (my-macro a b)))
  78
  79 ;;; Tags
  80
  81 (defun add-integer (integer1 integer2)
  82   "Add 2 integer numbers"
  83   (check-type integer1 integer)
  84   (check-type integer2 integer)
  85   (+ integer1 integer2))
  86
  87 (defun subtract-integer (integer1 integer2)
  88   "Subtract 2 integer numbers"
  89   (check-type integer1 integer)
  90   (check-type integer2 integer)
  91   (- integer1 integer2))
  92
  93 (define-test add-integer
  94   "Test add-integer for values and errors."
  95   (:tag :add :integer)
  96   (assert-eql 3 (add-integer 1 2))
  97   (assert-error 'type-error (add-integer 1.0 2))
  98   (assert-error 'type-error (add-integer 1 2.0)))
  99
 100 (define-test subtract-integer
 101   "Test subtract-integer for values and errors."
 102   (:tag :subtract :integer)
 103   (assert-eql 1 (subtract-integer 3 2))
 104   (assert-error 'type-error (subtract-integer 3.0 2))
 105   (assert-error 'type-error (subtract-integer 2 3.0)))
 106
 107 (defun add-float (float1 float2)
 108   "Add 2 floating point numbers"
 109   (check-type float1 float)
 110   (check-type float2 float)
 111   (+ float1 float2))
 112
 113 (defun subtract-float (float1 float2)
 114   "Subtract 2 floating point numbers"
 115   (check-type float1 float)
 116   (check-type float2 float)
 117   (- float1 float2))
 118
 119 (define-test add-float
 120   "Test add-float for values and errors."
 121   (:tag :add :float)
 122   (assert-eql 3.0 (add-float 1.0 2.0))
 123   (assert-error 'type-error (add-float 1.0 2))
 124   (assert-error 'type-error (add-float 1 2.0)))
 125
 126 (define-test subtract-float
 127   "Test subtract-float for values and errors."
 128   (:tag :subtract :float)
 129   (assert-eql 1.0 (subtract-float 3.0 2.0))
 130   (assert-error 'type-error (subtract-float 3.0 2))
 131   (assert-error 'type-error (subtract-float 2 3.0)))
 132
 133 (defun add-complex (complex1 complex2)
 134   "Add 2 complex numbers"
 135   (check-type complex1 complex)
 136   (check-type complex2 complex)
 137   (+ complex1 complex2))
 138
 139 (defun subtract-complex (complex1 complex2)
 140   "Subtract 2 complex numbers"
 141   (check-type complex1 complex)
 142   (check-type complex2 complex)
 143   (- complex1 complex2))
 144
 145 (define-test add-complex
 146   "Test add-complex for values and errors."
 147   (:tag :add :complex)
 148   (assert-eql #C(3 5) (add-complex #C(1 2) #C(2 3)))
 149   (assert-error 'type-error (add-integer #C(1 2) 3))
 150   (assert-error 'type-error (add-integer 1 #C(2 3))))
 151
 152 (define-test subtract-complex
 153   "Test subtract-complex for values and errors."
 154   (:tag :subtract :complex)
 155   (assert-eql #C(1 2) (subtract-complex #C(3 5) #C(2 3)))
 156   (assert-error 'type-error (subtract-integer #C(3 5) 2))
 157   (assert-error 'type-error (subtract-integer 2 #C(2 3))))