[bknr-cvs] r2365 - branches/bos/projects/bos/m2

[hhubner at common-lisp.net]

Author: hhubner
Date: Sat Jan 19 03:41:47 2008
New Revision: 2365

Modified:
   branches/bos/projects/bos/m2/allocation-test.lisp
   branches/bos/projects/bos/m2/m2.lisp
Log:
Add test that verifies that the "old" allocation algorithm can allocate all sqms in an area at once.

Modified: branches/bos/projects/bos/m2/allocation-test.lisp
==============================================================================
--- branches/bos/projects/bos/m2/allocation-test.lisp	(original)
+++ branches/bos/projects/bos/m2/allocation-test.lisp	Sat Jan 19 03:41:47 2008
@@ -30,3 +30,11 @@
       (finishes (make-contract sponsor m2-count))
       (is (zerop (allocation-area-free-m2s area))))))
 
+(test allocation-area.one-contract.allocate-all-without-cache
+  (with-fixture empty-store ()
+    (let ((area (make-allocation-rectangle 0 0 2 5))
+	  (sponsor (make-sponsor :login "test-sponsor"))
+	  (m2-count 10))
+      (finishes (make-contract sponsor m2-count))
+      (signals (error) (make-contract sponsor m2-count))
+      (is (zerop (allocation-area-free-m2s area))))))
\ No newline at end of file

Modified: branches/bos/projects/bos/m2/m2.lisp
==============================================================================
--- branches/bos/projects/bos/m2/m2.lisp	(original)
+++ branches/bos/projects/bos/m2/m2.lisp	Sat Jan 19 03:41:47 2008
@@ -459,6 +459,7 @@
   (when delete
     (delete-directory directory)
     (assert (not (probe-file directory))))
+  (close-store)
   (make-instance 'm2-store
 		 :directory directory
 		 :subsystems (list (make-instance 'store-object-subsystem)