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-25 08:02:27 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-function support
  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 (addtest (lisp-stat-ut-dataclos) equaltestnameData
  37          (ensure-error
  38           (equal (lisp-stat-data-clos::dataset
  39                   (make-instance 'dataframe-array
  40                                  :storage #2A(('a 'b)
  41                                               ('c 'd))))
  42                  #2A(('a 'b)
  43                      ('c 'd)))))
  44
  45 #|
  46  (defvar my-ds-1 nil
  47   "test ds for experiment.")
  48  (setf my-ds-1 (make-instance 'dataframe-array))
  49  my-ds-1
  50 |#
  51
  52 (defvar my-ds-2 nil
  53   "test ds for experiment.")
  54
  55 (setf my-ds-2 (make-instance 'dataframe-array
  56                              :storage #2A((1 2 3 4 5)
  57                                           (10 20 30 40 50))
  58                              :doc "This is an interesting dataframe-array"
  59                              :case-labels (list "a" "b" "c" "d" "e")
  60                              :var-labels (list "x" "y")))
  61 my-ds-2
  62 (make-array (list 3 5))
  63
  64 (array-dimensions (lisp-stat-data-clos::dataset my-ds-2))
  65
  66
  67 (addtest (lisp-stat-ut-dataclos) consData
  68          (ensure
  69           (consistent-dataframe-like-p my-ds-2)))
  70
  71 (addtest (lisp-stat-ut-dataclos) badAccess1
  72          (ensure-error
  73           (slot-value my-ds-2 'store)))
  74
  75 (addtest (lisp-stat-ut-dataclos) badAccess2
  76          (ensure-error
  77           (slot-value my-ds-2 'store)))
  78
  79 (addtest (lisp-stat-ut-dataclos) badAccess3
  80          (ensure-error
  81           (lisp-stat-data-clos::dataset my-ds-2)))
  82
  83 (addtest (lisp-stat-ut-dataclos) badAccess4
  84          (ensure
  85           (equal
  86            (slot-value my-ds-2 'lisp-stat-data-clos::store)
  87            (lisp-stat-data-clos::dataset my-ds-2))))
  88
  89
  90 (addtest (lisp-stat-ut-dataclos) badAccess5
  91          (ensure
  92           (eq (lisp-stat-data-clos::dataset my-ds-2)
  93               (slot-value my-ds-2 'lisp-stat-data-clos::store))))
  94
  95
  96 ;; NEVER DO THE FOLLOWING, UNLESS YOU WANT TO MUCK UP STRUCTURES...
  97 (addtest (lisp-stat-ut-dataclos) badAccess6
  98          (ensure
  99           (lisp-stat-data-clos::doc-string my-ds-2)))
 100
 101 (addtest (lisp-stat-ut-dataclos) badAccess7
 102          (ensure
 103           (lisp-stat-data-clos::case-labels my-ds-2)))
 104
 105 (addtest (lisp-stat-ut-dataclos) badAccess8
 106          (ensure
 107           (lisp-stat-data-clos::var-labels my-ds-2)))
 108
 109 ;; need to ensure that for things like the following, that we protect
 110 ;; this a bit more so that the results are not going to to be wrong.
 111 ;; That would be a bit nasty if the dataframe-array becomes
 112 ;; inconsistent.
 113
 114 (addtest (lisp-stat-ut-dataclos) badAccess9
 115          (ensure
 116           (setf (lisp-stat-data-clos::var-labels my-ds-2)
 117                 (list "a" "b"))))
 118
 119 (addtest (lisp-stat-ut-dataclos) badAccess10
 120          (ensure
 121           (progn
 122             ;; no error, but corrupts structure
 123             (setf (lisp-stat-data-clos::var-labels my-ds-2)
 124                   (list "a" "b" "c"))
 125             ;; error happens here
 126             (not (consistent-dataframe-like-p my-ds-2))))) ;; Nil
 127
 128 (addtest (lisp-stat-ut-dataclos) badAccess12
 129          (ensure
 130           (setf (lisp-stat-data-clos::var-labels my-ds-2)
 131                 (list "a" "b"))))
 132
 133 (addtest (lisp-stat-ut-dataclos) badAccess13
 134          (ensure
 135           (consistent-dataframe-like-p my-ds-2))) ;; T
 136
 137 ;; This is now done by:
 138 (addtest (lisp-stat-ut-dataclos) badAccess14
 139          (ensure-error
 140           (let ((old-varnames (varNames my-ds-2)))
 141             (setf (varNames my-ds-2) (list "a" "b")) ;; should error
 142             (setf (varNames my-ds-2) old-varnames)
 143             (error "don't reach this point in badaccess14"))))
 144
 145 ;; break this up.
 146 (defvar origCaseNames nil)
 147
 148 (addtest (lisp-stat-ut-dataclos) badAccess15
 149          (ensure
 150           (progn
 151             (setf origCaseNames (caseNames my-ds-2))
 152             (setf (caseNames my-ds-2) (list "a" "b" "c" 4 5))
 153             (caseNames my-ds-2)
 154             (ignore-errors
 155               (setf (caseNames my-ds-2)
 156                     (list "a" "b" 4 5)))
 157             (setf (caseNames my-ds-2) origCaseNames))))
 158
 159 ;;;
 160 ;; (run-tests)
 161 ;; (describe (run-tests))