[mcclim-cvs] CVS mcclim/Drei/Tests
thenriksen
thenriksen at common-lisp.net
Thu Dec 20 10:33:36 UTC 2007
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.
More information about the Mcclim-cvs
mailing list