[bknr-cvs] r2356 - in branches/bos/projects/bos: . m2 test

[ksprotte at common-lisp.net]

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.")