Update of /project/mcclim/cvsroot/mcclim/Drei/Tests In directory clnet:/tmp/cvs-serv9380/Drei/Tests

Modified Files: lisp-syntax-tests.lisp motion-tests.lisp Log Message: Added a bunch of neat convenience functions to Lisp syntax.

--- /project/mcclim/cvsroot/mcclim/Drei/Tests/lisp-syntax-tests.lisp 2007/12/08 08:53:48 1.8 +++ /project/mcclim/cvsroot/mcclim/Drei/Tests/lisp-syntax-tests.lisp 2007/12/19 17:17:37 1.9 @@ -834,7 +834,10 @@

(motion-fun-one-test up (nil nil (13 14 12) "(defun list () (&rest elements) -(append elements nil))" :syntax lisp-syntax)) +(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) @@ -844,12 +847,12 @@ (test in-string-p "Test the `in-string-p' function of Lisp syntax." (testing-lisp-syntax (" "foobar!" ") - (is-false (drei-lisp-syntax::in-string-p 0 (current-syntax))) - (is-false (drei-lisp-syntax::in-string-p 1 (current-syntax))) - (is-true (drei-lisp-syntax::in-string-p 2 (current-syntax))) - (is-true (drei-lisp-syntax::in-string-p 6 (current-syntax))) - (is-true (drei-lisp-syntax::in-string-p 9 (current-syntax))) - (is-false (drei-lisp-syntax::in-string-p 10 (current-syntax))))) + (is-false (in-string-p (current-syntax) 0)) + (is-false (in-string-p (current-syntax) 1)) + (is-true (in-string-p (current-syntax) 2)) + (is-true (in-string-p (current-syntax) 6)) + (is-true (in-string-p (current-syntax) 9)) + (is-false (in-string-p (current-syntax) 10))))

(test in-comment-p "Test the `in-comment-p' function of Lisp syntax." @@ -858,17 +861,98 @@ #| I'm a - BLOCK - comment |#") - (is-false (drei-lisp-syntax::in-comment-p 0 (current-syntax))) - (is-false (drei-lisp-syntax::in-comment-p 1 (current-syntax))) - (is-true (drei-lisp-syntax::in-comment-p 2 (current-syntax))) - (is-false (drei-lisp-syntax::in-comment-p 16 (current-syntax))) - (is-false (drei-lisp-syntax::in-comment-p 17 (current-syntax))) - (is-true (drei-lisp-syntax::in-comment-p 18 (current-syntax))) - (is-false (drei-lisp-syntax::in-comment-p 40 (current-syntax))) - (is-true (drei-lisp-syntax::in-comment-p 41 (current-syntax))) - (is-true (drei-lisp-syntax::in-comment-p 50 (current-syntax))) - (is-true (drei-lisp-syntax::in-comment-p 60 (current-syntax))) - (is-false (drei-lisp-syntax::in-comment-p 69 (current-syntax))))) + (is-false (in-comment-p (current-syntax) 0)) + (is-false (in-comment-p (current-syntax) 1)) + (is-true (in-comment-p (current-syntax) 2)) + (is-true (in-comment-p (current-syntax) 16)) + (is-false (in-comment-p (current-syntax) 17)) + (is-true (in-comment-p (current-syntax) 18)) + (is-false (in-comment-p (current-syntax) 40)) + (is-false (in-comment-p (current-syntax) 41)) + (is-true (in-comment-p (current-syntax) 50)) + (is-true (in-comment-p (current-syntax) 60)) + (is-false (in-comment-p (current-syntax) 68)) + (is-false (in-comment-p (current-syntax) 69)))) + +(test in-character-p + "Test the `in-character-p' function of Lisp syntax." + (testing-lisp-syntax ("#\C #\( +#\# +#\ +hello") + (is-false (in-character-p (current-syntax) 0)) + (is-false (in-character-p (current-syntax) 1)) + (is-true (in-character-p (current-syntax) 2)) + (is-false (in-character-p (current-syntax) 4)) + (is-false (in-character-p (current-syntax) 5)) + (is-true (in-character-p (current-syntax) 6)) + (is-true (in-character-p (current-syntax) 10)) + (is-true (in-character-p (current-syntax) 14)) + (is-false (in-character-p (current-syntax) 16)))) + +(test location-at-beginning-of-form-list + "Test the `location-at-beginning-of-form' function for lists." + (testing-lisp-syntax ("(a b c (d e f) g") + (is-false (location-at-beginning-of-form (current-syntax) 0)) + (is-true (location-at-beginning-of-form (current-syntax) 1)) + (is-false (location-at-beginning-of-form (current-syntax) 2)) + (is-false (location-at-beginning-of-form (current-syntax) 7)) + (is-true (location-at-beginning-of-form (current-syntax) 8)))) + +(test location-at-end-of-form-list + "Test the `location-at-end-of-form' function for lists." + (testing-lisp-syntax ("(a b c (d e f) g)") + (is-false (location-at-end-of-form (current-syntax) 0)) + (is-false (location-at-end-of-form (current-syntax) 1)) + (is-false (location-at-end-of-form (current-syntax) 12)) + (is-true (location-at-end-of-form (current-syntax) 13)) + (is-false (location-at-end-of-form (current-syntax) 14)) + (is-true (location-at-end-of-form (current-syntax) 16)))) + +(test location-at-beginning-of-form-string + "Test the `location-at-beginning-of-form' function for strings." + (testing-lisp-syntax (""a b c "d e f" g") + (is-false (location-at-beginning-of-form (current-syntax) 0)) + (is-true (location-at-beginning-of-form (current-syntax) 1)) + (is-false (location-at-beginning-of-form (current-syntax) 2)) + (is-false (location-at-beginning-of-form (current-syntax) 7)) + (is-false (location-at-beginning-of-form (current-syntax) 8)) + (is-true (location-at-beginning-of-form (current-syntax) 14)) + (is-false (location-at-beginning-of-form (current-syntax) 15)))) + +(test location-at-end-of-form-string + "Test the `location-at-end-of-form' function for strings." + (testing-lisp-syntax (""a b c "d e f" g)"") + (is-false (location-at-end-of-form (current-syntax) 0)) + (is-false (location-at-end-of-form (current-syntax) 1)) + (is-false (location-at-end-of-form (current-syntax) 6)) + (is-true (location-at-end-of-form (current-syntax) 7)) + (is-false (location-at-end-of-form (current-syntax) 8)) + (is-false (location-at-end-of-form (current-syntax) 16)) + (is-true (location-at-end-of-form (current-syntax) 17)) + (is-false (location-at-end-of-form (current-syntax) 18)))) + +(test location-at-beginning-of-form-simple-vector + "Test the `location-at-beginning-of-form' function for simple +vectors." + (testing-lisp-syntax ("#(a b c #(d e f) g") + (is-false (location-at-beginning-of-form (current-syntax) 0)) + (is-false (location-at-beginning-of-form (current-syntax) 1)) + (is-true (location-at-beginning-of-form (current-syntax) 2)) + (is-false (location-at-beginning-of-form (current-syntax) 3)) + (is-false (location-at-beginning-of-form (current-syntax) 9)) + (is-true (location-at-beginning-of-form (current-syntax) 10)))) + +(test location-at-end-of-form-simple-vector + "Test the `location-at-end-of-form' function for simple-vectors." + (testing-lisp-syntax ("#(a b c #(d e f) g)") + (is-false (location-at-end-of-form (current-syntax) 0)) + (is-false (location-at-end-of-form (current-syntax) 1)) + (is-false (location-at-end-of-form (current-syntax) 2)) + (is-false (location-at-end-of-form (current-syntax) 14)) + (is-true (location-at-end-of-form (current-syntax) 15)) + (is-false (location-at-end-of-form (current-syntax) 16)) + (is-true (location-at-end-of-form (current-syntax) 18))))

;; For some tests, we need various functions, classes and ;; macros. Define them here and pray we don't clobber anything --- /project/mcclim/cvsroot/mcclim/Drei/Tests/motion-tests.lisp 2007/12/08 08:53:48 1.5 +++ /project/mcclim/cvsroot/mcclim/Drei/Tests/motion-tests.lisp 2007/12/19 17:17:37 1.6 @@ -86,74 +86,79 @@ (backward-to-word-boundary m2r syntax) (is (= (offset m2r) 0))))))

-(defmacro motion-fun-one-test (unit (forward-begin-offset - backward-end-offset - (offset goal-forward-offset goal-backward-offset) - initial-contents - &key (syntax 'drei-fundamental-syntax:fundamental-syntax))) - (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) +(defmacro motion-fun-one-test (unit &rest test-specs) (let ((forward (intern (format nil "FORWARD-ONE-~S" unit))) (backward (intern (format nil "BACKWARD-ONE-~S" unit)))) `(progn - (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)))))))))))) + ,@(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)))))))))))))))

(motion-fun-one-test word (9 10 (5 9 2) " climacs