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: <2009-03-16 20:49:53 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
18 (in-package :lisp-stat-unittests
)
21 ;;; Use of this package: To see what gets exported for use in others,
22 ;;; and how much corruption can be done to objects within a package.
25 (deftestsuite lisp-stat-ut-dataclos
(lisp-stat-ut) ())
27 (addtest (lisp-stat-dataclos) genseq
29 (equal (lisp-stat-data-clos::gen-seq
4) (list 1 2 3 4))))
31 (addtest (lisp-stat-dataclos) genseq-null
33 (equal (lisp-stat-data-clos::gen-seq
0) nil
)))
35 (addtest (lisp-stat-dataclos) genseq-offset
37 (equal (lisp-stat-data-clos::gen-seq
4 2) (list 2 3 4))))
39 (addtest (lisp-stat-dataclos) equaltestnameData
41 (equal (lisp-stat-data-clos::dataset
42 (make-instance 'dataframe-array
43 :storage
#2A
(('a
'b
) ('c
'd
))))
44 #2A
(('a
'b
) ('c
'd
)))))
47 "test ds for experiment.")
48 (setf my-ds-1
(make-instance 'dataframe-array
))
53 "test ds for experiment.")
54 (setf my-ds-2
(make-instance 'dataframe-array
55 :storage
#2A
((1 2 3 4 5) (10 20 30 40 50))
56 :doc
"This is an interesting dataframe-array"
57 :case-labels
(list "a" "b" "c" "d" "e")
58 :var-labels
(list "x" "y")))
60 (make-array (list 3 5))
62 (array-dimensions (lisp-stat-data-clos::dataset my-ds-2
))
65 (addtest (lisp-stat-dataclos) consData
67 (consistent-dataframe-like-p my-ds-2
)))
69 (addtest (lisp-stat-dataclos) badAccess1
71 (slot-value my-ds-2
'store
)))
73 (addtest (lisp-stat-dataclos) badAccess2
75 (slot-value my-ds-2
'store
)))
77 (addtest (lisp-stat-dataclos) badAccess3
79 (lisp-stat-data-clos::dataset my-ds-2
)))
81 (addtest (lisp-stat-dataclos) badAccess4
84 (slot-value my-ds-2
'lisp-stat-data-clos
::store
)
85 (lisp-stat-data-clos::dataset my-ds-2
))))
88 (addtest (lisp-stat-dataclos) badAccess5
90 (eq (lisp-stat-data-clos::dataset my-ds-2
)
91 (slot-value my-ds-2
'lisp-stat-data-clos
::store
))))
94 ;; NEVER DO THE FOLLOWING, UNLESS YOU WANT TO MUCK UP STRUCTURES...
95 (addtest (lisp-stat-dataclos) badAccess6
97 (lisp-stat-data-clos::doc-string my-ds-2
)))
99 (addtest (lisp-stat-dataclos) badAccess7
101 (lisp-stat-data-clos::case-labels my-ds-2
)))
103 (addtest (lisp-stat-dataclos) badAccess8
105 (lisp-stat-data-clos::var-labels my-ds-2
)))
107 ;; need to ensure that for things like the following, that we protect
108 ;; this a bit more so that the results are not going to to be wrong.
109 ;; That would be a bit nasty if the dataframe-array becomes
112 (addtest (lisp-stat-dataclos) badAccess9
114 (setf (lisp-stat-data-clos::var-labels my-ds-2
)
117 (addtest (lisp-stat-dataclos) badAccess10
120 ;; no error, but corrupts structure
121 (setf (lisp-stat-data-clos::var-labels my-ds-2
)
123 ;; error happens here
124 (not (consistent-dataframe-like-p my-ds-2
))))) ;; Nil
126 (addtest (lisp-stat-dataclos) badAccess12
128 (setf (lisp-stat-data-clos::var-labels my-ds-2
)
131 (addtest (lisp-stat-dataclos) badAccess13
133 (consistent-dataframe-like-p my-ds-2
))) ;; T
135 ;; This is now done by:
136 (addtest (lisp-stat-dataclos) badAccess14
138 (let ((old-varnames (varNames my-ds-2
)))
139 (setf (varNames my-ds-2
) (list "a" "b")) ;; should error
140 (setf (varNames my-ds-2
) old-varnames
)
141 (error "don't reach this point in badaccess14"))))
144 (defvar origCaseNames nil
)
146 (addtest (lisp-stat-dataclos) badAccess15
149 (setf origCaseNames
(caseNames my-ds-2
))
150 (setf (caseNames my-ds-2
) (list "a" "b" "c" 4 5))
153 (setf (caseNames my-ds-2
)
155 (setf (caseNames my-ds-2
) origCaseNames
))))
159 ;; (describe (run-tests))