;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ; This file is part of "NOVA": NOVA = search + COCOMO tools ; Copyright, 2008, Tim Menzies tim@menzies.us ; ; NOVA is free software: you can redistribute it and/or modify ; it under the terms of the GNU General Public License as published by ; the Free Software Foundation, either version 3 of the License, or ; (at your option) any later version. ; ; NOVA is distributed in the hope that it will be useful, ; but WITHOUT ANY WARRANTY; without even the implied warranty of ; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the ; GNU General Public License for more details. ; You should have received a copy of the GNU General Public License ; a long with NOVA. If not, see . ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (in-package :wvu-lib-test.guess) (deftestsuite fresh-db-test-suite-mixin () () :documentation "By using this mixin, each test will run in an fresh db." :export-p t :dynamic-variables (*db*) :setup (setf *db* (make-db :default-configurations nil :current-configurations nil :cache nil)) :teardown (setf *db* nil)) (deftestsuite guess-db-test-suite (fresh-db-test-suite-mixin wvu-lib-tests) () :setup (setf (db-default-configurations *db*) (list (cons 'test (list (cons 'c (make-num :min 0 :max 2)) (cons 'd (make-bag :range (list 1 2 3 4)))))) (db-current-configurations *db*) (list (cons 'a (make-num :min 4 :max 6)) (cons 'b (make-bag :range (list 5 6 7 8)))))) ;;TODO tests for copy-configurations ;;TODO tests for full-copy-db ;;; accessing current-configurations (addtest get-current-attribute-configuration (ensure-same (get-current-attribute-configuration 'a) (geta 'a (db-current-configurations *db*)))) (addtest get-current-attribute-configuration-key-not-in-db (ensure-error (get-current-attribute-configuration 'invalid-key))) (addtest set-current-attribute-configuration (let ((new-configuration (make-num :min 10 :max 20))) (set-current-attribute-configuration 'a new-configuration) (ensure-same (get-current-attribute-configuration 'a) new-configuration))) (addtest set-current-attribute-configuration-key-not-in-db (ensure-error (set-current-attribute-configuration 'invalid-key nil))) ;;; guessing and caching values in *db* (addtest ?-value (ensure (<= 4 (? 'a) 6) :report "check that ? works")) (addtest ?-key-not-in-db (ensure-error (? 'invalid-key) :report "check that ? signals error when key isn't found")) (addtest !-value (ensure (<= 4 (! 'a) 6) :report "check that ! works")) (addtest ?-different (ensure-different (? 'a) (? 'a) :report "check that consecutive calls to ? are the different (not perfect)")) (addtest !-same (ensure-same (! 'a) (! 'a) :report "check that consecutive calls to ! are the same")) (addtest zap-target (ensure-different (! 'a) (progn (zap 'a) (! 'a)) :report "check that zap clears specifed variable (not perfect)")) (addtest zap-not-target (ensure-same (! 'a) (progn (zap 'b) (! 'a)) :report "check that zap clears specifed variable and not other variables")) (addtest zaps-single (ensure-different (! 'a) (progn (zaps) (! 'a)) :report "check that zap clears specifed variable (not perfect)")) (addtest zaps-multiple (ensure-different (list (! 'a) (! 'b)) (progn (zaps) (list (! 'a) (! 'b))) :test #'equalp :report "check that zap clears specifed variable (not perfect)")) ;;; initializing the db (addtest register-db-default-conifiguration-list-added (ensure-same (progn (register-db-default-configuration-list 'test2 (list (cons 'e (make-num :min 1 :max 4)) (cons 'f (make-bag :range (list 8 9 10 11))))) (length (db-default-configurations *db*))) 2)) (addtest init-db-new-values-loaded (ensure (progn (init-db) (member (? 'd) '(1 2 3 4))) :report "Make sure the new current-configurations are loaded")) (addtest init-db-old-values-removed (ensure-error (progn (init-db) (? 'a)) :report "Make sure the old current-configurations are removed") ) (addtest init-db-didnt-reset-when-current-config-is-modified (init-db) (setf (bag-range (get-current-attribute-configuration 'd)) '(5)) (ensure-same (? 'd) 5) (init-db) (ensure (member (? 'd) '(1 2 3 4)) :report "After init-db, config wasn't restored")) ;;; helpers (addtest with-new-db-new-db-not-eql (ensure-different *db* (with-new-db *db*) :report "check that the db in with-new-db isn't the exact same as old db")) (addtest with-new-db-new-db-equalp (ensure-same *db* (with-new-db *db*) :test #'equalp :report "check that the db in with-new-db has the same content as old db")) (addtest with-new-db-diff-after-cache-change (ensure-different *db* (with-new-db (! 'a) *db*) :test #'equalp :report "check that the db in with-new-db is different after cache has been modified")) (addtest with-new-db-diff-after-current-configurations-change (ensure-different *db* (with-new-db (init-db) *db*) :test #'equalp :report "check that the db in with-new-db is different after init-db")) (addtest with-new-db-diff-after-default-configurations-change (ensure-different *db* (with-new-db (register-db-default-configuration-list 'test `((c . (make-num :min 2 :max 3)))) *db*) :test #'equalp :report "check that the db in with-new-db is different after register-db-default-configuration-list update")) (addtest check-all-db-keys (ensure-same (all-db-keys) '(a b) :test #'subset-compare :report "check that all-db-keys works")) (addtest check-all-db-cache-keys (! 'a) (ensure-same (all-db-cache-keys) '(a) :test #'subset-compare :report "check that all-db-cache-keys works")) (addtest check-all-db-cache-keys (cache-all) (ensure-same (all-db-cache-keys) '(a b) :test #'subset-compare :report "check that cache-all works")) (addtest check-dump-cache (! 'a) (! 'b) (ensure (null (eql (dump-cache) (db-cache *db*))) :report "Make sure that dump-cache and db-cache aren't the same list") (ensure-same (dump-cache) (db-cache *db*) :test #'equalp :report "Make sure that dump-cache and db-cache have the same content"))