3 ;;; File: unittests-dataframe.lisp
4 ;;; Author: AJ Rossini <blindglobe@gmail.com>
5 ;;; Copyright: (c)2008--, AJ Rossini. Currently licensed under MIT
6 ;;; license. See file LICENSE.mit in top-level directory
8 ;;; Purpose: unittests for the dataframe package
9 ;;; Time-stamp: <2009-09-24 10:30:20 tony>
10 ;;; Creation: <2008-05-09 14:18:19 tony>
12 ;;; What is this talk of 'release'? Klingons do not make software
13 ;;; 'releases'. Our software 'escapes', leaving a bloody trail of
14 ;;; designers and quality assurance people in its wake.
16 (in-package :lisp-stat-unittests
)
18 (deftestsuite lisp-stat-ut-dataframe
(lisp-stat-ut)
20 (make-instance 'dataframe-array
21 :storage
#2A
((1 2 3 4 5)
23 :doc
"This is an interesting legal dataframe-array"
24 :case-labels
(list "x" "y")
25 :var-labels
(list "a" "b" "c" "d" "e")))
27 (make-instance 'dataframe-array
28 :storage
#2A
((1 2 3 4 5)
30 :doc
"This is an interesting illegal dataframe-array"
31 :case-labels
(list "a" "b" "c" "d" "e")
32 :var-labels
(list "x" "y")))))
34 ;;; Ensure helper-functions work
36 (addtest (lisp-stat-ut-dataframe) genseq
38 (equal (cls-dataframe::gen-seq
4)
41 (equal (cls-dataframe::gen-seq
0)
44 (equal (cls-dataframe::gen-seq
4 2)
47 (addtest (lisp-stat-ut-dataframe) repeatseq
49 (equal (cls-dataframe::repeat-seq
3 "d")
52 (equal (cls-dataframe::repeat-seq
3 'd
)
56 (addtest (lisp-stat-ut-dataframe) make-labels
58 (equal (cls-dataframe::make-labels
"c" 3)
59 (list "c1" "c2" "c3")))
61 (cls-dataframe::make-labels
'c
3)))
66 (addtest (lisp-stat-ut-dataframe) df-equalp
68 (equalp (dataset (make-instance 'dataframe-array
74 (addtest (lisp-stat-ut-dataframe) df-consdata
76 (consistent-dataframe-p my-df-1
)))
78 (addtest (lisp-stat-ut-dataframe) df-consdata
80 (slot-value my-df-1
'store
)))
82 (addtest (lisp-stat-ut-dataframe) df-consdata
84 (slot-value my-df-1
'cls-dataframe
::store
)))
86 (addtest (lisp-stat-ut-dataframe) df-consdata
90 (addtest (lisp-stat-ut-dataframe) df-consdata
93 (slot-value my-df-1
'cls-dataframe
::store
)
94 (cls-dataframe::dataset my-df-1
))))
96 (addtest (lisp-stat-ut-dataframe) df-consdata
98 (eq (cls-dataframe::dataset my-df-1
)
99 (slot-value my-df-1
'cls-dataframe
::store
))))
101 ;; NEVER REACH INTO CLASS INTERIORS, NO PROMISE
102 ;; GUARANTEE OF LATER CONSISTENCY...
104 (addtest (lisp-stat-ut-dataframe) df-consdata
106 (cls-dataframe::doc-string my-df-1
))
108 (doc-string my-df-1
)))
110 (addtest (lisp-stat-ut-dataframe) df-consdata
112 (cls-dataframe::case-labels my-df-1
))
114 (case-labels my-df-1
)))
116 (addtest (lisp-stat-ut-dataframe) df-consdata
118 (cls-dataframe::var-labels my-df-1
))
120 (var-labels my-df-1
)))
122 ;; need to ensure that for things like the following, that we protect
123 ;; this a bit more so that the results are not going to to be wrong.
124 ;; That would be a bit nasty if the dataframe-array becomes
127 (addtest (lisp-stat-ut-dataframe) badAccess9
129 (setf (cls-dataframe::var-labels my-df-1
)
132 (addtest (lisp-stat-ut-dataframe) badAccess10
135 ;; no error, but corrupts structure
136 (setf (cls-dataframe::var-labels my-df-1
)
138 ;; error happens here
139 (not (consistent-dataframe-p my-df-1
))))) ;; Nil
141 (addtest (lisp-stat-ut-dataframe) badAccess12
143 (setf (cls-dataframe::var-labels my-df-1
)
146 (addtest (lisp-stat-ut-dataframe) badAccess13
148 (consistent-dataframe-p my-df-1
))) ;; T
150 ;; This is now done by:
151 (addtest (lisp-stat-ut-dataframe) badAccess14
153 (let ((old-varnames (varNames my-df-1
)))
154 (setf (varNames my-df-1
) (list "a" "b")) ;; should error
155 (setf (varNames my-df-1
) old-varnames
)
156 (error "don't reach this point in badaccess14"))))
159 ;; NEED TO CONFIRM THERE IS AN ERROR.
160 (addtest (lisp-stat-ut-dataframe) badAccess15
162 (let ((origCaseNames (caselabels my-df-1
)))
163 (setf (caselabels my-df-1
) (list "a" "b" "c" 4 5))
166 (setf (caselabels my-df-1
)
168 (setf (caselabels my-df-1
) origCaseNames
))))
172 ;; (describe (run-tests))
177 (make-instance 'dataframe-array
184 (make-instance 'dataframe-array
191 (make-instance 'dataframe-array
192 :storage
#2A
((1d0 2d0
)