[mcclim-cvs] CVS mcclim/Drei/Tests
thenriksen
thenriksen at common-lisp.net
Wed Dec 19 17:17:37 UTC 2007
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
More information about the Mcclim-cvs
mailing list