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