3 ;;; File: unittests-dataframe.lisp
4 ;;; Author: AJ Rossini <blindglobe@gmail.com>
5 ;;; Copyright: (c)2008, AJ Rossini. BSD, LLGPL, or GPLv2, depending
7 ;;; Purpose: unittests for the dataframe package
8 ;;; Time-stamp: <2009-04-20 18:59:02 tony>
9 ;;; 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.
17 (in-package :lisp-stat-unittests
)
19 (deftestsuite lisp-stat-ut-dataframe
(lisp-stat-ut)
21 (make-instance 'dataframe-array
22 :storage
#2A
((1 2 3 4 5)
24 :doc
"This is an interesting legal dataframe-array"
25 :case-labels
(list "x" "y")
26 :var-labels
(list "a" "b" "c" "d" "e")))
28 (make-instance 'dataframe-array
29 :storage
#2A
((1 2 3 4 5)
31 :doc
"This is an interesting illegal dataframe-array"
32 :case-labels
(list "a" "b" "c" "d" "e")
33 :var-labels
(list "x" "y")))))
35 ;;; Ensure helper-functions work
37 (addtest (lisp-stat-ut-dataframe) genseq
39 (equal (cls-dataframe::gen-seq
4)
42 (equal (cls-dataframe::gen-seq
0)
45 (equal (cls-dataframe::gen-seq
4 2)
48 (addtest (lisp-stat-ut-dataframe) repeatseq
50 (equal (cls-dataframe::repeat-seq
3 "d")
53 (equal (cls-dataframe::repeat-seq
3 'd
)
57 (addtest (lisp-stat-ut-dataframe) make-labels
59 (equal (cls-dataframe::make-labels
"c" 3)
60 (list "c1" "c2" "c3")))
62 (cls-dataframe::make-labels
'c
3)))
67 (addtest (lisp-stat-ut-dataframe) df-equalp
69 (equalp (dataset (make-instance 'dataframe-array
75 (addtest (lisp-stat-ut-dataframe) df-consdata
77 (consistent-dataframe-p my-df-1
)))
79 (addtest (lisp-stat-ut-dataframe) df-consdata
81 (slot-value my-df-1
'store
)))
83 (addtest (lisp-stat-ut-dataframe) df-consdata
85 (slot-value my-df-1
'cls-dataframe
::store
)))
87 (addtest (lisp-stat-ut-dataframe) df-consdata
91 (addtest (lisp-stat-ut-dataframe) df-consdata
94 (slot-value my-df-1
'cls-dataframe
::store
)
95 (cls-dataframe::dataset my-df-1
))))
97 (addtest (lisp-stat-ut-dataframe) df-consdata
99 (eq (cls-dataframe::dataset my-df-1
)
100 (slot-value my-df-1
'cls-dataframe
::store
))))
102 ;; NEVER REACH INTO CLASS INTERIORS, NO PROMISE
103 ;; GUARANTEE OF LATER CONSISTENCY...
105 (addtest (lisp-stat-ut-dataframe) df-consdata
107 (cls-dataframe::doc-string my-df-1
))
109 (doc-string my-df-1
)))
111 (addtest (lisp-stat-ut-dataframe) df-consdata
113 (cls-dataframe::case-labels my-df-1
))
115 (case-labels my-df-1
)))
117 (addtest (lisp-stat-ut-dataframe) df-consdata
119 (cls-dataframe::var-labels my-df-1
))
121 (var-labels my-df-1
)))
123 ;; need to ensure that for things like the following, that we protect
124 ;; this a bit more so that the results are not going to to be wrong.
125 ;; That would be a bit nasty if the dataframe-array becomes
128 (addtest (lisp-stat-ut-dataframe) badAccess9
130 (setf (cls-dataframe::var-labels my-df-1
)
133 (addtest (lisp-stat-ut-dataframe) badAccess10
136 ;; no error, but corrupts structure
137 (setf (cls-dataframe::var-labels my-df-1
)
139 ;; error happens here
140 (not (consistent-dataframe-p my-df-1
))))) ;; Nil
142 (addtest (lisp-stat-ut-dataframe) badAccess12
144 (setf (cls-dataframe::var-labels my-df-1
)
147 (addtest (lisp-stat-ut-dataframe) badAccess13
149 (consistent-dataframe-p my-df-1
))) ;; T
151 ;; This is now done by:
152 (addtest (lisp-stat-ut-dataframe) badAccess14
154 (let ((old-varnames (varNames my-df-1
)))
155 (setf (varNames my-df-1
) (list "a" "b")) ;; should error
156 (setf (varNames my-df-1
) old-varnames
)
157 (error "don't reach this point in badaccess14"))))
160 ;; NEED TO CONFIRM THERE IS AN ERROR.
161 (addtest (lisp-stat-ut-dataframe) badAccess15
163 (let ((origCaseNames (caselabels my-df-1
)))
164 (setf (caselabels my-df-1
) (list "a" "b" "c" 4 5))
167 (setf (caselabels my-df-1
)
169 (setf (caselabels my-df-1
) origCaseNames
))))
173 ;; (describe (run-tests))
178 (make-instance 'dataframe-array
185 (make-instance 'dataframe-array
192 (make-instance 'dataframe-array
193 :storage
#2A
((1d0 2d0
)