src/unittests/unittests-data-clos.lisp

   1 ;;; -*- mode: lisp -*-
   2
   3 ;;; File:       unittests-data-clos.lisp
   4 ;;; Author:     AJ Rossini <blindglobe@gmail.com>
   5 ;;; Copyright:  (c)2008, AJ Rossini.  BSD, LLGPL, or GPLv2, depending
   6 ;;;             on how it arrives.
   7 ;;; Purpose:    unittests for the data-clos package
   8 ;;; Time-stamp: <2009-03-31 08:30:13 tony>
   9 ;;; Creation:   <2008-05-09 14:18:19 tony>
  10
  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.
  14
  15 (in-package :lisp-stat-unittests)
  16
  17 (deftestsuite lisp-stat-ut-dataclos (lisp-stat-ut) ())
  18
  19 ;;; Ensure helper-functions work
  20
  21 (addtest (lisp-stat-ut-dataclos) genseq
  22          (ensure
  23           (equal (lisp-stat-data-clos::gen-seq 4)
  24                  (list 1 2 3 4))))
  25
  26 (addtest (lisp-stat-ut-dataclos) genseq-null
  27          (ensure
  28           (equal (lisp-stat-data-clos::gen-seq 0)
  29                  nil)))
  30
  31 (addtest (lisp-stat-ut-dataclos) genseq-offset
  32          (ensure
  33           (equal (lisp-stat-data-clos::gen-seq 4 2)
  34                  (list 2 3 4))))
  35
  36
  37 (addtest (lisp-stat-ut-dataclos) repeatseq
  38          (ensure
  39           (equal (lisp-stat-data-clos::repeat-seq 3 "d")
  40                  (list "d" "d" "d")))
  41                  (ensure
  42           (equal (lisp-stat-data-clos::repeat-seq 3 'd)
  43                  (list 'd 'd 'd))))
  44
  45
  46
  47
  48
  49
  50
  51
  52
  53
  54 ;;; Dataframe
  55
  56 (addtest (lisp-stat-ut-dataclos) df-equalp
  57          (ensure
  58           (equalp (dataset (make-instance 'dataframe-array
  59                                           :storage #2A(('a 'b)
  60                                                        ('c 'd))))
  61                   #2A(('a 'b)
  62                       ('c 'd)))))
  63
  64
  65 ;; FAKE DF
  66 (defparameter *my-df-0*
  67   (make-instance 'dataframe-array
  68                  :storage #2A((1 2 3 4 5)
  69                               (10 20 30 40 50))
  70                  :doc "This is an interesting dataframe-array"
  71                  :case-labels (list "a" "b" "c" "d" "e")
  72                  :var-labels (list "x" "y")))
  73
  74 ;; WORKING DF
  75 (defparameter *my-df-1*
  76   (make-instance 'dataframe-array
  77                  :storage #2A((1 2 3 4 5)
  78                               (10 20 30 40 50))
  79                  :doc "This is an interesting dataframe-array"
  80                  :case-labels (list "x" "y")
  81                  :var-labels  (list "a" "b" "c" "d" "e")))
  82
  83 (addtest (lisp-stat-ut-dataclos) df-consdata
  84          (ensure
  85           (consistent-dataframe-p *my-df-1*)))
  86
  87 (addtest (lisp-stat-ut-dataclos) df-access-1
  88          (ensure-error
  89           (slot-value *my-df-1* 'store)))
  90
  91 (addtest (lisp-stat-ut-dataclos) df-access-2
  92          (ensure-error
  93           (slot-value *my-df-1* 'store)))
  94
  95 (addtest (lisp-stat-ut-dataclos) df-access-3
  96          (ensure
  97           (dataset *my-df-1*)))
  98
  99 (addtest (lisp-stat-ut-dataclos) df-access-4
 100          (ensure
 101           (equalp
 102            (slot-value *my-df-1* 'lisp-stat-data-clos::store)
 103            (lisp-stat-data-clos::dataset *my-df-1*))))
 104
 105 (addtest (lisp-stat-ut-dataclos) badAccess5
 106          (ensure
 107           (eq (lisp-stat-data-clos::dataset *my-df-1*)
 108               (slot-value *my-df-1* 'lisp-stat-data-clos::store))))
 109
 110
 111 ;; NEVER REACH INTO CLASS INTERIORS, NO PROMISE GUARANTEE OF LATER CONSISTENCY...
 112
 113 (addtest (lisp-stat-ut-dataclos) badAccess6
 114          (ensure
 115           (lisp-stat-data-clos::doc-string *my-df-1*))
 116          (ensure-error
 117           (doc-string *my-df-1*)))
 118
 119 (addtest (lisp-stat-ut-dataclos) badAccess7
 120          (ensure
 121           (lisp-stat-data-clos::case-labels *my-df-1*))
 122          (ensure-error
 123           (case-labels *my-df-1*)))
 124
 125 (addtest (lisp-stat-ut-dataclos) badAccess8
 126          (ensure
 127           (lisp-stat-data-clos::var-labels *my-df-1*))
 128          (ensure-error
 129           (var-labels *my-df-1*)))
 130
 131 ;; need to ensure that for things like the following, that we protect
 132 ;; this a bit more so that the results are not going to to be wrong.
 133 ;; That would be a bit nasty if the dataframe-array becomes
 134 ;; inconsistent.
 135
 136 (addtest (lisp-stat-ut-dataclos) badAccess9
 137          (ensure
 138           (setf (lisp-stat-data-clos::var-labels *my-df-1*)
 139                 (list "a" "b"))))
 140
 141 (addtest (lisp-stat-ut-dataclos) badAccess10
 142          (ensure
 143           (progn
 144             ;; no error, but corrupts structure
 145             (setf (lisp-stat-data-clos::var-labels *my-df-1*)
 146                   (list "a" "b" "c"))
 147             ;; error happens here
 148             (not (consistent-dataframe-like-p *my-df-1*))))) ;; Nil
 149
 150 (addtest (lisp-stat-ut-dataclos) badAccess12
 151          (ensure
 152           (setf (lisp-stat-data-clos::var-labels *my-df-1*)
 153                 (list "a" "b"))))
 154
 155 (addtest (lisp-stat-ut-dataclos) badAccess13
 156          (ensure
 157           (consistent-dataframe-like-p *my-df-1*))) ;; T
 158
 159 ;; This is now done by:
 160 (addtest (lisp-stat-ut-dataclos) badAccess14
 161          (ensure-error
 162           (let ((old-varnames (varNames *my-df-1*)))
 163             (setf (varNames *my-df-1*) (list "a" "b")) ;; should error
 164             (setf (varNames *my-df-1*) old-varnames)
 165             (error "don't reach this point in badaccess14"))))
 166
 167 ;; break this up.
 168 (defvar origCaseNames nil)
 169
 170 (addtest (lisp-stat-ut-dataclos) badAccess15
 171          (ensure
 172           (progn
 173             (setf origCaseNames (caseNames *my-df-1*))
 174             (setf (caseNames *my-df-1*) (list "a" "b" "c" 4 5))
 175             (caseNames *my-df-1*)
 176             (ignore-errors
 177               (setf (caseNames *my-df-1*)
 178                     (list "a" "b" 4 5)))
 179             (setf (caseNames *my-df-1*) origCaseNames))))
 180
 181 ;;;
 182 ;; (run-tests)
 183 ;; (describe (run-tests))