3 ;;; File: unittests-data-clos.lisp
4 ;;; Author: AJ Rossini <blindglobe@gmail.com>
5 ;;; Copyright: (c)2008, AJ Rossini. BSD, LLGPL, or GPLv2, depending
7 ;;; Purpose: unittests for the data-clos package
8 ;;; Time-stamp: <2008-05-09 14:18:19 tony>
9 ;;; Creation: <2008-05-09 14:18:19 tony>
11 ;;; What is this talk of 'release'? Klingons do not make software
12 ;;; 'releases'. Our software 'escapes', leaving a bloody trail of
13 ;;; designers and quality assurance people in its wake.
15 ;;; This organization and structure is new to the 21st Century
20 ;; if needed, but need to set the ASDf path first...!
21 ;; (asdf:oos 'asdf:load-op :lift)
23 (defpackage :lisp-stat-data-clos-example
25 :lift
:lisp-stat-unittests
26 :lisp-stat-data-clos
))
28 (in-package :lisp-stat-data-clos-example
)
31 ;;; Use of this package: To see what gets exported for use in others,
32 ;;; and how much corruption can be done to objects within a package.
35 (deftestsuite lisp-stat-dataclos
() ()) ;;(lisp-stat) ())
37 (addtest (lisp-stat-dataclos) genseq
39 (equal (lisp-stat-data-clos::gen-seq
4) (list 1 2 3 4))))
41 (addtest (lisp-stat-dataclos) genseq-null
43 (equal (lisp-stat-data-clos::gen-seq
0) nil
)))
45 (addtest (lisp-stat-dataclos) genseq-offset
47 (equal (lisp-stat-data-clos::gen-seq
4 2) (list 2 3 4))))
49 (addtest (lisp-stat-dataclos) equaltestnameData
51 (equal (lisp-stat-data-clos::dataset
52 (make-instance 'statistical-dataset
53 :storage
#2A
(('a
'b
) ('c
'd
))))
54 #2A
(('a
'b
) ('c
'd
)))))
57 "test ds for experiment.")
58 (setf my-ds-1
(make-instance 'statistical-dataset
))
63 "test ds for experiment.")
64 (setf my-ds-2
(make-instance 'statistical-dataset
65 :storage
#2A
((1 2 3 4 5) (10 20 30 40 50))
66 :doc
"This is an interesting statistical-dataset"
67 :case-labels
(list "a" "b" "c" "d" "e")
68 :var-labels
(list "x" "y")))
70 (make-array (list 3 5))
72 (array-dimensions (lisp-stat-data-clos::dataset my-ds-2
))
75 (addtest (lisp-stat-dataclos) consData
77 (consistent-statistical-dataset-p my-ds-2
)))
79 (addtest (lisp-stat-dataclos) badAccess1
81 (slot-value my-ds-2
'store
)))
83 (addtest (lisp-stat-dataclos) badAccess2
85 (slot-value my-ds-2
'store
)))
87 (addtest (lisp-stat-dataclos) badAccess3
89 (lisp-stat-data-clos::dataset my-ds-2
)))
91 (addtest (lisp-stat-dataclos) badAccess4
94 (slot-value my-ds-2
'lisp-stat-data-clos
::store
)
95 (lisp-stat-data-clos::dataset my-ds-2
))))
98 (addtest (lisp-stat-dataclos) badAccess5
100 (eq (lisp-stat-data-clos::dataset my-ds-2
)
101 (slot-value my-ds-2
'lisp-stat-data-clos
::store
))))
104 ;; NEVER DO THE FOLLOWING, UNLESS YOU WANT TO MUCK UP STRUCTURES...
105 (addtest (lisp-stat-dataclos) badAccess6
107 (lisp-stat-data-clos::doc-string my-ds-2
)))
109 (addtest (lisp-stat-dataclos) badAccess7
111 (lisp-stat-data-clos::case-labels my-ds-2
)))
113 (addtest (lisp-stat-dataclos) badAccess8
115 (lisp-stat-data-clos::var-labels my-ds-2
)))
117 ;; need to ensure that for things like the following, that we protect
118 ;; this a bit more so that the results are not going to to be wrong.
119 ;; That would be a bit nasty if the statistical-dataset becomes
122 (addtest (lisp-stat-dataclos) badAccess9
124 (setf (lisp-stat-data-clos::var-labels my-ds-2
)
127 (addtest (lisp-stat-dataclos) badAccess10
130 ;; no error, but corrupts structure
131 (setf (lisp-stat-data-clos::var-labels my-ds-2
)
133 ;; error happens here
134 (not (consistent-statistical-dataset-p my-ds-2
))))) ;; Nil
136 (addtest (lisp-stat-dataclos) badAccess12
138 (setf (lisp-stat-data-clos::var-labels my-ds-2
)
141 (addtest (lisp-stat-dataclos) badAccess13
143 (consistent-statistical-dataset-p my-ds-2
))) ;; T
145 ;; This is now done by:
146 (addtest (lisp-stat-dataclos) badAccess14
148 (let ((old-varnames (varNames my-ds-2
)))
149 (setf (varNames my-ds-2
) (list "a" "b")) ;; should error
150 (setf (varNames my-ds-2
) old-varnames
)
151 (error "don't reach this point in badaccess14"))))
154 (defvar origCaseNames nil
)
156 (addtest (lisp-stat-dataclos) badAccess15
159 (setf origCaseNames
(caseNames my-ds-2
))
160 (setf (caseNames my-ds-2
) (list "a" "b" "c" 4 5))
163 (setf (caseNames my-ds-2
)
165 (setf (caseNames my-ds-2
) origCaseNames
))))
169 ;; (describe (run-tests))