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