unittests-protoObj.lisp

   1 ;;; -*- mode: lisp -*-
   2 ;;; Copyright (c) 2007, by A.J. Rossini <blindglobe@gmail.com>
   3 ;;; See COPYRIGHT file for any additional restrictions (BSD license).
   4 ;;; Since 1991, ANSI was finally finished.  Edited for ANSI Common Lisp.
   5
   6 ;;; This is semi-external to lispstat core packages.  The dependency
   7 ;;; should be that lispstat packages are dependencies for the unit
   8 ;;; tests.  However, where they will end up is still to be
   9 ;;; determined.
  10
  11 (in-package :cl-user)
  12
  13 (defpackage :lisp-stat-unittests-proto
  14   (:use :common-lisp :lift :lisp-stat-object-system)
  15   (:export run-lisp-stat-proto-tests run-lisp-stat-proto-test scoreboard))
  16
  17 (in-package :lisp-stat-unittests)
  18
  19 ;; To use these tests, we need to do
  20 ;;       (unittests-protoObj::run-lisp-stat-proto-tests)
  21 ;; eventually, the scoreboard should work in order to take care of
  22 ;; real-time tracking.   Then something like
  23 ;;       (scoreboard)
  24 ;; should create, and either we poll/rerun based on event changes, or
  25 ;; we force a poll via
  26 ;;       (update-scoreboard)
  27 ;; and have it do the right thing.  Or it could be no problem to do
  28 ;; both.
  29
  30 ;;; TESTS
  31
  32 (defun run-lisp-stat-tests ()
  33   (run-tests :suite 'lisp-stat))
  34
  35 (defun run-lisp-stat-test (&rest x)
  36   (run-test x))
  37
  38 (deftestsuite lisp-stat-object-system () ())
  39 (deftestsuite lisp-stat-proto-basic (lisp-stat-object-system) ())
  40 (deftestsuite lisp-stat-proto-use (lisp-stat-object-system) ())
  41
  42 ;; EXAMPLES, not for use
  43
  44 #+nil(progn
  45        (addtest (lisp-stat-lin-alg) eigen
  46                 (ensure-same
  47                  (eigen #2A((2 3 4) (1 2 4) (2 4 5)))
  48                  (list #(10.656854249492381 -0.6568542494923802 -0.9999999999999996)
  49                        (list #(0.4999999999999998 0.4999999999999997 0.7071067811865475)
  50                              #(-0.49999999999999856 -0.5000000000000011 0.7071067811865474)
  51                              #(0.7071067811865483 -0.7071067811865466 -1.2560739669470215e-15))
  52                        NIL)))
  53
  54        (addtest (lisp-stat-lin-alg) spline
  55                 (ensure-same
  56                  (spline #(1.0 1.2 1.3 1.8 2.1 2.5)
  57                          #(1.2 2.0 2.1 2.0 1.1 2.8)
  58                          :xvals 6)
  59                  (list (list 1.0 1.3 1.6 1.9 2.2 2.5)
  60                        (list 1.2 2.1 2.2750696543866313 1.6465231041904045 1.2186576148879609 2.8))
  61                  :test 'almost=lists)))
  62
  63 ;;;; Object System tests
  64
  65 (deftestsuite lisp-stat-proto-use (lisp-stat-object-system)
  66   ()
  67   (:documentation "Make sure the proto object system is valid.")
  68   (:tests
  69    (create-proto (ensure (object-proto-p (defproto test-me))))
  70    (create-proto2 (ensure (object-proto-p (defproto2 test-me2))))
  71    (instance1 (ensure (send test-me :isnew)))
  72    (instance1-2 (ensure (send test-me2 :isnew)))
  73    (instance2 (ensure (send test-me :has-slot 'new)))
  74    (instance2-2 (ensure (send test-me2 :has-slot 'new)))
  75
  76    (instance5 (ensure (send test-me :has-slot 'new)))
  77    (instance5-2 (ensure (send test-me2 :has-slot 'new)))
  78    (instance5 (ensure (send test-me :own-slots 'new)))
  79    (instance5-2 (ensure (send test-me2 :own-slots 'new)))
  80    (instance5 (ensure (send test-me :has-slot 'new)))
  81    (instance5-2 (ensure (send test-me2 :has-slot 'new)))
  82    (instance5 (ensure (send test-me :has-slot 'new)))
  83    (instance5-2 (ensure (send test-me2 :has-slot 'new)))
  84    ))
  85
  86