Author: ksprotte Date: Fri Jan 18 11:03:44 2008 New Revision: 2356 Added: branches/bos/projects/bos/test/allocation-area.lisp branches/bos/projects/bos/test/fixtures.lisp Modified: branches/bos/projects/bos/Makefile branches/bos/projects/bos/m2/m2.lisp branches/bos/projects/bos/test/allocation-cache.lisp branches/bos/projects/bos/test/bos.test.asd branches/bos/projects/bos/test/packages.lisp branches/bos/projects/bos/test/suites.lisp Log: a few tests are place; some fail... Modified: branches/bos/projects/bos/Makefile ============================================================================== --- branches/bos/projects/bos/Makefile (original) +++ branches/bos/projects/bos/Makefile Fri Jan 18 11:03:44 2008 @@ -7,10 +7,15 @@ bos.core: cmucl.core build.sh load.lisp build.lisp ./build.sh +# run with slime +.PHONY: slime +slime: bos.core + lisp -core bos.core -slime + # test .PHONY: test -test: +test: bos.core lisp -core bos.core -test -slime # various cleaning stuff @@ -40,3 +45,8 @@ make cleancore make all +# TAGS + +TAGS: + find . -name '*.lisp' | xargs etags -a + Modified: branches/bos/projects/bos/m2/m2.lisp ============================================================================== --- branches/bos/projects/bos/m2/m2.lisp (original) +++ branches/bos/projects/bos/m2/m2.lisp Fri Jan 18 11:03:44 2008 @@ -451,6 +451,10 @@ (setf *website-url* website-url) (unless directory (error ":DIRECTORY parameter not set in m2.rc")) + (assert (and (null (pathname-name directory)) + (null (pathname-type directory))) + (directory) + ":DIRECTORY parameter is ~s (not a directory pathname)" directory) (when delete (delete-directory directory) (assert (not (probe-file directory)))) Added: branches/bos/projects/bos/test/allocation-area.lisp ============================================================================== --- (empty file) +++ branches/bos/projects/bos/test/allocation-area.lisp Fri Jan 18 11:03:44 2008 @@ -0,0 +1,19 @@ +(in-package :bos.test) +(in-suite :bos.test.allocation-area) + +(test allocation-area.none-at-startup + (with-fixture empty-store () + (is (null (class-instances 'bos.m2:allocation-area))))) + +(test allocation-area.no-intersection + (with-fixture empty-store () + (finishes (make-allocation-rectangle 0 0 100 100)) + (signals (error) (make-allocation-rectangle 0 0 100 100)))) + +(test allocation-area.one-contract + (with-fixture empty-store () + (let ((area (make-allocation-rectangle 0 0 100 100)) + (sponsor (make-sponsor :login "test-sponsor")) + (m2-count 10)) + (finishes (make-contract sponsor m2-count))))) + Modified: branches/bos/projects/bos/test/allocation-cache.lisp ============================================================================== --- branches/bos/projects/bos/test/allocation-cache.lisp (original) +++ branches/bos/projects/bos/test/allocation-cache.lisp Fri Jan 18 11:03:44 2008 @@ -1,9 +1,7 @@ (in-package :bos.test) (in-suite :bos.test.allocation-cache) -(test dummy - (is (= 1 1))) - -(test dummy.2 - (is (= 1 2))) +(test allocation-cache.present + (with-fixture empty-store () + (finishes (bos.m2.allocation-cache:find-exact-match 1)))) Modified: branches/bos/projects/bos/test/bos.test.asd ============================================================================== --- branches/bos/projects/bos/test/bos.test.asd (original) +++ branches/bos/projects/bos/test/bos.test.asd Fri Jan 18 11:03:44 2008 @@ -5,6 +5,8 @@ :depends-on (:bos.web :fiveam) :components ((:file "packages") (:file "suites" :depends-on ("packages")) - (:file "allocation-cache" :depends-on ("suites")) + (:file "fixtures" :depends-on ("packages")) + (:file "allocation-area" :depends-on ("suites" "fixtures")) + (:file "allocation-cache" :depends-on ("suites" "fixtures")) ;; (:file "utils" :depends-on ("config")) )) Added: branches/bos/projects/bos/test/fixtures.lisp ============================================================================== --- (empty file) +++ branches/bos/projects/bos/test/fixtures.lisp Fri Jan 18 11:03:44 2008 @@ -0,0 +1,10 @@ +(in-package :bos.test) + +(def-fixture empty-store () + (bos.m2::reinit :delete t + :directory #p"/tmp/test-store.tmp/" + :website-url bos.m2::*website-url*) + (unwind-protect + (&body) + (close-store))) + Modified: branches/bos/projects/bos/test/packages.lisp ============================================================================== --- branches/bos/projects/bos/test/packages.lisp (original) +++ branches/bos/projects/bos/test/packages.lisp Fri Jan 18 11:03:44 2008 @@ -13,6 +13,7 @@ :bknr.images :bknr.statistics :bknr.rss + :bos.m2 :bos.m2.config )) Modified: branches/bos/projects/bos/test/suites.lisp ============================================================================== --- branches/bos/projects/bos/test/suites.lisp (original) +++ branches/bos/projects/bos/test/suites.lisp Fri Jan 18 11:03:44 2008 @@ -3,6 +3,10 @@ (def-suite :bos.test :description "The root suite. Contains all tests.") +(def-suite :bos.test.allocation-area + :in :bos.test + :description "Some basic tests for allocation-area.") + (def-suite :bos.test.allocation-cache :in :bos.test :description "Tests for the newly introduced allocation-cache.")