Revision: 3570 Author: ksprotte URL: http://bknr.net/trac/changeset/3570

added a test allocation.disconnected-m2s.1 that should fail

U trunk/projects/bos/test/allocation.lisp

Modified: trunk/projects/bos/test/allocation.lisp =================================================================== --- trunk/projects/bos/test/allocation.lisp 2008-07-23 08:34:26 UTC (rev 3569) +++ trunk/projects/bos/test/allocation.lisp 2008-07-23 09:27:20 UTC (rev 3570) @@ -210,4 +210,24 @@ (test validate-allocation-area-inclusion-cache (with-fixture initial-bos-store () (let ((area1 (make-allocation-rectangle 0 0 8 8))) - (finishes (bos.m2::validate-allocation-area-inclusion-cache))))) \ No newline at end of file + (finishes (bos.m2::validate-allocation-area-inclusion-cache))))) + +(test allocation.disconnected-m2s.1 + (with-fixture initial-bos-store (:delete-store t) + (let ((area (make-allocation-area #((7193 . 5195) (7351 . 5193) (7340 . 5377) (7185 . 5390) (7174 . 5385) + (7166 . 5387) (7156 . 5381) (7150 . 5379) (7143 . 5374) (7136 . 5368) + (7135 . 5364) (7135 . 5359) (7140 . 5347) (7145 . 5342) (7148 . 5329) + (7156 . 5329) (7157 . 5334) (7166 . 5331) (7170 . 5329) (7171 . 5327) + (7174 . 5316) (7184 . 5306) (7185 . 5291) (7196 . 5286) (7197 . 5287) + (7200 . 5287) (7201 . 5284) (7203 . 5275) (7201 . 5264) (7191 . 5249) + (7203 . 5237) (7199 . 5235) (7195 . 5233) (7198 . 5222) (7202 . 5219) + (7202 . 5214) (7204 . 5205) (7195 . 5197)))) + (sponsor (make-sponsor :login "test-sponsor")) + (m2-counts '(12 43 29 3))) + (dolist (m2-count m2-counts) + (let ((contract (make-contract sponsor m2-count))) + (print (list 'make-contract-returned contract)))) + ;; This following check reported: + ;; WARNING: #<CONTRACT ID: 32131, unpaid> has m2s that are not + ;; connected + (is (bos.m2::consistent-p))))) \ No newline at end of file