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