Update of /project/mcclim/cvsroot/mcclim/Drei/Tests In directory clnet:/tmp/cvs-serv4077/Drei/Tests
Modified Files: lisp-syntax-tests.lisp motion-tests.lisp Log Message: Fixed some problems with retrieving forms in Lisp syntax.
--- /project/mcclim/cvsroot/mcclim/Drei/Tests/lisp-syntax-tests.lisp 2007/12/19 17:17:37 1.9 +++ /project/mcclim/cvsroot/mcclim/Drei/Tests/lisp-syntax-tests.lisp 2007/12/20 10:33:35 1.10 @@ -820,29 +820,36 @@ (buffer-is "(with-output-to-string (s "foo" :element-type 'character ") (is (= 45 (offset mark))))))
-(motion-fun-one-test expression (51 0 (11 28 7) - "(defun list (&rest elements) -(append elements nil))" :syntax lisp-syntax)) - -(motion-fun-one-test list (64 4 (22 41 11) - "foo (defun (barbaz) list (&rest elements) -(append elements nil))" :syntax lisp-syntax)) - -(motion-fun-one-test down (1 53 (15 16 13) - "(defun list () (&rest elements) -(append elements nil))" :syntax lisp-syntax)) - -(motion-fun-one-test up (nil nil (13 14 12) - "(defun list () (&rest elements) -(append elements nil))" :syntax lisp-syntax) - (nil nil (17 19 12) - "(defun list (x y z) -(list x y z))" :syntax lisp-syntax)) - -(motion-fun-one-test definition (51 52 (35 51 0) - "(defun list (&rest elements) -(append elements nil)) (defun second (list) (cadr list))" -:syntax lisp-syntax)) +(motion-fun-one-test (expression lisp-syntax) + (51 0 (11 28 7) + "(defun list (&rest elements) +(append elements nil))")) + +(motion-fun-one-test (list lisp-syntax) + (64 4 (22 41 11) + "foo (defun (barbaz) list (&rest elements) +(append elements nil))")) + +(motion-fun-one-test (down lisp-syntax) + (1 53 (15 16 13) + "(defun list () (&rest elements) +(append elements nil))")) + +(motion-fun-one-test (up lisp-syntax) + (nil nil (13 14 12) + "(defun list () (&rest elements) +(append elements nil))") + (nil nil (17 19 12) + "(defun list (x y z) +(list x y z))" ) + (nil nil (21 24 0) + "(defun list (x y z) + )")) + +(motion-fun-one-test (definition lisp-syntax) + (51 52 (35 51 0) + "(defun list (&rest elements) +(append elements nil)) (defun second (list) (cadr list))"))
(test in-string-p "Test the `in-string-p' function of Lisp syntax." --- /project/mcclim/cvsroot/mcclim/Drei/Tests/motion-tests.lisp 2007/12/19 17:17:37 1.6 +++ /project/mcclim/cvsroot/mcclim/Drei/Tests/motion-tests.lisp 2007/12/20 10:33:35 1.7 @@ -86,96 +86,106 @@ (backward-to-word-boundary m2r syntax) (is (= (offset m2r) 0))))))
-(defmacro motion-fun-one-test (unit &rest test-specs) +(defmacro motion-fun-one-test ((unit &optional (syntax 'drei-fundamental-syntax::fundamental-syntax)) + &body test-specs) (let ((forward (intern (format nil "FORWARD-ONE-~S" unit))) (backward (intern (format nil "BACKWARD-ONE-~S" unit)))) `(progn ,@(loop for test in test-specs nconc - (destructuring-bind (forward-begin-offset - backward-end-offset - (offset goal-forward-offset goal-backward-offset) - initial-contents - &key (syntax 'drei-fundamental-syntax::fundamental-syntax)) - test - (check-type forward-begin-offset (or integer null)) - (check-type backward-end-offset (or integer null)) - (check-type offset integer) - (check-type goal-forward-offset integer) - (check-type goal-backward-offset integer) - (list - `(test ,(intern (format nil "~A-~A" syntax forward) #.*package*) - (with-buffer (buffer :initial-contents ,initial-contents) - (with-view (view :buffer buffer :syntax ',syntax) - (let ((syntax (syntax view)) - (m0l (make-buffer-mark buffer 0 :left)) - (m0r (make-buffer-mark buffer 0 :right)) - (m1l (make-buffer-mark buffer ,offset :left)) - (m1r (make-buffer-mark buffer ,offset :right)) - (m2l (make-buffer-mark buffer (size buffer) :left)) - (m2r (make-buffer-mark buffer (size buffer) :right))) - (declare (ignore ,@(unless forward-begin-offset '(m0l)) - ,@(unless backward-end-offset '(m0r)))) - ,(when forward-begin-offset - `(progn - (is-true (,forward m0l syntax)) - (is (= ,forward-begin-offset (offset m0l))))) - ,(when backward-end-offset - `(progn - (is-true (,forward m0r syntax)) - (is (= ,forward-begin-offset (offset m0r))))) - (is-true (,forward m1l syntax)) - (is (= ,goal-forward-offset (offset m1l))) - (is-true (,forward m1r syntax)) - (is (= ,goal-forward-offset (offset m1r))) - (is-false (,forward m2l syntax)) - (is (= (size buffer) (offset m2l))) - (is-false (,forward m2r syntax)) - (is (= (size buffer) (offset m2r))))))) - `(test ,(intern (format nil "~A-~A" syntax backward) #.*package*) - (with-buffer (buffer :initial-contents ,initial-contents) - (with-view (view :buffer buffer :syntax ',syntax) - (let ((syntax (syntax view)) - (m0l (make-buffer-mark buffer 0 :left)) - (m0r (make-buffer-mark buffer 0 :right)) - (m1l (make-buffer-mark buffer ,offset :left)) - (m1r (make-buffer-mark buffer ,offset :right)) - (m2l (make-buffer-mark buffer (size buffer) :left)) - (m2r (make-buffer-mark buffer (size buffer) :right))) - (declare (ignore ,@(unless backward-end-offset '(m2l m2r)))) - (is-false (,backward m0l syntax)) - (is (= 0 (offset m0l))) - (is-false (,backward m0r syntax)) - (is (= 0 (offset m0r))) - (is-true (,backward m1l syntax)) - (is (= ,goal-backward-offset (offset m1l))) - (is-true (,backward m1r syntax)) - (is (= ,goal-backward-offset (offset m1r))) - ,(when backward-end-offset - `(progn - (is-true (,backward m2l syntax)) - (is (= ,backward-end-offset (offset m2l))))) - ,(when backward-end-offset - `(progn - (is-true (,backward m2r syntax)) - (is (= ,backward-end-offset (offset m2r))))))))))))))) + (list + `(test ,(intern (format nil "~A-~A" syntax forward) #.*package*) + ,@(loop for test in test-specs + collecting + (destructuring-bind (forward-begin-offset + backward-end-offset + (offset goal-forward-offset goal-backward-offset) + initial-contents) + test + (check-type forward-begin-offset (or integer null)) + (check-type backward-end-offset (or integer null)) + (check-type offset integer) + (check-type goal-forward-offset integer) + (check-type goal-backward-offset integer) + `(with-buffer (buffer :initial-contents ,initial-contents) + (with-view (view :buffer buffer :syntax ',syntax) + (let ((syntax (syntax view)) + (m0l (make-buffer-mark buffer 0 :left)) + (m0r (make-buffer-mark buffer 0 :right)) + (m1l (make-buffer-mark buffer ,offset :left)) + (m1r (make-buffer-mark buffer ,offset :right)) + (m2l (make-buffer-mark buffer (size buffer) :left)) + (m2r (make-buffer-mark buffer (size buffer) :right))) + (declare (ignore ,@(unless forward-begin-offset '(m0l)) + ,@(unless backward-end-offset '(m0r)))) + ,(when forward-begin-offset + `(progn + (is-true (,forward m0l syntax)) + (is (= ,forward-begin-offset (offset m0l))))) + ,(when backward-end-offset + `(progn + (is-true (,forward m0r syntax)) + (is (= ,forward-begin-offset (offset m0r))))) + (is-true (,forward m1l syntax)) + (is (= ,goal-forward-offset (offset m1l))) + (is-true (,forward m1r syntax)) + (is (= ,goal-forward-offset (offset m1r))) + (is-false (,forward m2l syntax)) + (is (= (size buffer) (offset m2l))) + (is-false (,forward m2r syntax)) + (is (= (size buffer) (offset m2r))))))))) + `(test ,(intern (format nil "~A-~A" syntax backward) #.*package*) + ,@(loop for test in test-specs + collecting + (destructuring-bind (forward-begin-offset + backward-end-offset + (offset goal-forward-offset goal-backward-offset) + initial-contents) + test + (declare (ignore forward-begin-offset goal-forward-offset)) + `(with-buffer (buffer :initial-contents ,initial-contents) + (with-view (view :buffer buffer :syntax ',syntax) + (let ((syntax (syntax view)) + (m0l (make-buffer-mark buffer 0 :left)) + (m0r (make-buffer-mark buffer 0 :right)) + (m1l (make-buffer-mark buffer ,offset :left)) + (m1r (make-buffer-mark buffer ,offset :right)) + (m2l (make-buffer-mark buffer (size buffer) :left)) + (m2r (make-buffer-mark buffer (size buffer) :right))) + (declare (ignore ,@(unless backward-end-offset '(m2l m2r)))) + (is-false (,backward m0l syntax)) + (is (= 0 (offset m0l))) + (is-false (,backward m0r syntax)) + (is (= 0 (offset m0r))) + (is-true (,backward m1l syntax)) + (is (= ,goal-backward-offset (offset m1l))) + (is-true (,backward m1r syntax)) + (is (= ,goal-backward-offset (offset m1r))) + ,(when backward-end-offset + `(progn + (is-true (,backward m2l syntax)) + (is (= ,backward-end-offset (offset m2l))))) + ,(when backward-end-offset + `(progn + (is-true (,backward m2r syntax)) + (is (= ,backward-end-offset (offset m2r))))))))))))))))
-(motion-fun-one-test word (9 10 (5 9 2) +(motion-fun-one-test (word) (9 10 (5 9 2) " climacs climacs"))
-(motion-fun-one-test line (17 22 (25 47 8) +(motion-fun-one-test (line) (17 22 (25 47 8) "Climacs-Climacs! climacsclimacsclimacs... Drei!"))
-(motion-fun-one-test page (19 42 (22 40 21) +(motion-fun-one-test (page) (19 42 (22 40 21) "This is about Drei! Drei is Cool Stuff. "))
-(motion-fun-one-test paragraph (21 67 (30 64 23) +(motion-fun-one-test (paragraph) (21 67 (30 64 23) "Climacs is an editor.
It is based on the Drei editor substrate.