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