Update of /project/climacs/cvsroot/climacs In directory common-lisp.net:/tmp/cvs-serv27993

Modified Files: TODO base-test.lisp buffer-test.lisp climacs.asd Log Message: Test refactoring.

Date: Thu Feb 10 01:27:07 2005 Author: abakic

Index: climacs/TODO diff -u climacs/TODO:1.2 climacs/TODO:1.3 --- climacs/TODO:1.2 Tue Feb 8 06:25:05 2005 +++ climacs/TODO Thu Feb 10 01:27:07 2005 @@ -5,8 +5,6 @@ one sequence type for lines, the other for line contents), then upgrade it to an undoable buffer

-- refactor tests - - handle wrapped lines instead of making McCLIM handle them

- replace the use of the scroller pane by custom pane

Index: climacs/base-test.lisp diff -u climacs/base-test.lisp:1.8 climacs/base-test.lisp:1.9 --- climacs/base-test.lisp:1.8 Mon Feb 7 23:13:37 2005 +++ climacs/base-test.lisp Thu Feb 10 01:27:07 2005 @@ -5,288 +5,288 @@

(in-package :climacs-tests)

-(deftest standard-buffer-previous-line.test-1 - (let ((buffer (make-instance 'standard-buffer))) +(defmultitest previous-line.test-1 + (let ((buffer (make-instance %%buffer))) (insert-buffer-sequence buffer 0 "climacs climacs") - (let ((mark (make-instance 'standard-left-sticky-mark + (let ((mark (make-instance %%left-sticky-mark :buffer buffer :offset 8))) (previous-line mark) (offset mark))) 0)

-(deftest standard-buffer-previous-line.test-2 - (let ((buffer (make-instance 'standard-buffer))) +(defmultitest previous-line.test-2 + (let ((buffer (make-instance %%buffer))) (insert-buffer-sequence buffer 0 "climacs climacs") - (let ((mark (make-instance 'standard-right-sticky-mark + (let ((mark (make-instance %%right-sticky-mark :buffer buffer :offset 11))) (previous-line mark 2) (offset mark))) 2)

-(deftest standard-buffer-previous-line.test-3 - (let ((buffer (make-instance 'standard-buffer))) +(defmultitest previous-line.test-3 + (let ((buffer (make-instance %%buffer))) (insert-buffer-sequence buffer 0 "climacs climacs") - (let ((mark (make-instance 'standard-left-sticky-mark + (let ((mark (make-instance %%left-sticky-mark :buffer buffer :offset 7))) (previous-line mark) (offset mark))) 7)

-(deftest standard-buffer-previous-line.test-4 - (let ((buffer (make-instance 'standard-buffer))) +(defmultitest previous-line.test-4 + (let ((buffer (make-instance %%buffer))) (insert-buffer-sequence buffer 0 "climacs climacs") - (let ((mark (make-instance 'standard-right-sticky-mark + (let ((mark (make-instance %%right-sticky-mark :buffer buffer :offset 7))) (previous-line mark 2) (offset mark))) 2)

-(deftest standard-buffer-previous-line.test-5 - (let ((buffer (make-instance 'standard-buffer))) +(defmultitest previous-line.test-5 + (let ((buffer (make-instance %%buffer))) (insert-buffer-sequence buffer 0 "climacs climacs") - (let ((mark (make-instance 'standard-left-sticky-mark + (let ((mark (make-instance %%left-sticky-mark :buffer buffer :offset 0))) (previous-line mark) (offset mark))) 0)

-(deftest standard-buffer-previous-line.test-6 - (let ((buffer (make-instance 'standard-buffer))) +(defmultitest previous-line.test-6 + (let ((buffer (make-instance %%buffer))) (insert-buffer-sequence buffer 0 "climacs climacs") - (let ((mark (make-instance 'standard-right-sticky-mark + (let ((mark (make-instance %%right-sticky-mark :buffer buffer :offset 0))) (previous-line mark 2) (offset mark))) 2)

-(deftest standard-buffer-previous-line.test-7 - (let ((buffer (make-instance 'standard-buffer))) +(defmultitest previous-line.test-7 + (let ((buffer (make-instance %%buffer))) (insert-buffer-sequence buffer 0 "climacs climacs2") - (let ((mark (make-instance 'standard-left-sticky-mark + (let ((mark (make-instance %%left-sticky-mark :buffer buffer :offset 15))) (previous-line mark) (offset mark))) 7)

-(deftest standard-buffer-next-line.test-1 - (let ((buffer (make-instance 'standard-buffer))) +(defmultitest next-line.test-1 + (let ((buffer (make-instance %%buffer))) (insert-buffer-sequence buffer 0 "climacs climacs") - (let ((mark (make-instance 'standard-left-sticky-mark + (let ((mark (make-instance %%left-sticky-mark :buffer buffer :offset 6))) (next-line mark) (offset mark))) 14)

-(deftest standard-buffer-next-line.test-2 - (let ((buffer (make-instance 'standard-buffer))) +(defmultitest next-line.test-2 + (let ((buffer (make-instance %%buffer))) (insert-buffer-sequence buffer 0 "climacs climacs") - (let ((mark (make-instance 'standard-right-sticky-mark + (let ((mark (make-instance %%right-sticky-mark :buffer buffer :offset 3))) (next-line mark 2) (offset mark))) 10)

-(deftest standard-buffer-next-line.test-3 - (let ((buffer (make-instance 'standard-buffer))) +(defmultitest next-line.test-3 + (let ((buffer (make-instance %%buffer))) (insert-buffer-sequence buffer 0 "climacs climacs") - (let ((mark (make-instance 'standard-left-sticky-mark + (let ((mark (make-instance %%left-sticky-mark :buffer buffer :offset 8))) (next-line mark) (offset mark))) 8)

-(deftest standard-buffer-next-line.test-4 - (let ((buffer (make-instance 'standard-buffer))) +(defmultitest next-line.test-4 + (let ((buffer (make-instance %%buffer))) (insert-buffer-sequence buffer 0 "climacs climacs") - (let ((mark (make-instance 'standard-right-sticky-mark + (let ((mark (make-instance %%right-sticky-mark :buffer buffer :offset 8))) (next-line mark 2) (offset mark))) 10)

-(deftest standard-buffer-next-line.test-5 - (let ((buffer (make-instance 'standard-buffer))) +(defmultitest next-line.test-5 + (let ((buffer (make-instance %%buffer))) (insert-buffer-sequence buffer 0 "climacs climacs") - (let ((mark (make-instance 'standard-left-sticky-mark + (let ((mark (make-instance %%left-sticky-mark :buffer buffer :offset 15))) (next-line mark) (offset mark))) 15)

-(deftest standard-buffer-next-line.test-6 - (let ((buffer (make-instance 'standard-buffer))) +(defmultitest next-line.test-6 + (let ((buffer (make-instance %%buffer))) (insert-buffer-sequence buffer 0 "climacs climacs") - (let ((mark (make-instance 'standard-right-sticky-mark + (let ((mark (make-instance %%right-sticky-mark :buffer buffer :offset 15))) (next-line mark 2) (offset mark))) 10)

-(deftest standard-buffer-next-line.test-7 - (let ((buffer (make-instance 'standard-buffer))) +(defmultitest next-line.test-7 + (let ((buffer (make-instance %%buffer))) (insert-buffer-sequence buffer 0 "climacs climacs") - (let ((mark (make-instance 'standard-left-sticky-mark + (let ((mark (make-instance %%left-sticky-mark :buffer buffer :offset 0))) (next-line mark) (offset mark))) 8)

-(deftest standard-buffer-open-line.test-1 - (let ((buffer (make-instance 'standard-buffer))) +(defmultitest open-line.test-1 + (let ((buffer (make-instance %%buffer))) (insert-buffer-sequence buffer 0 "climacs") - (let ((mark (make-instance 'standard-left-sticky-mark + (let ((mark (make-instance %%left-sticky-mark :buffer buffer :offset 0))) (open-line mark) (values (buffer-sequence buffer 0 (size buffer)) (offset mark)))) " climacs" 0)

-(deftest standard-buffer-open-line.test-2 - (let ((buffer (make-instance 'standard-buffer))) +(defmultitest open-line.test-2 + (let ((buffer (make-instance %%buffer))) (insert-buffer-sequence buffer 0 "climacs") - (let ((mark (make-instance 'standard-right-sticky-mark + (let ((mark (make-instance %%right-sticky-mark :buffer buffer :offset 0))) (open-line mark) (values (buffer-sequence buffer 0 (size buffer)) (offset mark)))) " climacs" 0)

-(deftest standard-buffer-open-line.test-3 - (let ((buffer (make-instance 'standard-buffer))) +(defmultitest open-line.test-3 + (let ((buffer (make-instance %%buffer))) (insert-buffer-sequence buffer 0 "climacs") - (let ((mark (make-instance 'standard-left-sticky-mark + (let ((mark (make-instance %%left-sticky-mark :buffer buffer :offset 7))) (open-line mark) (values (buffer-sequence buffer 0 (size buffer)) (offset mark)))) "climacs " 7)

-(deftest standard-buffer-open-line.test-4 - (let ((buffer (make-instance 'standard-buffer))) +(defmultitest open-line.test-4 + (let ((buffer (make-instance %%buffer))) (insert-buffer-sequence buffer 0 "climacs") - (let ((mark (make-instance 'standard-right-sticky-mark + (let ((mark (make-instance %%right-sticky-mark :buffer buffer :offset 7))) (open-line mark) (values (buffer-sequence buffer 0 (size buffer)) (offset mark)))) "climacs " 7)

-(deftest standard-buffer-kill-line.test-1 - (let ((buffer (make-instance 'standard-buffer))) +(defmultitest kill-line.test-1 + (let ((buffer (make-instance %%buffer))) (insert-buffer-sequence buffer 0 "climacs") - (let ((mark (make-instance 'standard-left-sticky-mark + (let ((mark (make-instance %%left-sticky-mark :buffer buffer :offset 0))) (kill-line mark) (values (buffer-sequence buffer 0 (size buffer)) (offset mark)))) #() 0)

-(deftest standard-buffer-kill-line.test-2 - (let ((buffer (make-instance 'standard-buffer))) +(defmultitest kill-line.test-2 + (let ((buffer (make-instance %%buffer))) (insert-buffer-sequence buffer 0 "climacs") - (let ((mark (make-instance 'standard-right-sticky-mark + (let ((mark (make-instance %%right-sticky-mark :buffer buffer :offset 0))) (kill-line mark) (values (buffer-sequence buffer 0 (size buffer)) (offset mark)))) #() 0)

-(deftest standard-buffer-kill-line.test-3 - (let ((buffer (make-instance 'standard-buffer))) +(defmultitest kill-line.test-3 + (let ((buffer (make-instance %%buffer))) (insert-buffer-sequence buffer 0 "climacs") - (let ((mark (make-instance 'standard-left-sticky-mark + (let ((mark (make-instance %%left-sticky-mark :buffer buffer :offset 7))) (kill-line mark) (values (buffer-sequence buffer 0 (size buffer)) (offset mark)))) "climacs" 7)

-(deftest standard-buffer-kill-line.test-4 - (let ((buffer (make-instance 'standard-buffer))) +(defmultitest kill-line.test-4 + (let ((buffer (make-instance %%buffer))) (insert-buffer-sequence buffer 0 "climacs") - (let ((mark (make-instance 'standard-right-sticky-mark + (let ((mark (make-instance %%right-sticky-mark :buffer buffer :offset 7))) (kill-line mark) (values (buffer-sequence buffer 0 (size buffer)) (offset mark)))) "climacs" 7)

-(deftest standard-buffer-kill-line.test-5 - (let ((buffer (make-instance 'standard-buffer))) +(defmultitest kill-line.test-5 + (let ((buffer (make-instance %%buffer))) (insert-buffer-sequence buffer 0 "climacs climacs") - (let ((mark (make-instance 'standard-left-sticky-mark + (let ((mark (make-instance %%left-sticky-mark :buffer buffer :offset 7))) (kill-line mark) (values (buffer-sequence buffer 0 (size buffer)) (offset mark)))) "climacsclimacs" 7)

-(deftest standard-buffer-kill-line.test-6 - (let ((buffer (make-instance 'standard-buffer))) +(defmultitest kill-line.test-6 + (let ((buffer (make-instance %%buffer))) (insert-buffer-sequence buffer 0 "climacs climacs") - (let ((mark (make-instance 'standard-right-sticky-mark + (let ((mark (make-instance %%right-sticky-mark :buffer buffer :offset 7))) (kill-line mark) (values (buffer-sequence buffer 0 (size buffer)) (offset mark)))) "climacsclimacs" 7)

-(deftest standard-buffer-empty-line-p.test-1 - (let* ((buffer (make-instance 'standard-buffer)) - (m1 (make-instance 'standard-left-sticky-mark :buffer buffer)) - (m2 (make-instance 'standard-right-sticky-mark :buffer buffer))) +(defmultitest empty-line-p.test-1 + (let* ((buffer (make-instance %%buffer)) + (m1 (make-instance %%left-sticky-mark :buffer buffer)) + (m2 (make-instance %%right-sticky-mark :buffer buffer))) (values (empty-line-p m1) (empty-line-p m2))) t t)

-(deftest standard-buffer-empty-line-p.test-2 - (let ((buffer (make-instance 'standard-buffer))) +(defmultitest empty-line-p.test-2 + (let ((buffer (make-instance %%buffer))) (insert-buffer-object buffer 0 #\a) - (let ((m1 (make-instance 'standard-left-sticky-mark :buffer buffer)) - (m2 (make-instance 'standard-right-sticky-mark :buffer buffer))) + (let ((m1 (make-instance %%left-sticky-mark :buffer buffer)) + (m2 (make-instance %%right-sticky-mark :buffer buffer))) (values (empty-line-p m1) (empty-line-p m2)))) nil nil)

-(deftest standard-buffer-empty-line-p.test-3 - (let ((buffer (make-instance 'standard-buffer))) +(defmultitest empty-line-p.test-3 + (let ((buffer (make-instance %%buffer))) (insert-buffer-object buffer 0 #\a) - (let ((m1 (make-instance 'standard-left-sticky-mark + (let ((m1 (make-instance %%left-sticky-mark :buffer buffer :offset 1)) - (m2 (make-instance 'standard-right-sticky-mark + (m2 (make-instance %%right-sticky-mark :buffer buffer :offset 1))) (values (empty-line-p m1) (empty-line-p m2)))) nil nil)

-(deftest standard-buffer-empty-line-p.test-4 - (let ((buffer (make-instance 'standard-buffer))) +(defmultitest empty-line-p.test-4 + (let ((buffer (make-instance %%buffer))) (insert-buffer-sequence buffer 0 "a b") - (let ((m1 (make-instance 'standard-left-sticky-mark + (let ((m1 (make-instance %%left-sticky-mark :buffer buffer :offset 1)) - (m2 (make-instance 'standard-right-sticky-mark + (m2 (make-instance %%right-sticky-mark :buffer buffer :offset 1))) (values (empty-line-p m1) (empty-line-p m2)))) nil nil)

-(deftest standard-buffer-line-indentation.test-1 - (let ((buffer (make-instance 'standard-buffer))) +(defmultitest line-indentation.test-1 + (let ((buffer (make-instance %%buffer))) (insert-buffer-sequence buffer 0 " climacs") - (let ((m1 (make-instance 'standard-left-sticky-mark + (let ((m1 (make-instance %%left-sticky-mark :buffer buffer :offset 0)) - (m2 (make-instance 'standard-right-sticky-mark + (m2 (make-instance %%right-sticky-mark :buffer buffer :offset 0)) - (m3 (make-instance 'standard-left-sticky-mark + (m3 (make-instance %%left-sticky-mark :buffer buffer :offset 10)) - (m4 (make-instance 'standard-right-sticky-mark + (m4 (make-instance %%right-sticky-mark :buffer buffer :offset 10))) (values (line-indentation m1 8) @@ -299,16 +299,16 @@ (offset m4)))) 10 10 10 10 0 0 10 10)

-(deftest standard-buffer-line-indentation.test-2 - (let ((buffer (make-instance 'standard-buffer))) +(defmultitest line-indentation.test-2 + (let ((buffer (make-instance %%buffer))) (insert-buffer-sequence buffer 0 " climacs") - (let ((m1 (make-instance 'standard-left-sticky-mark + (let ((m1 (make-instance %%left-sticky-mark :buffer buffer :offset 0)) - (m2 (make-instance 'standard-right-sticky-mark + (m2 (make-instance %%right-sticky-mark :buffer buffer :offset 0)) - (m3 (make-instance 'standard-left-sticky-mark + (m3 (make-instance %%left-sticky-mark :buffer buffer :offset 11)) - (m4 (make-instance 'standard-right-sticky-mark + (m4 (make-instance %%right-sticky-mark :buffer buffer :offset 11))) (values (line-indentation m1 8) @@ -321,16 +321,16 @@ (offset m4)))) 18 18 18 18 0 0 11 11)

-(deftest standard-buffer-line-indentation.test-3 - (let ((buffer (make-instance 'standard-buffer))) +(defmultitest line-indentation.test-3 + (let ((buffer (make-instance %%buffer))) (insert-buffer-sequence buffer 0 " climacs ") - (let ((m1 (make-instance 'standard-left-sticky-mark + (let ((m1 (make-instance %%left-sticky-mark :buffer buffer :offset 0)) - (m2 (make-instance 'standard-right-sticky-mark + (m2 (make-instance %%right-sticky-mark :buffer buffer :offset 0)) - (m3 (make-instance 'standard-left-sticky-mark + (m3 (make-instance %%left-sticky-mark :buffer buffer :offset 11)) - (m4 (make-instance 'standard-right-sticky-mark + (m4 (make-instance %%right-sticky-mark :buffer buffer :offset 11))) (values (line-indentation m1 8) @@ -343,8 +343,8 @@ (offset m4)))) 10 10 10 10 0 0 11 11)

-(deftest standard-buffer-buffer-number-of-lines-in-region.test-1 - (let ((buffer (make-instance 'standard-buffer))) +(defmultitest buffer-number-of-lines-in-region.test-1 + (let ((buffer (make-instance %%buffer))) (insert-buffer-sequence buffer 0 "climacs climacs") (values @@ -358,8 +358,8 @@ (climacs-base::buffer-number-of-lines-in-region buffer 8 14))) 0 0 1 1 1 1 0 0)

-(deftest standard-buffer-buffer-display-column.test-1 - (let ((buffer (make-instance 'standard-buffer))) +(defmultitest buffer-display-column.test-1 + (let ((buffer (make-instance %%buffer))) (insert-buffer-sequence buffer 0 " cli macs") (values (buffer-display-column buffer 0 8) @@ -369,35 +369,35 @@ (buffer-display-column buffer 6 8))) 0 8 16 19 24)

-(deftest standard-buffer-number-of-lines-in-region.test-1 - (let ((buffer (make-instance 'standard-buffer))) +(defmultitest number-of-lines-in-region.test-1 + (let ((buffer (make-instance %%buffer))) (insert-buffer-sequence buffer 0 " climacs climacs ") - (let ((m1l (make-instance 'standard-left-sticky-mark + (let ((m1l (make-instance %%left-sticky-mark :buffer buffer :offset 0)) - (m1r (make-instance 'standard-right-sticky-mark + (m1r (make-instance %%right-sticky-mark :buffer buffer :offset 0)) - (m2l (make-instance 'standard-left-sticky-mark + (m2l (make-instance %%left-sticky-mark :buffer buffer :offset 1)) - (m2r (make-instance 'standard-left-sticky-mark + (m2r (make-instance %%left-sticky-mark :buffer buffer :offset 1)) - (m3l (make-instance 'standard-left-sticky-mark + (m3l (make-instance %%left-sticky-mark :buffer buffer :offset 3)) - (m3r (make-instance 'standard-right-sticky-mark + (m3r (make-instance %%right-sticky-mark :buffer buffer :offset 3)) - (m4l (make-instance 'standard-left-sticky-mark + (m4l (make-instance %%left-sticky-mark :buffer buffer :offset 8)) - (m4r (make-instance 'standard-right-sticky-mark + (m4r (make-instance %%right-sticky-mark :buffer buffer :offset 8)) - (m5l (make-instance 'standard-left-sticky-mark + (m5l (make-instance %%left-sticky-mark :buffer buffer :offset 15)) - (m5r (make-instance 'standard-right-sticky-mark + (m5r (make-instance %%right-sticky-mark :buffer buffer :offset 15)) - (m6l (make-instance 'standard-left-sticky-mark + (m6l (make-instance %%left-sticky-mark :buffer buffer :offset 16)) - (m6r (make-instance 'standard-right-sticky-mark + (m6r (make-instance %%right-sticky-mark :buffer buffer :offset 16))) (values (number-of-lines-in-region m1l m1r) @@ -420,17 +420,17 @@ (number-of-lines-in-region m3r m6l)))) 0 0 1 1 1 1 1 1 1 1 1 1 1 0 0 0 2 1)

-(deftest standard-buffer-number-of-lines-in-region.test-2 - (let ((buffer (make-instance 'standard-buffer))) +(defmultitest number-of-lines-in-region.test-2 + (let ((buffer (make-instance %%buffer))) (insert-buffer-sequence buffer 0 "climacs climacs") - (let ((m1l (make-instance 'standard-left-sticky-mark + (let ((m1l (make-instance %%left-sticky-mark :buffer buffer :offset 6)) - (m1r (make-instance 'standard-right-sticky-mark + (m1r (make-instance %%right-sticky-mark :buffer buffer :offset 6)) - (m2l (make-instance 'standard-left-sticky-mark + (m2l (make-instance %%left-sticky-mark :buffer buffer :offset 7)) - (m2r (make-instance 'standard-right-sticky-mark + (m2r (make-instance %%right-sticky-mark :buffer buffer :offset 7))) (values (number-of-lines-in-region m1l 10) @@ -444,7 +444,7 @@ (number-of-lines-in-region 10 m2r)))) 1 1 1 1 0 0 0 1 1)

-(deftest constituentp.test-1 ; NOTE: more tests may be needed for sbcl +(defmultitest constituentp.test-1 ; NOTE: more tests may be needed for sbcl (values (constituentp #\a) (constituentp #\Newline) @@ -454,7 +454,7 @@ (constituentp #\Null)) t nil nil nil nil nil)

-(deftest whitespacep.test-1 +(defmultitest whitespacep.test-1 (values (not (null (whitespacep #\a))) (not (null (whitespacep #\Newline))) @@ -464,21 +464,21 @@ (not (null (whitespacep #\Null)))) nil nil t t nil nil)

-(deftest standard-buffer-forward-to-word-boundary.test-1 - (let ((buffer (make-instance 'standard-buffer))) +(defmultitest forward-to-word-boundary.test-1 + (let ((buffer (make-instance %%buffer))) (insert-buffer-sequence buffer 0 " climacs climacs") - (let ((m0l (make-instance 'standard-left-sticky-mark + (let ((m0l (make-instance %%left-sticky-mark :buffer buffer :offset 0)) - (m0r (make-instance 'standard-right-sticky-mark + (m0r (make-instance %%right-sticky-mark :buffer buffer :offset 0)) - (m1l (make-instance 'standard-left-sticky-mark + (m1l (make-instance %%left-sticky-mark :buffer buffer :offset 5)) - (m1r (make-instance 'standard-right-sticky-mark + (m1r (make-instance %%right-sticky-mark :buffer buffer :offset 5)) - (m2l (make-instance 'standard-left-sticky-mark + (m2l (make-instance %%left-sticky-mark :buffer buffer :offset 17)) - (m2r (make-instance 'standard-right-sticky-mark + (m2r (make-instance %%right-sticky-mark :buffer buffer :offset 17))) (values (progn (climacs-base::forward-to-word-boundary m0l) (offset m0l)) @@ -489,21 +489,21 @@ (progn (climacs-base::forward-to-word-boundary m2r) (offset m2r))))) 2 2 5 5 17 17)

-(deftest standard-buffer-backward-to-word-boundary.test-1 - (let ((buffer (make-instance 'standard-buffer))) +(defmultitest backward-to-word-boundary.test-1 + (let ((buffer (make-instance %%buffer))) (insert-buffer-sequence buffer 0 "climacs climacs ") - (let ((m0l (make-instance 'standard-left-sticky-mark + (let ((m0l (make-instance %%left-sticky-mark :buffer buffer :offset 17)) - (m0r (make-instance 'standard-right-sticky-mark + (m0r (make-instance %%right-sticky-mark :buffer buffer :offset 17)) - (m1l (make-instance 'standard-left-sticky-mark + (m1l (make-instance %%left-sticky-mark :buffer buffer :offset 10)) - (m1r (make-instance 'standard-right-sticky-mark + (m1r (make-instance %%right-sticky-mark :buffer buffer :offset 10)) - (m2l (make-instance 'standard-left-sticky-mark + (m2l (make-instance %%left-sticky-mark :buffer buffer :offset 0)) - (m2r (make-instance 'standard-right-sticky-mark + (m2r (make-instance %%right-sticky-mark :buffer buffer :offset 0))) (values (progn (climacs-base::backward-to-word-boundary m0l) (offset m0l)) @@ -514,21 +514,21 @@ (progn (climacs-base::backward-to-word-boundary m2r) (offset m2r))))) 15 15 10 10 0 0)

-(deftest standard-buffer-forward-word.test-1 - (let ((buffer (make-instance 'standard-buffer))) +(defmultitest forward-word.test-1 + (let ((buffer (make-instance %%buffer))) (insert-buffer-sequence buffer 0 " climacs climacs") - (let ((m0l (make-instance 'standard-left-sticky-mark + (let ((m0l (make-instance %%left-sticky-mark :buffer buffer :offset 0)) - (m0r (make-instance 'standard-right-sticky-mark + (m0r (make-instance %%right-sticky-mark :buffer buffer :offset 0)) - (m1l (make-instance 'standard-left-sticky-mark + (m1l (make-instance %%left-sticky-mark :buffer buffer :offset 5)) - (m1r (make-instance 'standard-right-sticky-mark + (m1r (make-instance %%right-sticky-mark :buffer buffer :offset 15)) - (m2l (make-instance 'standard-left-sticky-mark + (m2l (make-instance %%left-sticky-mark :buffer buffer :offset 17)) - (m2r (make-instance 'standard-right-sticky-mark + (m2r (make-instance %%right-sticky-mark :buffer buffer :offset 17))) (values (progn (forward-word m0l) (offset m0l)) @@ -539,21 +539,21 @@ (progn (forward-word m2r) (offset m2r))))) 9 9 9 17 17 17)

-(deftest standard-buffer-backward-word.test-1 - (let ((buffer (make-instance 'standard-buffer))) +(defmultitest backward-word.test-1 + (let ((buffer (make-instance %%buffer))) (insert-buffer-sequence buffer 0 "climacs climacs ") - (let ((m0l (make-instance 'standard-left-sticky-mark + (let ((m0l (make-instance %%left-sticky-mark :buffer buffer :offset 17)) - (m0r (make-instance 'standard-right-sticky-mark + (m0r (make-instance %%right-sticky-mark :buffer buffer :offset 17)) - (m1l (make-instance 'standard-left-sticky-mark + (m1l (make-instance %%left-sticky-mark :buffer buffer :offset 10)) - (m1r (make-instance 'standard-right-sticky-mark + (m1r (make-instance %%right-sticky-mark :buffer buffer :offset 5)) - (m2l (make-instance 'standard-left-sticky-mark + (m2l (make-instance %%left-sticky-mark :buffer buffer :offset 0)) - (m2r (make-instance 'standard-right-sticky-mark + (m2r (make-instance %%right-sticky-mark :buffer buffer :offset 0))) (values (progn (backward-word m0l) (offset m0l)) @@ -564,10 +564,10 @@ (progn (backward-word m2r) (offset m2r))))) 8 8 8 0 0 0)

-(deftest standard-buffer-delete-word.test-1 - (let ((buffer (make-instance 'standard-buffer))) +(defmultitest delete-word.test-1 + (let ((buffer (make-instance %%buffer))) (insert-buffer-sequence buffer 0 "climacs") - (let ((m (make-instance 'standard-left-sticky-mark + (let ((m (make-instance %%left-sticky-mark :buffer buffer :offset 3))) (delete-word m) (values @@ -575,10 +575,10 @@ (offset m)))) "cli" 3)

-(deftest standard-buffer-delete-word.test-2 - (let ((buffer (make-instance 'standard-buffer))) +(defmultitest delete-word.test-2 + (let ((buffer (make-instance %%buffer))) (insert-buffer-sequence buffer 0 " climacs climacs") - (let ((m (make-instance 'standard-right-sticky-mark + (let ((m (make-instance %%right-sticky-mark :buffer buffer :offset 0))) (delete-word m 2) (values @@ -586,10 +586,10 @@ (offset m)))) #() 0)

-(deftest standard-buffer-backward-delete-word.test-1 - (let ((buffer (make-instance 'standard-buffer))) +(defmultitest backward-delete-word.test-1 + (let ((buffer (make-instance %%buffer))) (insert-buffer-sequence buffer 0 "climacs") - (let ((m (make-instance 'standard-left-sticky-mark + (let ((m (make-instance %%left-sticky-mark :buffer buffer :offset 3))) (backward-delete-word m) (values @@ -597,10 +597,10 @@ (offset m)))) "macs" 0)

-(deftest standard-buffer-backward-delete-word.test-2 - (let ((buffer (make-instance 'standard-buffer))) +(defmultitest backward-delete-word.test-2 + (let ((buffer (make-instance %%buffer))) (insert-buffer-sequence buffer 0 "climacs climacs ") - (let ((m (make-instance 'standard-right-sticky-mark + (let ((m (make-instance %%right-sticky-mark :buffer buffer :offset 17))) (backward-delete-word m 2) (values @@ -608,14 +608,14 @@ (offset m)))) #() 0)

-(deftest standard-buffer-previous-word.test-1 - (let ((buffer (make-instance 'standard-buffer))) +(defmultitest previous-word.test-1 + (let ((buffer (make-instance %%buffer))) (insert-buffer-sequence buffer 0 "climacs climacs") - (let ((m0 (make-instance 'standard-right-sticky-mark + (let ((m0 (make-instance %%right-sticky-mark :buffer buffer :offset 7)) - (m1 (make-instance 'standard-left-sticky-mark + (m1 (make-instance %%left-sticky-mark :buffer buffer :offset 8)) - (m2 (make-instance 'standard-right-sticky-mark + (m2 (make-instance %%right-sticky-mark :buffer buffer :offset 10))) (values (climacs-base::previous-word m0) @@ -623,46 +623,46 @@ (climacs-base::previous-word m2)))) "climacs" #() "cl")

-(deftest standard-buffer-downcase-buffer-region.test-1 - (let ((buffer (make-instance 'standard-buffer))) +(defmultitest downcase-buffer-region.test-1 + (let ((buffer (make-instance %%buffer))) (insert-buffer-sequence buffer 0 "CLi mac5") (climacs-base::downcase-buffer-region buffer 1 (size buffer)) (buffer-sequence buffer 0 (size buffer))) "Cli mac5")

-(deftest standard-buffer-downcase-region.test-1 - (let ((buffer (make-instance 'standard-buffer))) +(defmultitest downcase-region.test-1 + (let ((buffer (make-instance %%buffer))) (insert-buffer-sequence buffer 0 "_Cli mac5_") - (let ((m1 (make-instance 'standard-left-sticky-mark + (let ((m1 (make-instance %%left-sticky-mark :buffer buffer :offset 1)) - (m2 (make-instance 'standard-right-sticky-mark + (m2 (make-instance %%right-sticky-mark :buffer buffer :offset 8))) (downcase-region m2 m1) (buffer-sequence buffer 0 (size buffer)))) "_cli mac5_")

-(deftest standard-buffer-downcase-region.test-2 - (let ((buffer (make-instance 'standard-buffer))) +(defmultitest downcase-region.test-2 + (let ((buffer (make-instance %%buffer))) (insert-buffer-sequence buffer 0 "_Cli mac5_") - (let ((m1 (make-instance 'standard-right-sticky-mark + (let ((m1 (make-instance %%right-sticky-mark :buffer buffer :offset 1))) (downcase-region 8 m1) (buffer-sequence buffer 0 (size buffer)))) "_cli mac5_")

-(deftest standard-buffer-downcase-region.test-3 - (let ((buffer (make-instance 'standard-buffer))) +(defmultitest downcase-region.test-3 + (let ((buffer (make-instance %%buffer))) (insert-buffer-sequence buffer 0 "_Cli mac5_") - (let ((m1 (make-instance 'standard-left-sticky-mark + (let ((m1 (make-instance %%left-sticky-mark :buffer buffer :offset 8))) (downcase-region 1 m1) (buffer-sequence buffer 0 (size buffer)))) "_cli mac5_")

-(deftest standard-buffer-downcase-word.test-1 - (let ((buffer (make-instance 'standard-buffer))) +(defmultitest downcase-word.test-1 + (let ((buffer (make-instance %%buffer))) (insert-buffer-sequence buffer 0 "CLI MA CS CLIMACS") - (let ((m (make-instance 'standard-right-sticky-mark + (let ((m (make-instance %%right-sticky-mark :buffer buffer :offset 0))) (downcase-word m 3) (values @@ -670,46 +670,46 @@ (offset m)))) "cli ma cs CLIMACS" 9)

-(deftest standard-buffer-upcase-buffer-region.test-1 - (let ((buffer (make-instance 'standard-buffer))) +(defmultitest upcase-buffer-region.test-1 + (let ((buffer (make-instance %%buffer))) (insert-buffer-sequence buffer 0 "cli mac5") (climacs-base::upcase-buffer-region buffer 1 (size buffer)) (buffer-sequence buffer 0 (size buffer))) "cLI MAC5")

-(deftest standard-buffer-upcase-region.test-1 - (let ((buffer (make-instance 'standard-buffer))) +(defmultitest upcase-region.test-1 + (let ((buffer (make-instance %%buffer))) (insert-buffer-sequence buffer 0 "_Cli mac5_") - (let ((m1 (make-instance 'standard-left-sticky-mark + (let ((m1 (make-instance %%left-sticky-mark :buffer buffer :offset 1)) - (m2 (make-instance 'standard-right-sticky-mark + (m2 (make-instance %%right-sticky-mark :buffer buffer :offset 8))) (upcase-region m2 m1) (buffer-sequence buffer 0 (size buffer)))) "_CLI MAC5_")

-(deftest standard-buffer-upcase-region.test-2 - (let ((buffer (make-instance 'standard-buffer))) +(defmultitest upcase-region.test-2 + (let ((buffer (make-instance %%buffer))) (insert-buffer-sequence buffer 0 "_Cli mac5_") - (let ((m1 (make-instance 'standard-right-sticky-mark + (let ((m1 (make-instance %%right-sticky-mark :buffer buffer :offset 1))) (upcase-region 8 m1) (buffer-sequence buffer 0 (size buffer)))) "_CLI MAC5_")

-(deftest standard-buffer-upcase-region.test-3 - (let ((buffer (make-instance 'standard-buffer))) +(defmultitest upcase-region.test-3 + (let ((buffer (make-instance %%buffer))) (insert-buffer-sequence buffer 0 "_Cli mac5_") - (let ((m1 (make-instance 'standard-left-sticky-mark + (let ((m1 (make-instance %%left-sticky-mark :buffer buffer :offset 8))) (upcase-region 1 m1) (buffer-sequence buffer 0 (size buffer)))) "_CLI MAC5_")

-(deftest standard-buffer-upcase-word.test-1 - (let ((buffer (make-instance 'standard-buffer))) +(defmultitest upcase-word.test-1 + (let ((buffer (make-instance %%buffer))) (insert-buffer-sequence buffer 0 "cli ma cs climacs") - (let ((m (make-instance 'standard-right-sticky-mark + (let ((m (make-instance %%right-sticky-mark :buffer buffer :offset 0))) (upcase-word m 3) (values @@ -717,53 +717,53 @@ (offset m)))) "CLI MA CS climacs" 9)

-(deftest standard-buffer-capitalize-buffer-region.test-1 - (let ((buffer (make-instance 'standard-buffer))) +(defmultitest capitalize-buffer-region.test-1 + (let ((buffer (make-instance %%buffer))) (insert-buffer-sequence buffer 0 "cli ma cs") (climacs-base::capitalize-buffer-region buffer 1 (size buffer)) (buffer-sequence buffer 0 (size buffer))) "cLi Ma Cs")

-(deftest standard-buffer-capitalize-buffer-region.test-2 - (let ((buffer (make-instance 'standard-buffer))) +(defmultitest capitalize-buffer-region.test-2 + (let ((buffer (make-instance %%buffer))) (insert-buffer-sequence buffer 0 "CLI mA Cs") (climacs-base::capitalize-buffer-region buffer 0 (size buffer)) (buffer-sequence buffer 0 (size buffer))) "Cli Ma Cs")

-(deftest standard-buffer-capitalize-region.test-1 - (let ((buffer (make-instance 'standard-buffer))) +(defmultitest capitalize-region.test-1 + (let ((buffer (make-instance %%buffer))) (insert-buffer-sequence buffer 0 "_Cli mac5_") - (let ((m1 (make-instance 'standard-left-sticky-mark + (let ((m1 (make-instance %%left-sticky-mark :buffer buffer :offset 1)) - (m2 (make-instance 'standard-right-sticky-mark + (m2 (make-instance %%right-sticky-mark :buffer buffer :offset 8))) (capitalize-region m2 m1) (buffer-sequence buffer 0 (size buffer)))) "_Cli Mac5_")

-(deftest standard-buffer-capitalize-region.test-2 - (let ((buffer (make-instance 'standard-buffer))) +(defmultitest capitalize-region.test-2 + (let ((buffer (make-instance %%buffer))) (insert-buffer-sequence buffer 0 "_Cli mac5_") - (let ((m1 (make-instance 'standard-right-sticky-mark + (let ((m1 (make-instance %%right-sticky-mark :buffer buffer :offset 1))) (capitalize-region 8 m1) (buffer-sequence buffer 0 (size buffer)))) "_Cli Mac5_")

-(deftest standard-buffer-capitalize-region.test-3 - (let ((buffer (make-instance 'standard-buffer))) +(defmultitest capitalize-region.test-3 + (let ((buffer (make-instance %%buffer))) (insert-buffer-sequence buffer 0 "_Cli mac5_") - (let ((m1 (make-instance 'standard-left-sticky-mark + (let ((m1 (make-instance %%left-sticky-mark :buffer buffer :offset 8))) (capitalize-region 1 m1) (buffer-sequence buffer 0 (size buffer)))) "_Cli Mac5_")

-(deftest standard-buffer-capitalize-word.test-1 - (let ((buffer (make-instance 'standard-buffer))) +(defmultitest capitalize-word.test-1 + (let ((buffer (make-instance %%buffer))) (insert-buffer-sequence buffer 0 "cli ma cs climacs") - (let ((m (make-instance 'standard-right-sticky-mark + (let ((m (make-instance %%right-sticky-mark :buffer buffer :offset 0))) (capitalize-word m 3) (values @@ -771,96 +771,96 @@ (offset m)))) "Cli Ma Cs climacs" 9)

-(deftest standard-buffer-tabify-buffer-region.test-1 - (let ((buffer (make-instance 'standard-buffer))) +(defmultitest tabify-buffer-region.test-1 + (let ((buffer (make-instance %%buffer))) (insert-buffer-sequence buffer 0 "c l im acs") (climacs-base::tabify-buffer-region buffer 0 (size buffer) 8) (buffer-sequence buffer 0 (size buffer))) "c l im acs")

-(deftest standard-buffer-tabify-buffer-region.test-2 - (let ((buffer (make-instance 'standard-buffer))) +(defmultitest tabify-buffer-region.test-2 + (let ((buffer (make-instance %%buffer))) (insert-buffer-sequence buffer 0 "c l im acs") (climacs-base::tabify-buffer-region buffer 0 (size buffer) 8) (buffer-sequence buffer 0 (size buffer))) "c l im acs")

-(deftest standard-buffer-tabify-region.test-1 - (let ((buffer (make-instance 'standard-buffer))) +(defmultitest tabify-region.test-1 + (let ((buffer (make-instance %%buffer))) (insert-buffer-sequence buffer 0 "clim acs") - (let ((m1 (make-instance 'standard-left-sticky-mark + (let ((m1 (make-instance %%left-sticky-mark :buffer buffer :offset 3)) - (m2 (make-instance 'standard-right-sticky-mark + (m2 (make-instance %%right-sticky-mark :buffer buffer :offset 7))) (tabify-region m2 m1 4) (buffer-sequence buffer 0 (size buffer)))) "clim acs")

-(deftest standard-buffer-tabify-region.test-2 - (let ((buffer (make-instance 'standard-buffer))) +(defmultitest tabify-region.test-2 + (let ((buffer (make-instance %%buffer))) (insert-buffer-sequence buffer 0 "clim acs") - (let ((m1 (make-instance 'standard-right-sticky-mark + (let ((m1 (make-instance %%right-sticky-mark :buffer buffer :offset 3))) (tabify-region 7 m1 4) (buffer-sequence buffer 0 (size buffer)))) "clim acs")

-(deftest standard-buffer-tabify-region.test-3 - (let ((buffer (make-instance 'standard-buffer))) +(defmultitest tabify-region.test-3 + (let ((buffer (make-instance %%buffer))) (insert-buffer-sequence buffer 0 "clim acs") - (let ((m1 (make-instance 'standard-left-sticky-mark + (let ((m1 (make-instance %%left-sticky-mark :buffer buffer :offset 7))) (tabify-region 3 m1 4) (buffer-sequence buffer 0 (size buffer)))) "clim acs")

-(deftest standard-buffer-untabify-buffer-region.test-1 - (let ((buffer (make-instance 'standard-buffer))) +(defmultitest untabify-buffer-region.test-1 + (let ((buffer (make-instance %%buffer))) (insert-buffer-sequence buffer 0 "c l im acs") (climacs-base::untabify-buffer-region buffer 0 (size buffer) 8) (buffer-sequence buffer 0 (size buffer))) "c l im acs")

-(deftest standard-buffer-untabify-buffer-region.test-2 - (let ((buffer (make-instance 'standard-buffer))) +(defmultitest untabify-buffer-region.test-2 + (let ((buffer (make-instance %%buffer))) (insert-buffer-sequence buffer 0 "c l im acs") (climacs-base::untabify-buffer-region buffer 0 (size buffer) 8) (buffer-sequence buffer 0 (size buffer))) "c l im acs")

-(deftest standard-buffer-untabify-region.test-1 - (let ((buffer (make-instance 'standard-buffer))) +(defmultitest untabify-region.test-1 + (let ((buffer (make-instance %%buffer))) (insert-buffer-sequence buffer 0 "clim acs") - (let ((m1 (make-instance 'standard-left-sticky-mark + (let ((m1 (make-instance %%left-sticky-mark :buffer buffer :offset 3)) - (m2 (make-instance 'standard-right-sticky-mark + (m2 (make-instance %%right-sticky-mark :buffer buffer :offset 5))) (untabify-region m2 m1 4) (buffer-sequence buffer 0 (size buffer)))) "clim acs")

-(deftest standard-buffer-untabify-region.test-2 - (let ((buffer (make-instance 'standard-buffer))) +(defmultitest untabify-region.test-2 + (let ((buffer (make-instance %%buffer))) (insert-buffer-sequence buffer 0 "clim acs") - (let ((m1 (make-instance 'standard-right-sticky-mark + (let ((m1 (make-instance %%right-sticky-mark :buffer buffer :offset 3))) (untabify-region 5 m1 4) (buffer-sequence buffer 0 (size buffer)))) "clim acs")

-(deftest standard-buffer-untabify-region.test-3 - (let ((buffer (make-instance 'standard-buffer))) +(defmultitest untabify-region.test-3 + (let ((buffer (make-instance %%buffer))) (insert-buffer-sequence buffer 0 "clim acs") - (let ((m1 (make-instance 'standard-left-sticky-mark + (let ((m1 (make-instance %%left-sticky-mark :buffer buffer :offset 5))) (untabify-region 3 m1 4) (buffer-sequence buffer 0 (size buffer)))) "clim acs")

-(deftest standard-buffer-indent-line.test-1 - (let ((buffer (make-instance 'standard-buffer))) +(defmultitest indent-line.test-1 + (let ((buffer (make-instance %%buffer))) (insert-buffer-sequence buffer 0 " climacs ") - (let ((m (make-instance 'standard-left-sticky-mark + (let ((m (make-instance %%left-sticky-mark :buffer buffer :offset 3))) (indent-line m 4 nil) (values @@ -868,10 +868,10 @@ (buffer-sequence buffer 0 (size buffer))))) 0 " climacs ")

-(deftest standard-buffer-indent-line.test-2 - (let ((buffer (make-instance 'standard-buffer))) +(defmultitest indent-line.test-2 + (let ((buffer (make-instance %%buffer))) (insert-buffer-sequence buffer 0 " climacs ") - (let ((m (make-instance 'standard-left-sticky-mark + (let ((m (make-instance %%left-sticky-mark :buffer buffer :offset 4))) (indent-line m 5 4) (values @@ -879,10 +879,10 @@ (buffer-sequence buffer 0 (size buffer))))) 3 " climacs ")

-(deftest standard-buffer-indent-line.test-3 - (let ((buffer (make-instance 'standard-buffer))) +(defmultitest indent-line.test-3 + (let ((buffer (make-instance %%buffer))) (insert-buffer-sequence buffer 0 " climacs ") - (let ((m (make-instance 'standard-right-sticky-mark + (let ((m (make-instance %%right-sticky-mark :buffer buffer :offset 3))) (indent-line m 5 4) (values @@ -890,11 +890,11 @@ (buffer-sequence buffer 0 (size buffer))))) 2 " climacs ")

-(deftest standard-buffer-delete-indentation.test-1 - (let ((buffer (make-instance 'standard-buffer))) +(defmultitest delete-indentation.test-1 + (let ((buffer (make-instance %%buffer))) (insert-buffer-sequence buffer 0 " climacs ") - (let ((m (make-instance 'standard-left-sticky-mark + (let ((m (make-instance %%left-sticky-mark :buffer buffer :offset 3))) (delete-indentation m) (values @@ -902,11 +902,11 @@ (buffer-sequence buffer 0 (size buffer))))) 0 "climacs ")

-(deftest standard-buffer-delete-indentation.test-2 - (let ((buffer (make-instance 'standard-buffer))) +(defmultitest delete-indentation.test-2 + (let ((buffer (make-instance %%buffer))) (insert-buffer-sequence buffer 0 " climacs ") - (let ((m (make-instance 'standard-right-sticky-mark + (let ((m (make-instance %%right-sticky-mark :buffer buffer :offset 7))) (delete-indentation m) (values @@ -914,10 +914,10 @@ (buffer-sequence buffer 0 (size buffer))))) 0 "climacs ")

-(deftest standard-buffer-delete-indentation.test-3 - (let ((buffer (make-instance 'standard-buffer))) +(defmultitest delete-indentation.test-3 + (let ((buffer (make-instance %%buffer))) (insert-buffer-sequence buffer 0 " climacs ") - (let ((m (make-instance 'standard-left-sticky-mark + (let ((m (make-instance %%left-sticky-mark :buffer buffer :offset 7))) (delete-indentation m) (values @@ -925,11 +925,11 @@ (buffer-sequence buffer 0 (size buffer))))) 0 " climacs ")

-(deftest standard-buffer-delete-indentation.test-4 - (let ((buffer (make-instance 'standard-buffer))) +(defmultitest delete-indentation.test-4 + (let ((buffer (make-instance %%buffer))) (insert-buffer-sequence buffer 0 "climacs climacs ") - (let ((m (make-instance 'standard-right-sticky-mark + (let ((m (make-instance %%right-sticky-mark :buffer buffer :offset 12))) (delete-indentation m) (values @@ -937,12 +937,12 @@ (buffer-sequence buffer 0 (size buffer))))) 8 "climacs climacs ")

-(deftest standard-buffer-delete-indentation.test-5 - (let ((buffer (make-instance 'standard-buffer))) +(defmultitest delete-indentation.test-5 + (let ((buffer (make-instance %%buffer))) (insert-buffer-sequence buffer 0 "

climacs ") - (let ((m (make-instance 'standard-right-sticky-mark + (let ((m (make-instance %%right-sticky-mark :buffer buffer :offset 12))) (delete-indentation m) (values @@ -951,10 +951,10 @@ 1 " climacs ")

-(deftest standard-buffer-fill-line.test-1 - (let ((buffer (make-instance 'standard-buffer))) +(defmultitest fill-line.test-1 + (let ((buffer (make-instance %%buffer))) (insert-buffer-sequence buffer 0 "climacs climacs climacs") - (let ((m (make-instance 'standard-right-sticky-mark + (let ((m (make-instance %%right-sticky-mark :buffer buffer :offset 25))) (fill-line m #'(lambda (m) (declare (ignore m)) 8) 10 8) (values

Index: climacs/buffer-test.lisp diff -u climacs/buffer-test.lisp:1.14 climacs/buffer-test.lisp:1.15 --- climacs/buffer-test.lisp:1.14 Sun Feb 6 01:03:26 2005 +++ climacs/buffer-test.lisp Thu Feb 10 01:27:07 2005 @@ -8,8 +8,40 @@

(cl:in-package :climacs-tests)

-(deftest standard-buffer-make-instance.test-1 - (let* ((buffer (make-instance 'standard-buffer)) +(defmacro defmultitest (name form &rest results) + (let ((name-string (symbol-name name))) + (flet ((%deftest-wrapper (bc lsm rsm tn f rs) + (let ((alist (list (cons '%%buffer bc) + (cons '%%left-sticky-mark lsm) + (cons '%%right-sticky-mark rsm)))) + `(deftest ,tn + ,(sublis alist f) + ,@(mapcar (lambda (r) (sublis alist r)) rs))))) + `(progn + ,(%deftest-wrapper + ''standard-buffer + ''standard-left-sticky-mark + ''standard-right-sticky-mark + (intern (concatenate 'string "STANDARD-BUFFER-" name-string)) + form + results) + ,(%deftest-wrapper + ''binseq-buffer + ''persistent-left-sticky-mark + ''persistent-right-sticky-mark + (intern (concatenate 'string "BINSEQ-BUFFER-" name-string)) + form + results) + ,(%deftest-wrapper + ''obinseq-buffer + ''persistent-left-sticky-mark + ''persistent-right-sticky-mark + (intern (concatenate 'string "OBINSEQ-BUFFER-" name-string)) + form + results))))) + +(defmultitest buffer-make-instance.test-1 + (let* ((buffer (make-instance %%buffer)) (low (slot-value buffer 'low-mark)) (high (slot-value buffer 'high-mark))) (and (= (offset low) 0) @@ -19,34 +51,34 @@ (eq (buffer high) buffer))) t)

-(deftest standard-buffer-mark-make-instance.test-1 +(defmultitest mark-make-instance.test-1 (handler-case - (let ((buffer (make-instance 'standard-buffer))) - (make-instance 'standard-left-sticky-mark :buffer buffer :offset 1)) + (let ((buffer (make-instance %%buffer))) + (make-instance %%left-sticky-mark :buffer buffer :offset 1)) (climacs-buffer::no-such-offset (c) (= (climacs-buffer::condition-offset c) 1))) t)

-(deftest standard-buffer-mark-make-instance.test-2 +(defmultitest mark-make-instance.test-2 (handler-case - (let ((buffer (make-instance 'standard-buffer))) - (make-instance 'standard-right-sticky-mark :buffer buffer :offset 1)) + (let ((buffer (make-instance %%buffer))) + (make-instance %%right-sticky-mark :buffer buffer :offset 1)) (climacs-buffer::no-such-offset (c) (= (climacs-buffer::condition-offset c) 1))) t)

-(deftest standard-buffer-clone-mark.test-1 +(defmultitest clone-mark.test-1 (flet ((%all-eq (&optional x y) (cond ((null x) nil) (t (when (eq x y) y))))) - (let* ((buffer (make-instance 'standard-buffer)) + (let* ((buffer (make-instance %%buffer)) (low (slot-value buffer 'low-mark)) (high (slot-value buffer 'high-mark)) (low2 (clone-mark low)) (high2 (clone-mark high)) - (low3 (clone-mark high 'standard-left-sticky-mark)) - (high3 (clone-mark low 'standard-right-sticky-mark))) + (low3 (clone-mark high %%left-sticky-mark)) + (high3 (clone-mark low %%right-sticky-mark))) (and (reduce #'%all-eq (list (class-of low) (class-of low2) (class-of low3))) (reduce #'%all-eq @@ -58,8 +90,8 @@ ;;; NOTE: the current implementation uses vectors wherever sequences are ;;; expected (and strings are vectors of characters)

-(deftest standard-buffer-insert-buffer-object.test-1 - (let ((buffer (make-instance 'standard-buffer))) +(defmultitest insert-buffer-object.test-1 + (let ((buffer (make-instance %%buffer))) (insert-buffer-object buffer 0 #\a) (values (offset (low-mark buffer)) @@ -69,8 +101,8 @@ (buffer-sequence buffer 0 1))) 0 1 t 1 "a")

-(deftest standard-buffer-insert-buffer-object.test-2 - (let ((buffer (make-instance 'standard-buffer))) +(defmultitest insert-buffer-object.test-2 + (let ((buffer (make-instance %%buffer))) (insert-buffer-object buffer 0 #\b) (insert-buffer-object buffer 0 #\a) (values @@ -81,8 +113,8 @@ (buffer-sequence buffer 0 2))) 0 2 t 2 "ab")

-(deftest standard-buffer-insert-buffer-object.test-3 - (let ((buffer (make-instance 'standard-buffer))) +(defmultitest insert-buffer-object.test-3 + (let ((buffer (make-instance %%buffer))) (insert-buffer-object buffer 0 #\b) (insert-buffer-object buffer 1 #\a) (values @@ -93,66 +125,66 @@ (buffer-sequence buffer 0 2))) 0 2 t 2 "ba")

-(deftest standard-buffer-insert-buffer-object.test-4 +(defmultitest insert-buffer-object.test-4 (handler-case - (let ((buffer (make-instance 'standard-buffer))) + (let ((buffer (make-instance %%buffer))) (insert-buffer-object buffer 1 #\a)) (error (c) (= (climacs-buffer::condition-offset c) 1))) t)

-(deftest standard-buffer-insert-buffer-object.test-5 +(defmultitest insert-buffer-object.test-5 (handler-case - (let ((buffer (make-instance 'standard-buffer))) + (let ((buffer (make-instance %%buffer))) (insert-buffer-object buffer -1 #\a)) (climacs-buffer::no-such-offset (c) (= (climacs-buffer::condition-offset c) -1))) t)

-(deftest standard-buffer-insert-buffer-sequence.test-1 - (let ((buffer (make-instance 'standard-buffer))) +(defmultitest insert-buffer-sequence.test-1 + (let ((buffer (make-instance %%buffer))) (insert-buffer-sequence buffer 0 "climacs") (and (= (size buffer) 7) (buffer-sequence buffer 0 7))) "climacs")

-(deftest standard-buffer-insert-buffer-sequence.test-2 - (let ((buffer (make-instance 'standard-buffer))) +(defmultitest insert-buffer-sequence.test-2 + (let ((buffer (make-instance %%buffer))) (insert-buffer-sequence buffer 0 "climacs") (insert-buffer-sequence buffer 3 "ClimacS") (and (= (size buffer) 14) (buffer-sequence buffer 0 14))) "cliClimacSmacs")

-(deftest standard-buffer-insert-buffer-sequence.test-3 - (let ((buffer (make-instance 'standard-buffer))) +(defmultitest insert-buffer-sequence.test-3 + (let ((buffer (make-instance %%buffer))) (insert-buffer-sequence buffer 0 "climacs") (insert-buffer-sequence buffer 0 "ClimacS") (and (= (size buffer) 14) (buffer-sequence buffer 0 14))) "ClimacSclimacs")

-(deftest standard-buffer-insert-buffer-sequence.test-4 - (let ((buffer (make-instance 'standard-buffer))) +(defmultitest insert-buffer-sequence.test-4 + (let ((buffer (make-instance %%buffer))) (insert-buffer-sequence buffer 0 "") (and (= (size buffer) 0) (buffer-sequence buffer 0 0))) "")

-(deftest standard-buffer-insert-buffer-sequence.test-5 +(defmultitest insert-buffer-sequence.test-5 (handler-case - (let ((buffer (make-instance 'standard-buffer))) + (let ((buffer (make-instance %%buffer))) (insert-buffer-sequence buffer 1 "climacs")) (climacs-buffer::no-such-offset (c) (= (climacs-buffer::condition-offset c) 1))) t)

-(deftest standard-buffer-insert-buffer-sequence.test-6 +(defmultitest insert-buffer-sequence.test-6 (handler-case - (let ((buffer (make-instance 'standard-buffer))) + (let ((buffer (make-instance %%buffer))) (insert-buffer-sequence buffer -1 "climacs")) (climacs-buffer::no-such-offset (c) (= (climacs-buffer::condition-offset c) -1))) t)

-(deftest standard-buffer-delete-buffer-range.test-1 - (let ((buffer (make-instance 'standard-buffer))) +(defmultitest delete-buffer-range.test-1 + (let ((buffer (make-instance %%buffer))) (insert-buffer-sequence buffer 0 "climacs") (delete-buffer-range buffer 0 7) (values @@ -162,8 +194,8 @@ (size buffer))) 0 0 t 0)

-(deftest standard-buffer-delete-buffer-range.test-2 - (let ((buffer (make-instance 'standard-buffer))) +(defmultitest delete-buffer-range.test-2 + (let ((buffer (make-instance %%buffer))) (insert-buffer-sequence buffer 0 "climacs") (delete-buffer-range buffer 0 3) (values @@ -174,42 +206,42 @@ (buffer-sequence buffer 0 4))) 0 4 t 4 "macs")

-(deftest standard-buffer-delete-buffer-range.test-3 - (let ((buffer (make-instance 'standard-buffer))) +(defmultitest delete-buffer-range.test-3 + (let ((buffer (make-instance %%buffer))) (insert-buffer-sequence buffer 0 "climacs") (delete-buffer-range buffer 3 4) (and (= (size buffer) 3) (buffer-sequence buffer 0 3))) "cli")

-(deftest standard-buffer-delete-buffer-range.test-4 - (let ((buffer (make-instance 'standard-buffer))) +(defmultitest delete-buffer-range.test-4 + (let ((buffer (make-instance %%buffer))) (insert-buffer-sequence buffer 0 "climacs") (delete-buffer-range buffer 3 0) (and (= (size buffer) 7) (buffer-sequence buffer 0 7))) "climacs")

-(deftest standard-buffer-delete-buffer-range.test-5 +(defmultitest delete-buffer-range.test-5 (handler-case - (let ((buffer (make-instance 'standard-buffer))) + (let ((buffer (make-instance %%buffer))) (insert-buffer-sequence buffer 0 "climacs") (delete-buffer-range buffer -1 0)) (climacs-buffer::no-such-offset (c) (= (climacs-buffer::condition-offset c) -1))) t)

-(deftest standard-buffer-delete-buffer-range.test-6 +(defmultitest delete-buffer-range.test-6 (handler-case - (let ((buffer (make-instance 'standard-buffer))) + (let ((buffer (make-instance %%buffer))) (insert-buffer-sequence buffer 0 "climacs") (delete-buffer-range buffer 6 2)) (climacs-buffer::no-such-offset (c) (= (climacs-buffer::condition-offset c) 8))) t)

-(deftest standard-buffer-insert-object.test-1 - (let ((buffer (make-instance 'standard-buffer))) +(defmultitest insert-object.test-1 + (let ((buffer (make-instance %%buffer))) (insert-buffer-sequence buffer 0 "climacs") - (let ((m (make-instance 'standard-left-sticky-mark + (let ((m (make-instance %%left-sticky-mark :buffer buffer :offset 3))) (insert-object m #\X) (and (= (size buffer) 8) @@ -218,10 +250,10 @@ (buffer-sequence buffer 0 8)))) "cliXmacs")

-(deftest standard-buffer-insert-object.test-2 - (let ((buffer (make-instance 'standard-buffer))) +(defmultitest insert-object.test-2 + (let ((buffer (make-instance %%buffer))) (insert-buffer-sequence buffer 0 "climacs") - (let ((m (make-instance 'standard-right-sticky-mark + (let ((m (make-instance %%right-sticky-mark :buffer buffer :offset 3))) (insert-object m #\X) (and (= (size buffer) 8) @@ -230,12 +262,12 @@ (buffer-sequence buffer 0 8)))) "cliXmacs")

-(deftest standard-buffer-insert-sequence.test-1 - (let ((buffer (make-instance 'standard-buffer))) +(defmultitest insert-sequence.test-1 + (let ((buffer (make-instance %%buffer))) (insert-buffer-sequence buffer 0 "climacs") - (let ((m (make-instance 'standard-left-sticky-mark + (let ((m (make-instance %%left-sticky-mark :buffer buffer :offset 3)) - (m2 (make-instance 'standard-left-sticky-mark + (m2 (make-instance %%left-sticky-mark :buffer buffer :offset 5))) (insert-sequence m "ClimacS") (and (= (size buffer) 14) @@ -245,12 +277,12 @@ (buffer-sequence buffer 0 14)))) "cliClimacSmacs")

-(deftest standard-buffer-insert-sequence.test-2 - (let ((buffer (make-instance 'standard-buffer))) +(defmultitest insert-sequence.test-2 + (let ((buffer (make-instance %%buffer))) (insert-buffer-sequence buffer 0 "climacs") - (let ((m (make-instance 'standard-right-sticky-mark + (let ((m (make-instance %%right-sticky-mark :buffer buffer :offset 3)) - (m2 (make-instance 'standard-right-sticky-mark + (m2 (make-instance %%right-sticky-mark :buffer buffer :offset 5))) (insert-sequence m "ClimacS") (and (= (size buffer) 14) @@ -260,12 +292,12 @@ (buffer-sequence buffer 0 14)))) "cliClimacSmacs")

-(deftest standard-buffer-delete-range.test-1 - (let ((buffer (make-instance 'standard-buffer))) +(defmultitest delete-range.test-1 + (let ((buffer (make-instance %%buffer))) (insert-buffer-sequence buffer 0 "climacs") - (let ((m (make-instance 'standard-left-sticky-mark + (let ((m (make-instance %%left-sticky-mark :buffer buffer :offset 3)) - (m2 (make-instance 'standard-left-sticky-mark + (m2 (make-instance %%left-sticky-mark :buffer buffer :offset 5))) (delete-range m 2) (and (= (size buffer) 5) @@ -276,12 +308,12 @@ (buffer-sequence buffer 0 5)))) "clics")

-(deftest standard-buffer-delete-range.test-2 - (let ((buffer (make-instance 'standard-buffer))) +(defmultitest delete-range.test-2 + (let ((buffer (make-instance %%buffer))) (insert-buffer-sequence buffer 0 "climacs") - (let ((m (make-instance 'standard-right-sticky-mark + (let ((m (make-instance %%right-sticky-mark :buffer buffer :offset 3)) - (m2 (make-instance 'standard-right-sticky-mark + (m2 (make-instance %%right-sticky-mark :buffer buffer :offset 5))) (delete-range m -2) (and (= (size buffer) 5) @@ -292,12 +324,12 @@ (buffer-sequence buffer 0 5)))) "cmacs")

-(deftest standard-buffer-delete-region.test-1 - (let ((buffer (make-instance 'standard-buffer))) +(defmultitest delete-region.test-1 + (let ((buffer (make-instance %%buffer))) (insert-buffer-sequence buffer 0 "climacs") - (let ((m (make-instance 'standard-left-sticky-mark + (let ((m (make-instance %%left-sticky-mark :buffer buffer :offset 3)) - (m2 (make-instance 'standard-left-sticky-mark + (m2 (make-instance %%left-sticky-mark :buffer buffer :offset 5))) (delete-region m m2) (and (= (size buffer) 5) @@ -308,12 +340,12 @@ (buffer-sequence buffer 0 5)))) "clics")

-(deftest standard-buffer-delete-region.test-2 - (let ((buffer (make-instance 'standard-buffer))) +(defmultitest delete-region.test-2 + (let ((buffer (make-instance %%buffer))) (insert-buffer-sequence buffer 0 "climacs") - (let ((m (make-instance 'standard-right-sticky-mark + (let ((m (make-instance %%right-sticky-mark :buffer buffer :offset 3)) - (m2 (make-instance 'standard-right-sticky-mark + (m2 (make-instance %%right-sticky-mark :buffer buffer :offset 5))) (delete-region m m2) (and (= (size buffer) 5) @@ -324,12 +356,12 @@ (buffer-sequence buffer 0 5)))) "clics")

-(deftest standard-buffer-delete-region.test-3 - (let ((buffer (make-instance 'standard-buffer))) +(defmultitest delete-region.test-3 + (let ((buffer (make-instance %%buffer))) (insert-buffer-sequence buffer 0 "climacs") - (let ((m (make-instance 'standard-left-sticky-mark + (let ((m (make-instance %%left-sticky-mark :buffer buffer :offset 3)) - (m2 (make-instance 'standard-left-sticky-mark + (m2 (make-instance %%left-sticky-mark :buffer buffer :offset 5))) (delete-region m2 m) (and (= (size buffer) 5) @@ -340,12 +372,12 @@ (buffer-sequence buffer 0 5)))) "clics")

-(deftest standard-buffer-delete-region.test-4 - (let ((buffer (make-instance 'standard-buffer))) +(defmultitest delete-region.test-4 + (let ((buffer (make-instance %%buffer))) (insert-buffer-sequence buffer 0 "climacs") - (let ((m (make-instance 'standard-right-sticky-mark + (let ((m (make-instance %%right-sticky-mark :buffer buffer :offset 3)) - (m2 (make-instance 'standard-right-sticky-mark + (m2 (make-instance %%right-sticky-mark :buffer buffer :offset 5))) (delete-region m2 m) (and (= (size buffer) 5) @@ -356,15 +388,15 @@ (buffer-sequence buffer 0 5)))) "clics")

-(deftest standard-buffer-delete-region.test-5 +(defmultitest delete-region.test-5 (handler-case - (let ((buffer (make-instance 'standard-buffer)) - (buffer2 (make-instance 'standard-buffer))) + (let ((buffer (make-instance %%buffer)) + (buffer2 (make-instance %%buffer))) (insert-buffer-sequence buffer 0 "climacs") (insert-buffer-sequence buffer2 0 "climacs") - (let ((m (make-instance 'standard-right-sticky-mark + (let ((m (make-instance %%right-sticky-mark :buffer buffer :offset 3)) - (m2 (make-instance 'standard-right-sticky-mark + (m2 (make-instance %%right-sticky-mark :buffer buffer2 :offset 5))) (delete-region m2 m))) (error (c) @@ -372,12 +404,12 @@ 'caught)) caught)

-(deftest standard-buffer-delete-region.test-6 - (let ((buffer (make-instance 'standard-buffer))) +(defmultitest delete-region.test-6 + (let ((buffer (make-instance %%buffer))) (insert-buffer-sequence buffer 0 "climacs") - (let ((m (make-instance 'standard-left-sticky-mark + (let ((m (make-instance %%left-sticky-mark :buffer buffer :offset 3)) - (m2 (make-instance 'standard-left-sticky-mark + (m2 (make-instance %%left-sticky-mark :buffer buffer :offset 5))) (delete-region m 5) (delete-region 1 m2) @@ -389,33 +421,33 @@ (buffer-sequence buffer 0 3)))) "ccs")

-(deftest standard-buffer-number-of-lines.test-1 - (let ((buffer (make-instance 'standard-buffer))) +(defmultitest number-of-lines.test-1 + (let ((buffer (make-instance %%buffer))) (number-of-lines buffer)) 0)

-(deftest standard-buffer-number-of-lines.test-2 - (let ((buffer (make-instance 'standard-buffer))) +(defmultitest number-of-lines.test-2 + (let ((buffer (make-instance %%buffer))) (insert-buffer-sequence buffer 0 "climacs climacs ") (number-of-lines buffer)) 2)

-(deftest standard-buffer-mark-relations.test-1 - (let ((buffer (make-instance 'standard-buffer))) +(defmultitest mark-relations.test-1 + (let ((buffer (make-instance %%buffer))) (insert-buffer-sequence buffer 0 "climacs") - (let ((m0 (make-instance 'standard-right-sticky-mark + (let ((m0 (make-instance %%right-sticky-mark :buffer buffer :offset 0)) - (m1 (make-instance 'standard-left-sticky-mark + (m1 (make-instance %%left-sticky-mark :buffer buffer :offset 3)) - (m1a (make-instance 'standard-right-sticky-mark + (m1a (make-instance %%right-sticky-mark :buffer buffer :offset 3)) - (m2 (make-instance 'standard-right-sticky-mark + (m2 (make-instance %%right-sticky-mark :buffer buffer :offset 4)) - (m2a (make-instance 'standard-left-sticky-mark + (m2a (make-instance %%left-sticky-mark :buffer buffer :offset 5)) - (m3 (make-instance 'standard-left-sticky-mark + (m3 (make-instance %%left-sticky-mark :buffer buffer :offset 7))) (setf (offset m2) 5) (and (mark< m0 m1) (not (mark> m0 m1)) (not (mark>= m0 m1)) @@ -443,43 +475,43 @@ (list m0 m1 m1a m2 m2a m3))))) t)

-(deftest standard-buffer-setf-offset.test-1 +(defmultitest setf-offset.test-1 (handler-case - (let ((buffer (make-instance 'standard-buffer))) + (let ((buffer (make-instance %%buffer))) (insert-buffer-sequence buffer 0 "climacs") - (let ((m (make-instance 'standard-left-sticky-mark + (let ((m (make-instance %%left-sticky-mark :buffer buffer :offset 4))) (setf (offset m) -1))) (climacs-buffer::no-such-offset (c) (= (climacs-buffer::condition-offset c) -1))) t)

-(deftest standard-buffer-setf-offset.test-2 +(defmultitest setf-offset.test-2 (handler-case - (let ((buffer (make-instance 'standard-buffer))) + (let ((buffer (make-instance %%buffer))) (insert-buffer-sequence buffer 0 "climacs") - (let ((m (make-instance 'standard-left-sticky-mark + (let ((m (make-instance %%left-sticky-mark :buffer buffer :offset 4))) (setf (offset m) 8))) (climacs-buffer::no-such-offset (c) (= (climacs-buffer::condition-offset c) 8))) t)

-(deftest standard-buffer-backward-object.test-1 - (let ((buffer (make-instance 'standard-buffer))) +(defmultitest backward-object.test-1 + (let ((buffer (make-instance %%buffer))) (insert-buffer-sequence buffer 0 "climacs") - (let* ((m1 (make-instance 'standard-left-sticky-mark + (let* ((m1 (make-instance %%left-sticky-mark :buffer buffer :offset 4)) (m2 (clone-mark m1))) (backward-object m1 2) (region-to-sequence m1 m2))) "im")

-(deftest standard-buffer-backward-object.test-2 +(defmultitest backward-object.test-2 (handler-case - (let ((buffer (make-instance 'standard-buffer))) + (let ((buffer (make-instance %%buffer))) (insert-buffer-sequence buffer 0 "climacs") - (let* ((m1 (make-instance 'standard-right-sticky-mark + (let* ((m1 (make-instance %%right-sticky-mark :buffer buffer :offset 2)) (m2 (clone-mark m1))) (backward-object m1 3) @@ -488,21 +520,21 @@ (= (climacs-buffer::condition-offset c) -1))) t)

-(deftest standard-buffer-forward-object.test-1 - (let ((buffer (make-instance 'standard-buffer))) +(defmultitest forward-object.test-1 + (let ((buffer (make-instance %%buffer))) (insert-buffer-sequence buffer 0 "climacs") - (let* ((m1 (make-instance 'standard-left-sticky-mark + (let* ((m1 (make-instance %%left-sticky-mark :buffer buffer :offset 4)) (m2 (clone-mark m1))) (forward-object m1 2) (region-to-sequence m1 m2))) "ac")

-(deftest standard-buffer-forward-object.test-2 +(defmultitest forward-object.test-2 (handler-case - (let ((buffer (make-instance 'standard-buffer))) + (let ((buffer (make-instance %%buffer))) (insert-buffer-sequence buffer 0 "climacs") - (let* ((m1 (make-instance 'standard-right-sticky-mark + (let* ((m1 (make-instance %%right-sticky-mark :buffer buffer :offset 6)) (m2 (clone-mark m1))) (forward-object m1 3) @@ -511,38 +543,38 @@ (= (climacs-buffer::condition-offset c) 9))) t)

-(deftest standard-buffer-setf-buffer-object.test-1 - (let ((buffer (make-instance 'standard-buffer))) +(defmultitest setf-buffer-object.test-1 + (let ((buffer (make-instance %%buffer))) (insert-buffer-sequence buffer 0 "climacs") (setf (buffer-object buffer 0) #\C) (buffer-sequence buffer 0 (size buffer))) "Climacs")

-(deftest standard-buffer-setf-buffer-object.test-2 +(defmultitest setf-buffer-object.test-2 (handler-case - (let ((buffer (make-instance 'standard-buffer))) + (let ((buffer (make-instance %%buffer))) (setf (buffer-object buffer 0) #\a)) (climacs-buffer::no-such-offset (c) (= (climacs-buffer::condition-offset c) 0))) t)

-(deftest standard-buffer-setf-buffer-object.test-3 +(defmultitest setf-buffer-object.test-3 (handler-case - (let ((buffer (make-instance 'standard-buffer))) + (let ((buffer (make-instance %%buffer))) (setf (buffer-object buffer -1) #\a)) (climacs-buffer::no-such-offset (c) (= (climacs-buffer::condition-offset c) -1))) t)

-(deftest standard-buffer-mark<.test-1 +(defmultitest mark<.test-1 (handler-case - (let ((buffer (make-instance 'standard-buffer)) - (buffer2 (make-instance 'standard-buffer))) + (let ((buffer (make-instance %%buffer)) + (buffer2 (make-instance %%buffer))) (insert-buffer-sequence buffer 0 "climacs") (insert-buffer-sequence buffer2 0 "climacs") - (let ((m1 (make-instance 'standard-left-sticky-mark + (let ((m1 (make-instance %%left-sticky-mark :buffer buffer :offset 4)) - (m2 (make-instance 'standard-left-sticky-mark + (m2 (make-instance %%left-sticky-mark :buffer buffer2 :offset 4))) (mark< m1 m2))) (error (c) @@ -550,15 +582,15 @@ 'caught)) caught)

-(deftest standard-buffer-mark>.test-1 +(defmultitest mark>.test-1 (handler-case - (let ((buffer (make-instance 'standard-buffer)) - (buffer2 (make-instance 'standard-buffer))) + (let ((buffer (make-instance %%buffer)) + (buffer2 (make-instance %%buffer))) (insert-buffer-sequence buffer 0 "climacs") (insert-buffer-sequence buffer2 0 "climacs") - (let ((m1 (make-instance 'standard-left-sticky-mark + (let ((m1 (make-instance %%left-sticky-mark :buffer buffer :offset 4)) - (m2 (make-instance 'standard-left-sticky-mark + (m2 (make-instance %%left-sticky-mark :buffer buffer2 :offset 4))) (mark> m1 m2))) (error (c) @@ -566,15 +598,15 @@ 'caught)) caught)

-(deftest standard-buffer-mark<=.test-1 +(defmultitest mark<=.test-1 (handler-case - (let ((buffer (make-instance 'standard-buffer)) - (buffer2 (make-instance 'standard-buffer))) + (let ((buffer (make-instance %%buffer)) + (buffer2 (make-instance %%buffer))) (insert-buffer-sequence buffer 0 "climacs") (insert-buffer-sequence buffer2 0 "climacs") - (let ((m1 (make-instance 'standard-left-sticky-mark + (let ((m1 (make-instance %%left-sticky-mark :buffer buffer :offset 4)) - (m2 (make-instance 'standard-left-sticky-mark + (m2 (make-instance %%left-sticky-mark :buffer buffer2 :offset 4))) (mark<= m1 m2))) (error (c) @@ -582,15 +614,15 @@ 'caught)) caught)

-(deftest standard-buffer-mark>=.test-1 +(defmultitest mark>=.test-1 (handler-case - (let ((buffer (make-instance 'standard-buffer)) - (buffer2 (make-instance 'standard-buffer))) + (let ((buffer (make-instance %%buffer)) + (buffer2 (make-instance %%buffer))) (insert-buffer-sequence buffer 0 "climacs") (insert-buffer-sequence buffer2 0 "climacs") - (let ((m1 (make-instance 'standard-left-sticky-mark + (let ((m1 (make-instance %%left-sticky-mark :buffer buffer :offset 4)) - (m2 (make-instance 'standard-left-sticky-mark + (m2 (make-instance %%left-sticky-mark :buffer buffer2 :offset 4))) (mark>= m1 m2))) (error (c) @@ -598,15 +630,15 @@ 'caught)) caught)

-(deftest standard-buffer-mark=.test-1 +(defmultitest mark=.test-1 (handler-case - (let ((buffer (make-instance 'standard-buffer)) - (buffer2 (make-instance 'standard-buffer))) + (let ((buffer (make-instance %%buffer)) + (buffer2 (make-instance %%buffer))) (insert-buffer-sequence buffer 0 "climacs") (insert-buffer-sequence buffer2 0 "climacs") - (let ((m1 (make-instance 'standard-left-sticky-mark + (let ((m1 (make-instance %%left-sticky-mark :buffer buffer :offset 4)) - (m2 (make-instance 'standard-left-sticky-mark + (m2 (make-instance %%left-sticky-mark :buffer buffer2 :offset 4))) (mark= m1 m2))) (error (c) @@ -614,27 +646,27 @@ 'caught)) caught)

-(deftest standard-buffer-line-number.test-1 - (let ((buffer (make-instance 'standard-buffer))) +(defmultitest line-number.test-1 + (let ((buffer (make-instance %%buffer))) (insert-buffer-sequence buffer 0 "climacs climacs") - (let ((m1 (make-instance 'standard-left-sticky-mark + (let ((m1 (make-instance %%left-sticky-mark :buffer buffer :offset 3)) - (m2 (make-instance 'standard-right-sticky-mark + (m2 (make-instance %%right-sticky-mark :buffer buffer :offset 11))) (= 0 (line-number m1) (1- (line-number m2))))) t)

-(deftest standard-buffer-buffer-column-number.test-1 - (let ((buffer (make-instance 'standard-buffer))) +(defmultitest buffer-column-number.test-1 + (let ((buffer (make-instance %%buffer))) (insert-buffer-sequence buffer 0 " climacs") (values (buffer-object buffer 2) (buffer-column-number buffer 2))) #\c 2)

-(deftest standard-buffer-buffer-column-number.test-2 - (let ((buffer (make-instance 'standard-buffer))) +(defmultitest buffer-column-number.test-2 + (let ((buffer (make-instance %%buffer))) (insert-buffer-sequence buffer 0 " climacs") (values @@ -642,300 +674,304 @@ (buffer-column-number buffer 3))) #\c 2)

-(deftest standard-buffer-column-number.test-1 - (let ((buffer (make-instance 'standard-buffer))) +(defmultitest column-number.test-1 + (let ((buffer (make-instance %%buffer))) (insert-buffer-sequence buffer 0 "climacs climacs") - (let ((m1 (make-instance 'standard-left-sticky-mark + (let ((m1 (make-instance %%left-sticky-mark :buffer buffer :offset 3)) - (m2 (make-instance 'standard-right-sticky-mark + (m2 (make-instance %%right-sticky-mark :buffer buffer :offset 11))) (= 3 (column-number m1) (column-number m2)))) t)

-(deftest standard-buffer-beginning-of-line.test-1 - (let ((buffer (make-instance 'standard-buffer))) +(defmultitest beginning-of-line.test-1 + (let ((buffer (make-instance %%buffer))) (insert-buffer-sequence buffer 0 "climacs climacs") - (let ((m (make-instance 'standard-left-sticky-mark + (let ((m (make-instance %%left-sticky-mark :buffer buffer :offset 11))) (and (not (beginning-of-line-p m)) (progn (beginning-of-line m) (beginning-of-line-p m))))) t)

-(deftest standard-buffer-end-of-line.test-1 - (let ((buffer (make-instance 'standard-buffer))) +(defmultitest end-of-line.test-1 + (let ((buffer (make-instance %%buffer))) (insert-buffer-sequence buffer 0 "climacs climacs") - (let ((m (make-instance 'standard-left-sticky-mark + (let ((m (make-instance %%left-sticky-mark :buffer buffer :offset 11))) (and (not (end-of-line-p m)) (progn (end-of-line m) (end-of-line-p m))))) t)

-(deftest standard-buffer-beginning-of-buffer.test-1 - (let ((buffer (make-instance 'standard-buffer))) +(defmultitest beginning-of-buffer.test-1 + (let ((buffer (make-instance %%buffer))) (insert-buffer-sequence buffer 0 "climacs climacs") - (let ((m (make-instance 'standard-left-sticky-mark + (let ((m (make-instance %%left-sticky-mark :buffer buffer :offset 11))) (and (not (beginning-of-buffer-p m)) (progn (beginning-of-buffer m) (beginning-of-buffer-p m))))) t)

-(deftest standard-buffer-end-of-buffer.test-1 - (let ((buffer (make-instance 'standard-buffer))) +(defmultitest end-of-buffer.test-1 + (let ((buffer (make-instance %%buffer))) (insert-buffer-sequence buffer 0 "climacs climacs") - (let ((m (make-instance 'standard-left-sticky-mark + (let ((m (make-instance %%left-sticky-mark :buffer buffer :offset 11))) (and (not (end-of-buffer-p m)) (progn (end-of-buffer m) (end-of-buffer-p m))))) t)

-(deftest standard-buffer-buffer-object.test-1 - (let ((buffer (make-instance 'standard-buffer))) +(defmultitest buffer-object.test-1 + (let ((buffer (make-instance %%buffer))) (insert-buffer-sequence buffer 0 "climacs") (buffer-object buffer 3)) #\m)

-(deftest standard-buffer-buffer-object.test-2 +(defmultitest buffer-object.test-2 (handler-case - (let ((buffer (make-instance 'standard-buffer))) + (let ((buffer (make-instance %%buffer))) (insert-buffer-sequence buffer 0 "climacs") (buffer-object buffer -1)) (climacs-buffer::no-such-offset (c) (= (climacs-buffer::condition-offset c) -1))) t)

-(deftest standard-buffer-buffer-object.test-3 +(defmultitest buffer-object.test-3 (handler-case - (let ((buffer (make-instance 'standard-buffer))) + (let ((buffer (make-instance %%buffer))) (insert-buffer-sequence buffer 0 "climacs") (buffer-object buffer 7)) (climacs-buffer::no-such-offset (c) (= (climacs-buffer::condition-offset c) 7))) t)

-(deftest standard-buffer-buffer-sequence.test-1 +(defmultitest buffer-sequence.test-1 (handler-case - (let ((buffer (make-instance 'standard-buffer))) + (let ((buffer (make-instance %%buffer))) (buffer-sequence buffer -1 0)) (climacs-buffer::no-such-offset (c) (= (climacs-buffer::condition-offset c) -1))) t)

-(deftest standard-buffer-buffer-sequence.test-2 +(defmultitest buffer-sequence.test-2 (handler-case - (let ((buffer (make-instance 'standard-buffer))) + (let ((buffer (make-instance %%buffer))) (buffer-sequence buffer 0 1)) (climacs-buffer::no-such-offset (c) (= (climacs-buffer::condition-offset c) 1))) t)

-(deftest standard-buffer-buffer-sequence.test-3 - (let ((buffer (make-instance 'standard-buffer))) +(defmultitest buffer-sequence.test-3 + (let ((buffer (make-instance %%buffer))) (insert-buffer-sequence buffer 0 "climacs") (buffer-sequence buffer 5 3)) #())

-(deftest standard-buffer-object-before.test-1 - (let ((buffer (make-instance 'standard-buffer))) +(defmultitest object-before.test-1 + (let ((buffer (make-instance %%buffer))) (insert-buffer-sequence buffer 0 "climacs") (object-before (high-mark buffer))) #\s)

-(deftest standard-buffer-object-before.test-2 +(defmultitest object-before.test-2 (handler-case - (let ((buffer (make-instance 'standard-buffer))) + (let ((buffer (make-instance %%buffer))) (insert-buffer-sequence buffer 0 "climacs") (object-before (low-mark buffer))) (climacs-buffer::no-such-offset (c) (= (climacs-buffer::condition-offset c) -1))) t)

-(deftest standard-buffer-object-after.test-1 - (let ((buffer (make-instance 'standard-buffer))) +(defmultitest object-after.test-1 + (let ((buffer (make-instance %%buffer))) (insert-buffer-sequence buffer 0 "climacs") (object-after (low-mark buffer))) #\c)

-(deftest standard-buffer-object-after.test-2 +(defmultitest object-after.test-2 (handler-case - (let ((buffer (make-instance 'standard-buffer))) + (let ((buffer (make-instance %%buffer))) (insert-buffer-sequence buffer 0 "climacs") (object-after (high-mark buffer))) (climacs-buffer::no-such-offset (c) (= (climacs-buffer::condition-offset c) 7))) t)

-(deftest standard-buffer-region-to-sequence.test-1 +(defmultitest region-to-sequence.test-1 (let ((seq "climacs") - (buffer (make-instance 'standard-buffer))) + (buffer (make-instance %%buffer))) (insert-buffer-sequence buffer 0 seq) (let ((seq2 (region-to-sequence (low-mark buffer) (high-mark buffer)))) (and (not (eq seq seq2)) seq2))) "climacs")

-(deftest standard-buffer-region-to-sequence.test-1a +(defmultitest region-to-sequence.test-1a (let ((seq "climacs") - (buffer (make-instance 'standard-buffer))) + (buffer (make-instance %%buffer))) (insert-buffer-sequence buffer 0 seq) (let ((seq2 (region-to-sequence 0 (high-mark buffer)))) (and (not (eq seq seq2)) seq2))) "climacs")

-(deftest standard-buffer-region-to-sequence.test-1aa +(defmultitest region-to-sequence.test-1aa (let ((seq "climacs") - (buffer (make-instance 'standard-buffer))) + (buffer (make-instance %%buffer))) (insert-buffer-sequence buffer 0 seq) (let ((seq2 (region-to-sequence (high-mark buffer) 0))) (and (not (eq seq seq2)) seq2))) "climacs")

-(deftest standard-buffer-region-to-sequence.test-1b +(defmultitest region-to-sequence.test-1b (let ((seq "climacs") - (buffer (make-instance 'standard-buffer))) + (buffer (make-instance %%buffer))) (insert-buffer-sequence buffer 0 seq) (let ((seq2 (region-to-sequence (low-mark buffer) 7))) (and (not (eq seq seq2)) seq2))) "climacs")

-(deftest standard-buffer-region-to-sequence.test-1ba +(defmultitest region-to-sequence.test-1ba (let ((seq "climacs") - (buffer (make-instance 'standard-buffer))) + (buffer (make-instance %%buffer))) (insert-buffer-sequence buffer 0 seq) (let ((seq2 (region-to-sequence 7 (low-mark buffer)))) (and (not (eq seq seq2)) seq2))) "climacs")

-(deftest standard-buffer-region-to-sequence.test-2 +(defmultitest region-to-sequence.test-2 (let ((seq "climacs") - (buffer (make-instance 'standard-buffer))) + (buffer (make-instance %%buffer))) (insert-buffer-sequence buffer 0 seq) (region-to-sequence (high-mark buffer) (low-mark buffer))) "climacs")

-(deftest standard-buffer-region-to-sequence.test-3 +(defmultitest region-to-sequence.test-3 (handler-case - (let ((buffer1 (make-instance 'standard-buffer)) - (buffer2 (make-instance 'standard-buffer))) + (let ((buffer1 (make-instance %%buffer)) + (buffer2 (make-instance %%buffer))) (region-to-sequence (low-mark buffer1) (high-mark buffer2))) (error (c) (declare (ignore c)) 'caught)) caught)

- ;;;; performance tests

-(defmacro deftimetest (name form &rest results) - `(deftest ,name - (time - (progn - (format t "~&; Performance test ~a" ',name) - ,form)) - ,@results)) - -(deftimetest standard-buffer-performance.test-1 - (loop with b = (make-instance 'standard-buffer) - for i from 0 below 100000 - do (insert-buffer-object b 0 #\a) - finally (return (size b))) +(defmultitest performance.test-1 + (time + (loop with b = (make-instance %%buffer) + for i from 0 below 100000 + do (insert-buffer-object b 0 #\a) + finally (return (size b)))) 100000)

-(deftimetest standard-buffer-performance.test-1a - (let ((b (loop with b = (make-instance 'standard-buffer) - for i from 0 below 100000 - do (insert-buffer-object b 0 #\a) - finally (return b)))) - (loop for i from 0 below 100000 - do (delete-buffer-range b 0 1) - finally (return (size b)))) +(defmultitest performance.test-1a + (time + (let ((b (loop with b = (make-instance %%buffer) + for i from 0 below 100000 + do (insert-buffer-object b 0 #\a) + finally (return b)))) + (loop for i from 0 below 100000 + do (delete-buffer-range b 0 1) + finally (return (size b))))) 0)

-(deftimetest standard-buffer-performance.test-1b - (loop with b = (make-instance 'standard-buffer) - for i from 0 below 100000 - do (insert-buffer-object b (size b) #\a) - finally (return (size b))) +(defmultitest performance.test-1b + (time + (loop with b = (make-instance %%buffer) + for i from 0 below 100000 + do (insert-buffer-object b (size b) #\a) + finally (return (size b)))) 100000)

-(deftimetest standard-buffer-performance.test-1ba - (let ((b (loop with b = (make-instance 'standard-buffer) - for i from 0 below 100000 - do (insert-buffer-object b (size b) #\a) - finally (return b)))) - (loop for i from 0 below 100000 - do (delete-buffer-range b 0 1) - finally (return (size b)))) +(defmultitest performance.test-1ba + (time + (let ((b (loop with b = (make-instance %%buffer) + for i from 0 below 100000 + do (insert-buffer-object b (size b) #\a) + finally (return b)))) + (loop for i from 0 below 100000 + do (delete-buffer-range b 0 1) + finally (return (size b))))) 0)

-(deftimetest standard-buffer-performance.test-1c - (loop with b = (make-instance 'standard-buffer) - for i from 0 below 100000 - do (insert-buffer-object b (floor (size b) 2) #\a) - finally (return (size b))) +(defmultitest performance.test-1c + (time + (loop with b = (make-instance %%buffer) + for i from 0 below 100000 + do (insert-buffer-object b (floor (size b) 2) #\a) + finally (return (size b)))) 100000)

-(deftimetest standard-buffer-performance.test-1ca - (let ((b (loop with b = (make-instance 'standard-buffer) - for i from 0 below 100000 - do (insert-buffer-object b (floor (size b) 2) #\a) - finally (return b)))) - (loop for i from 0 below 100000 - do (delete-buffer-range b 0 1) - finally (return (size b)))) +(defmultitest performance.test-1ca + (time + (let ((b (loop with b = (make-instance %%buffer) + for i from 0 below 100000 + do (insert-buffer-object b (floor (size b) 2) #\a) + finally (return b)))) + (loop for i from 0 below 100000 + do (delete-buffer-range b 0 1) + finally (return (size b))))) 0)

-(deftimetest standard-buffer-performance.test-1cb - (let ((b (loop with b = (make-instance 'standard-buffer) - for i from 0 below 100000 - do (insert-buffer-object b (floor (size b) 2) #\a) - finally (return b)))) - (loop for i from 0 below 100000 - do (delete-buffer-range b (floor (size b) 2) 1) - finally (return (size b)))) +(defmultitest performance.test-1cb + (time + (let ((b (loop with b = (make-instance %%buffer) + for i from 0 below 100000 + do (insert-buffer-object b (floor (size b) 2) #\a) + finally (return b)))) + (loop for i from 0 below 100000 + do (delete-buffer-range b (floor (size b) 2) 1) + finally (return (size b))))) 0)

-(deftimetest standard-buffer-performance.test-2 - (loop with b = (make-instance 'standard-buffer) - for i from 0 below 100000 - do (insert-buffer-sequence b 0 "a") - finally (return (size b))) +(defmultitest performance.test-2 + (time + (loop with b = (make-instance %%buffer) + for i from 0 below 100000 + do (insert-buffer-sequence b 0 "a") + finally (return (size b)))) 100000)

-(deftimetest standard-buffer-performance.test-2b - (loop with b = (make-instance 'standard-buffer) - for i from 0 below 100000 - do (insert-buffer-sequence b (size b) "a") - finally (return (size b))) +(defmultitest performance.test-2b + (time + (loop with b = (make-instance %%buffer) + for i from 0 below 100000 + do (insert-buffer-sequence b (size b) "a") + finally (return (size b)))) 100000)

-(deftimetest standard-buffer-performance.test-2c - (loop with b = (make-instance 'standard-buffer) - for i from 0 below 100000 - do (insert-buffer-sequence b (floor (size b) 2) "a") - finally (return (size b))) +(defmultitest performance.test-2c + (time + (loop with b = (make-instance %%buffer) + for i from 0 below 100000 + do (insert-buffer-sequence b (floor (size b) 2) "a") + finally (return (size b)))) 100000)

-(deftimetest standard-buffer-performance.test-3 - (loop with b = (make-instance 'standard-buffer) - for i from 0 below 100000 - do (insert-buffer-sequence b 0 "abcdefghij") - finally (return (size b))) +(defmultitest performance.test-3 + (time + (loop with b = (make-instance %%buffer) + for i from 0 below 100000 + do (insert-buffer-sequence b 0 "abcdefghij") + finally (return (size b)))) 1000000)

-(deftimetest standard-buffer-performance.test-3b - (loop with b = (make-instance 'standard-buffer) - for i from 0 below 100000 - do (insert-buffer-sequence b (size b) "abcdefghij") - finally (return (size b))) +(defmultitest performance.test-3b + (time + (loop with b = (make-instance %%buffer) + for i from 0 below 100000 + do (insert-buffer-sequence b (size b) "abcdefghij") + finally (return (size b)))) 1000000)

-(deftimetest standard-buffer-performance.test-3c - (loop with b = (make-instance 'standard-buffer) - for i from 0 below 100000 - do (insert-buffer-sequence b (floor (size b) 2) "abcdefghij") - finally (return (size b))) +(defmultitest performance.test-3c + (time + (loop with b = (make-instance %%buffer) + for i from 0 below 100000 + do (insert-buffer-sequence b (floor (size b) 2) "abcdefghij") + finally (return (size b)))) 1000000)

Index: climacs/climacs.asd diff -u climacs/climacs.asd:1.18 climacs/climacs.asd:1.19 --- climacs/climacs.asd:1.18 Mon Feb 7 16:26:41 2005 +++ climacs/climacs.asd Thu Feb 10 01:27:07 2005 @@ -70,9 +70,7 @@ ;;---- optional ---- "testing/rt" "buffer-test" - "base-test" - "Persistent/persistent-buffer-test" - "Persistent/persistent-base-test") + "base-test")

#+asdf (defmethod asdf:perform :around ((o asdf:compile-op)