[mcclim-cvs] CVS mcclim/Drei/Tests
thenriksen
thenriksen at common-lisp.net
Sat Feb 17 17:54:06 UTC 2007
Update of /project/mcclim/cvsroot/mcclim/Drei/Tests
In directory clnet:/tmp/cvs-serv13162/Tests
Modified Files:
testing.lisp motion-tests.lisp lisp-syntax-tests.lisp
Log Message:
Tightened the nuts and bolts of Lisp syntax and added a bunch of tests
to make relatively sure there are no regressions. No tests for Swine
yet, but "it seems to work". Also fixes very major performance issue
with redisplay of literal objects in Lisp syntax.
--- /project/mcclim/cvsroot/mcclim/Drei/Tests/testing.lisp 2007/01/15 11:35:53 1.3
+++ /project/mcclim/cvsroot/mcclim/Drei/Tests/testing.lisp 2007/02/17 17:54:06 1.4
@@ -76,8 +76,7 @@
(begin-offset 0) (end-offset (size buffer)))
"Check (using FiveAM) whether `buffer' contains `string' in the
subsequence delimited by `begin-offset' and `end-offset'."
- (is (string= (buffer-substring buffer begin-offset end-offset)
- string)))
+ (is (string= string (buffer-substring buffer begin-offset end-offset))))
(defclass test-drei (drei)
()
--- /project/mcclim/cvsroot/mcclim/Drei/Tests/motion-tests.lisp 2006/12/04 07:54:51 1.1
+++ /project/mcclim/cvsroot/mcclim/Drei/Tests/motion-tests.lisp 2007/02/17 17:54:06 1.2
@@ -1,8 +1,7 @@
;;; -*- Mode: Lisp; Package: COMMON-LISP-USER -*-
-;;; (c) copyright 2005 by
+;;; (c) copyright 2005-2007 by
;;; Aleksandar Bakic (a_bakic at yahoo.com)
-;;; (c) copyright 2006 by
;;; Troels Henriksen (athas at sigkill.dk)
;;; This library is free software; you can redistribute it and/or
@@ -94,18 +93,18 @@
backward-end-offset
(offset goal-forward-offset goal-backward-offset)
initial-contents
- &key (syntax ''drei-fundamental-syntax:fundamental-syntax)))
- (check-type forward-begin-offset integer)
- (check-type backward-end-offset integer)
+ &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)
(let ((forward (intern (format nil "FORWARD-ONE-~S" unit)))
(backward (intern (format nil "BACKWARD-ONE-~S" unit))))
`(progn
- (test ,forward
+ (test ,(intern (format nil "~A-~A" syntax forward))
(with-buffer (buffer :initial-contents ,initial-contents
- :syntax ,syntax)
+ :syntax ',syntax)
(let ((syntax (syntax buffer))
(m0l (clone-mark (low-mark buffer) :left))
(m0r (clone-mark (low-mark buffer) :right))
@@ -119,21 +118,25 @@
(offset m1r) ,offset
(offset m2l) (size buffer)
(offset m2r) (size buffer))
- (is-true (,forward m0l syntax))
- (is (= (offset m0l) ,forward-begin-offset))
- (is-true (,forward m0r syntax))
- (is (= (offset m0r) ,forward-begin-offset))
+ ,(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 (= (offset m1l) ,goal-forward-offset))
+ (is (= ,goal-forward-offset (offset m1l)))
(is-true (,forward m1r syntax))
- (is (= (offset m1r) ,goal-forward-offset))
+ (is (= ,goal-forward-offset (offset m1r)))
(is-false (,forward m2l syntax))
- (is (= (offset m2l) (size buffer)))
+ (is (= (size buffer) (offset m2l)))
(is-false (,forward m2r syntax))
- (is (= (offset m2r) (size buffer))))))
- (test ,backward
+ (is (= (size buffer) (offset m2r))))))
+ (test ,(intern (format nil "~A-~A" syntax backward))
(with-buffer (buffer :initial-contents ,initial-contents
- :syntax ,syntax)
+ :syntax ',syntax)
(let ((syntax (syntax buffer))
(m0l (clone-mark (low-mark buffer) :left))
(m0r (clone-mark (low-mark buffer) :right))
@@ -148,17 +151,21 @@
(offset m2l) (size buffer)
(offset m2r) (size buffer))
(is-false (,backward m0l syntax))
- (is (= (offset m0l) 0))
+ (is (= 0 (offset m0l)))
(is-false (,backward m0r syntax))
- (is (= (offset m0r) 0))
+ (is (= 0 (offset m0r)))
(is-true (,backward m1l syntax))
- (is (= (offset m1l) ,goal-backward-offset))
+ (is (= ,goal-backward-offset (offset m1l)))
(is-true (,backward m1r syntax))
- (is (= (offset m1r) ,goal-backward-offset))
- (is-true (,backward m2l syntax))
- (is (= (offset m2l) ,backward-end-offset))
- (is-true (,backward m2r syntax))
- (is (= (offset m2r) ,backward-end-offset))))))))
+ (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
--- /project/mcclim/cvsroot/mcclim/Drei/Tests/lisp-syntax-tests.lisp 2007/01/31 14:31:59 1.3
+++ /project/mcclim/cvsroot/mcclim/Drei/Tests/lisp-syntax-tests.lisp 2007/02/17 17:54:06 1.4
@@ -1,6 +1,6 @@
;;; -*- Mode: Lisp; Package: COMMON-LISP-USER -*-
-;;; (c) copyright 2006 by
+;;; (c) copyright 2006-2007 by
;;; Troels Henriksen (athas at sigkill.dk)
;;; This library is free software; you can redistribute it and/or
@@ -21,7 +21,11 @@
(cl:in-package :drei-tests)
(def-suite lisp-syntax-tests :description "The test suite for
-tests related to the Lisp syntax module.")
+tests related to the Lisp syntax module. The parser is not
+explicitly tested. Instead, it is hoped that any defects will be
+caught by other test cases, all of which depend on correct
+parsing. Also, redisplay is not tested, because no-one has any
+idea how to do it.")
(in-suite lisp-syntax-tests)
@@ -32,16 +36,22 @@
parser result and re-run the test suite (except for this
self-compilation test, of course).")
-(defmacro testing-lisp-syntax ((buffer-contents) &body body)
- `(with-buffer (buffer :initial-contents ,buffer-contents
- :syntax 'lisp-syntax)
- (flet ((get-object (&rest args)
- (apply #'form-to-object (syntax buffer)
- (first (drei-lisp-syntax::children
- (slot-value (syntax buffer)
- 'drei-lisp-syntax::stack-top)))
- args)))
- , at body)))
+(defmacro testing-lisp-syntax ((buffer-contents &rest options) &body body)
+ (assert (evenp (length options)))
+ (with-gensyms (buffer drei)
+ `(with-buffer (,buffer :initial-contents ,buffer-contents :syntax 'lisp-syntax)
+ ,@(loop for (option value) on options by #'cddr
+ collecting `(eval-option (syntax ,buffer) ,option ,value))
+ (let ((,drei (make-instance 'test-drei :buffer ,buffer)))
+ (with-bound-drei-special-variables (,drei :minibuffer nil)
+ (labels ((get-form ()
+ (first (drei-lisp-syntax::children
+ (slot-value *current-syntax*
+ 'drei-lisp-syntax::stack-top))))
+ (get-object (&rest args)
+ (apply #'form-to-object *current-syntax*
+ (get-form) args)))
+ , at body))))))
(defmacro testing-symbol ((sym-sym &rest args) &body body)
`(let ((,sym-sym (get-object , at args)))
@@ -55,171 +65,285 @@
(defmacro testing-lisp-syntax-symbol ((buffer-contents sym-sym &rest args)
&body body)
- `(with-buffer (buffer :initial-contents ,buffer-contents
- :syntax 'lisp-syntax)
+ `(testing-lisp-syntax (,buffer-contents)
(flet ((get-object (&rest args)
- (apply #'form-to-object (syntax buffer)
+ (apply #'form-to-object *current-syntax*
(first (drei-lisp-syntax::children
- (slot-value (syntax buffer)
+ (slot-value *current-syntax*
'drei-lisp-syntax::stack-top)))
args)))
(testing-symbol (,sym-sym , at args)
, at body))))
+(test lisp-syntax-test-base
+ "Test the Base syntax attribute for Lisp syntax."
+ (testing-lisp-syntax ("")
+ (is (= *read-base* (drei-lisp-syntax::base *current-syntax*))))
+ (testing-lisp-syntax ("" :base "2")
+ (is (= 2 (drei-lisp-syntax::base *current-syntax*))))
+ (testing-lisp-syntax ("" :base "36")
+ (is (= 36 (drei-lisp-syntax::base *current-syntax*))))
+ (testing-lisp-syntax ("" :base "1") ; Should be ignored.
+ (is (= *read-base* (drei-lisp-syntax::base *current-syntax*))))
+ (testing-lisp-syntax ("" :base "37") ; Should be ignored.
+ (is (= *read-base* (drei-lisp-syntax::base *current-syntax*)))))
+
+(test lisp-syntax-test-package
+ "Test the Package syntax attribute for Lisp syntax."
+ (testing-lisp-syntax ("")
+ (is (eq nil (drei-lisp-syntax::option-specified-package *current-syntax*))))
+ (testing-lisp-syntax ("" :package "COMMON-LISP")
+ (is (eq (find-package :cl)
+ (drei-lisp-syntax::option-specified-package *current-syntax*))))
+ (testing-lisp-syntax ("" :package "CL")
+ (is (eq (find-package :cl)
+ (drei-lisp-syntax::option-specified-package *current-syntax*))))
+ (testing-lisp-syntax ("" :package "common-lisp")
+ (is (string= "common-lisp"
+ (drei-lisp-syntax::option-specified-package *current-syntax*)))))
+
+(test lisp-syntax-test-attributes
+ "Test that the syntax attributes of Lisp syntax are returned
+properly."
+ (testing-lisp-syntax ("")
+ (is-true (assoc :package (current-attributes-for-syntax *current-syntax*)))
+ (is-true (assoc :base (current-attributes-for-syntax *current-syntax*)))))
+
+(test lisp-syntax-package-at-mark
+ "Test that Lisp syntax' handling of (in-package) forms is
+correct."
+ (testing-lisp-syntax ("(in-package :cl-user) ")
+ (is (eq *package*
+ (drei-lisp-syntax::package-at-mark *current-syntax* 10))))
+ (testing-lisp-syntax ("(in-package :cl-user) " :package "DREI-LISP-SYNTAX")
+ (is (eq (find-package :drei-lisp-syntax)
+ (drei-lisp-syntax::package-at-mark *current-syntax* 10))))
+ (testing-lisp-syntax ("(in-package :cl-user) ")
+ (is (eq (find-package :cl-user)
+ (drei-lisp-syntax::package-at-mark *current-syntax* 23))))
+ (testing-lisp-syntax ("(in-package \"CL-USER\") ")
+ (is (eq (find-package :cl-user)
+ (drei-lisp-syntax::package-at-mark *current-syntax* 23))))
+ (testing-lisp-syntax ("(in-package \"cl-user\") ")
+ (is (eq *package*
+ (drei-lisp-syntax::package-at-mark *current-syntax* 23))))
+ (testing-lisp-syntax ("(in-package :cl-user)(in-package :clim) ")
+ (is (eq (find-package :clim)
+ (drei-lisp-syntax::package-at-mark *current-syntax* 43))))
+ (testing-lisp-syntax ("(in-package :cl-user)(in-package :iDoNotExist) ")
+ (is (eq (find-package :cl-user)
+ (drei-lisp-syntax::package-at-mark *current-syntax* 43)))))
+
+(test lisp-syntax-provided-package-name-at-mark
+ "Test that Lisp syntax' handling of (in-package) forms is
+correct, even counting packages that cannot be found."
+ (testing-lisp-syntax ("(in-package :cl-user) ")
+ (is (string= "CLIM-USER"
+ (drei-lisp-syntax::provided-package-name-at-mark *current-syntax* 10))))
+ (testing-lisp-syntax ("(in-package :cl-user) " :package "DREI-LISP-SYNTAX")
+ (is (string= "DREI-LISP-SYNTAX"
+ (drei-lisp-syntax::provided-package-name-at-mark *current-syntax* 10))))
+ (testing-lisp-syntax ("(in-package :cl-user) ")
+ (is (string= "CL-USER"
+ (drei-lisp-syntax::provided-package-name-at-mark *current-syntax* 23))))
+ (testing-lisp-syntax ("(in-package \"CL-USER\") ")
+ (is (string= "CL-USER"
+ (drei-lisp-syntax::provided-package-name-at-mark *current-syntax* 23))))
+ (testing-lisp-syntax ("(in-package \"cl-user\") ")
+ (is (string= "cl-user"
+ (drei-lisp-syntax::provided-package-name-at-mark *current-syntax* 23))))
+ (testing-lisp-syntax ("(in-package :cl-user)(in-package :clim) ")
+ (is (string= "CLIM"
+ (drei-lisp-syntax::provided-package-name-at-mark *current-syntax* 43))))
+ (testing-lisp-syntax ("(in-package :cl-user)(in-package :iDoNotExist) ")
+ (is (string= "IDONOTEXIST"
+ (drei-lisp-syntax::provided-package-name-at-mark *current-syntax* 48)))))
+
+(test lisp-syntax-need-to-update-package-list-p
+ "Test that Lisp syntax can properly handle it when (in-package)
+ forms change."
+ (testing-lisp-syntax ("(in-package :cl-user) ")
+ (is (eq (find-package :cl-user)
+ (drei-lisp-syntax::package-at-mark *current-syntax* 23)))
+ (delete-buffer-range *current-buffer* 0 (size *current-buffer*))
+ (insert-buffer-sequence *current-buffer* 0 "(in-package :cl-userr) ")
+ (update-syntax *current-buffer* *current-syntax*)
+ (is (eq *package*
+ (drei-lisp-syntax::package-at-mark *current-syntax* 24)))
+ (insert-buffer-sequence *current-buffer* 24 "(in-package :drei-lisp-syntax) ")
+ (update-syntax *current-buffer* *current-syntax*)
+ (is (eq (find-package :drei-lisp-syntax)
+ (drei-lisp-syntax::package-at-mark *current-syntax* 54)))
+ (delete-buffer-range *current-buffer* 0 23)
+ (insert-buffer-sequence *current-buffer* 0 "(in-package :clim-user)")
+ (update-syntax *current-buffer* *current-syntax*)
+ (is (eq (find-package :clim-user)
+ (drei-lisp-syntax::package-at-mark *current-syntax* 26)))))
+
(test form-to-object-1
+ "Test that we can parse and recognize T in Lisp syntax."
(testing-lisp-syntax ("T")
- (is (eq (get-object) t)))
+ (is (eq t (get-object))))
(testing-lisp-syntax ("t")
- (is (eq (get-object) t))))
+ (is (eq t (get-object)))))
(test form-to-object-2
+ "Test that casing is properly done for NIL."
(testing-lisp-syntax ("nil")
- (is (eq (get-object) nil)))
+ (is (eq nil (get-object))))
(testing-lisp-syntax ("NIL")
- (is (eq (get-object) nil)))
+ (is (eq nil (get-object))))
(testing-lisp-syntax ("NIl")
- (is (eq (get-object) nil)))
+ (is (eq nil (get-object))))
(testing-lisp-syntax ("NIl")
- (is-false (eq (get-object :case :preserve) nil))))
+ (is-false (eq nil (get-object :case :preserve)))))
(test form-to-object-3
+ "Test case-conversion for tokens."
(testing-lisp-syntax ("iDoNotExist")
(testing-symbol (sym :case :upcase)
(is-false (symbol-package sym))
- (is (string= (symbol-name sym)
- "IDONOTEXIST")))
+ (is (string= "IDONOTEXIST"
+ (symbol-name sym))))
(testing-symbol (sym :case :preserve)
(is-false (symbol-package sym))
- (is (string= (symbol-name sym)
- "iDoNotExist")))
+ (is (string= "iDoNotExist"
+ (symbol-name sym))))
(testing-symbol (sym :case :downcase)
(is-false (symbol-package sym))
- (is (string= (symbol-name sym)
- "idonotexist")))
+ (is (string= "idonotexist"
+ (symbol-name sym))))
(testing-symbol (sym :read t :case :upcase)
(is-true (symbol-package sym))
- (is (string= (symbol-name sym)
- "IDONOTEXIST")))
+ (is (string= "IDONOTEXIST"
+ (symbol-name sym))))
(testing-symbol (sym :read t :case :preserve)
(is-true (symbol-package sym))
- (is (string= (symbol-name sym)
- "iDoNotExist")))
+ (is (string= "iDoNotExist"
+ (symbol-name sym))))
(testing-symbol (sym :read t :case :downcase)
(is-true (symbol-package sym))
- (is (string= (symbol-name sym)
- "idonotexist")))
+ (is (string= "idonotexist"
+ (symbol-name sym))))
(testing-symbol (sym :case :invert)
(is-false (symbol-package sym))
- (is (string= (symbol-name sym)
- "iDoNotExist"))))
+ (is (string= "iDoNotExist"
+ (symbol-name sym)))))
(testing-lisp-syntax-symbol ("IDONOTEXIST" sym :case :invert)
(is-false (symbol-package sym))
- (is (string= (symbol-name sym)
- "idonotexist")))
+ (is (string= "idonotexist"
+ (symbol-name sym))))
(testing-lisp-syntax-symbol ("idonotexist" sym :case :invert)
(is-false (symbol-package sym))
- (is (string= (symbol-name sym)
- "IDONOTEXIST"))))
+ (is (string= "IDONOTEXIST"
+ (symbol-name sym)))))
(test form-to-object-4
+ "Test case-conversion for uninterned tokens."
(testing-lisp-syntax ("#:iDoNotExist")
(testing-symbol (sym :case :upcase)
(is-false (symbol-package sym))
- (is (string= (symbol-name sym)
- "IDONOTEXIST")))
+ (is (string= "IDONOTEXIST"
+ (symbol-name sym))))
(testing-symbol (sym :case :preserve)
(is-false (symbol-package sym))
- (is (string= (symbol-name sym)
- "iDoNotExist")))
+ (is (string= "iDoNotExist"
+ (symbol-name sym))))
(testing-symbol (sym :case :downcase)
(is-false (symbol-package sym))
- (is (string= (symbol-name sym)
- "idonotexist")))
+ (is (string= "idonotexist"
+ (symbol-name sym))))
(testing-symbol (sym :case :invert)
(is-false (symbol-package sym))
- (is (string= (symbol-name sym)
- "iDoNotExist"))))
+ (is (string= "iDoNotExist"
+ (symbol-name sym)))))
(testing-lisp-syntax ("#:IDONOTEXIST")
(let ((sym (get-object :case :invert)))
(is-false (symbol-package sym))
- (is (string= (symbol-name sym)
- "idonotexist"))))
+ (is (string= "idonotexist"
+ (symbol-name sym)))))
(testing-lisp-syntax ("#:idonotexist")
(let ((sym (get-object :case :invert)))
(is-false (symbol-package sym))
- (is (string= (symbol-name sym)
- "IDONOTEXIST")))))
+ (is (string= "IDONOTEXIST"
+ (symbol-name sym))))))
(test form-to-object-5
+ "Test handling of escaped symbols."
(testing-lisp-syntax-symbol ("|123|" sym :read t)
- (is (string= (symbol-name sym) "123")))
+ (is (string= "123" (symbol-name sym))))
(testing-lisp-syntax-symbol ("|LIST|" sym :read t :case :downcase)
- (is (string= (symbol-name sym) "LIST")))
+ (is (string= "LIST" (symbol-name sym))))
(testing-lisp-syntax-symbol ("| |" sym :read t)
- (is (string= (symbol-name sym) " ")))
+ (is (string= " " (symbol-name sym))))
(testing-lisp-syntax-symbol ("|foo|bar|abbabz|" sym :read t)
- (is (string= (symbol-name sym)
- "fooBARabbabz")))
+ (is (string= "fooBARabbabz" (symbol-name sym))))
(testing-lisp-syntax-symbol ("||" sym :read t)
- (is (string= (symbol-name sym) "")))
+ (is (string= "" (symbol-name sym))))
(testing-lisp-syntax-symbol ("||||" sym :read t)
- (is (string= (symbol-name sym) ""))))
+ (is (string= "" (symbol-name sym)))))
(test form-to-object-6
+ "Test keyword symbols."
(testing-lisp-syntax-symbol (":foo" sym :read t)
- (is (string= (symbol-name sym) "FOO"))
- (is (eq (symbol-package sym)
- (find-package :keyword)))))
+ (is (string= "FOO" (symbol-name sym)))
+ (is (eq (find-package :keyword)
+ (symbol-package sym)))))
(test form-to-object-7
+ "Test that numbers are recognized and handled properly by the
+Lisp syntax."
(testing-lisp-syntax ("123")
- (is (= (get-object) 123)))
+ (is (= 123 (get-object))))
(testing-lisp-syntax ("-123")
- (is (= (get-object) -123)))
+ (is (= -123 (get-object))))
(testing-lisp-syntax (".123")
- (is (= (get-object) .123)))
+ (is (= .123 (get-object))))
(testing-lisp-syntax ("-.123")
- (is (= (get-object) -.123)))
+ (is (= -.123 (get-object))))
(testing-lisp-syntax ("1.234")
- (is (= (get-object) 1.234)))
+ (is (= 1.234 (get-object))))
(testing-lisp-syntax ("-1.234")
- (is (= (get-object) -1.234)))
+ (is (= -1.234 (get-object))))
(testing-lisp-syntax ("1e7")
- (is (= (get-object) 1e7)))
+ (is (= 1e7 (get-object))))
(testing-lisp-syntax ("1E7")
- (is (= (get-object) 1e7)))
+ (is (= 1e7 (get-object))))
(testing-lisp-syntax ("1.123E7")
- (is (= (get-object) 1.123e7)))
+ (is (= 1.123e7 (get-object))))
(testing-lisp-syntax ("-1.123E7")
- (is (= (get-object) -1.123e7)))
+ (is (= -1.123e7 (get-object))))
(testing-lisp-syntax (".123E7")
- (is (= (get-object) .123e7)))
+ (is (= .123e7 (get-object))))
(testing-lisp-syntax ("-.123E7")
- (is (= (get-object) -.123e7)))
+ (is (= -.123e7 (get-object))))
(testing-lisp-syntax ("1.34e-7")
- (is (= (get-object) 1.34e-7))))
+ (is (= 1.34e-7 (get-object)))))
(test form-to-object-8
+ "Test that the standard reader macros for numbers are
+recognized and handled."
(testing-lisp-syntax ("#b0000")
- (is (= (get-object) 0)))
+ (is (= 0 (get-object))))
(testing-lisp-syntax ("#b10")
- (is (= (get-object) 2)))
+ (is (= 2 (get-object))))
(testing-lisp-syntax ("#b-10")
- (is (= (get-object) -2)))
+ (is (= -2 (get-object))))
(testing-lisp-syntax ("#x00")
- (is (= (get-object) 0)))
+ (is (= 0 (get-object))))
(testing-lisp-syntax ("#xFE")
- (is (= (get-object) 254)))
+ (is (= 254 (get-object))))
(testing-lisp-syntax ("#x-FE")
- (is (= (get-object) -254)))
+ (is (= -254 (get-object))))
(testing-lisp-syntax ("#o00")
[804 lines skipped]
More information about the Mcclim-cvs
mailing list