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