git » jacl.git » commit 2722385

diff --git a/jacl-tests.lisp b/jacl-tests.lisp
index 835fe8a..dc26efe 100644
--- a/jacl-tests.lisp
+++ b/jacl-tests.lisp
@@ -19,13 +19,18 @@
 ;;;; OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE
 ;;;; SOFTWARE.
 
+;; Test framework
+
 (jacl:enable-js-syntax)
 
 (let* ((jpkg (jacl:\. (jacl:%js "Package") (|get| @"JACL"))))
   (jacl:\. *package* (|usePackage| jpkg)))
 
 (defvar *is*)
-(defvar *label* nil)
+(defvar *label* @"")
+
+(defun in-module (label)
+  (\. @|QUnit| (|module| (\. label (|toString|)))))
 
 (defmacro deftest (label &body body)
   (let ((is# (gensym)))
@@ -35,46 +40,61 @@
                      (let ((*is* ,is#))
                        ,@body))))))
 
-(defun assert= (x y &optional (label ""))
-  (\. *is* (|strictEqual| x y (or *label* (\. label (|toString|))))))
+(defmacro with-label (label &body body)
+  `(let ((*label* (\. ,label (|toString|))))
+     ,@body))
+
+(defun assert= (x y &optional (label *label*))
+  (\. *is* (|strictEqual| x y label)))
 
 (defmacro assert-throws (&body body)
-  `(\. *is* (|throws|
-             (lambda () ,@body)
-             (if *label* (\. *label* (|toString|)) @""))))
+  `(\. *is* (|throws| (lambda () ,@body) *label*)))
 
 (defun read1 (s)
   (let ((s (\. s (|toString|))))
     (\. (%new @|Reader| (%new @|StringStream| s)) (|read|))))
 
 (defun log (&rest objects)
-  (declare (jacl:rest-array))
-  (\. (jacl:%js "console") |log| (|apply| nil objects)))
+  (\. @|console| |log| (|apply| nil @|arguments|)))
+
+;; Tests
+
+(in-module "Reader")
+
+(defvar *object*)
 
-(\. @|QUnit| (|module| @"Atoms"))
+(defmacro with-read (str &body body)
+  `(let ((*object* (await (read1 ,(\. str (|toString|))))))
+     ,@body))
 
 (deftest "Fixnums"
-  (assert= (await (read1 "123 "))   123  "single integer")
+  (assert= (await (read1 "123 ")) 123  "single integer")
   (assert= (await (read1 "+9912 ")) 9912 "integer with leading +")
-  (assert= (await (read1 "0 "))     0    "zero")
-  (assert= (await (read1 "-32 "))   -32  "negative number")
-  (assert= (await (read1 "1. "))    1.   "number with trailing dot"))
+  (assert= (await (read1 "0 ")) 0 "zero")
+  (assert= (await (read1 "-32 ")) -32 "negative number")
+  (assert= (await (read1 "1. ")) 1. "number with trailing dot"))
 
 (deftest "Symbols"
-  (assert= nil @|null|)
-  (assert= 'nil @|null|)
-  (assert= t @|true|)
-  (assert= 't @|true|)
-  (let ((sym (await (read1 @"somesym "))))
-    (assert= (\. sym |name|) @"SOMESYM" "simple symbol name")
-    (assert= (\. sym |packageName|) @"COMMON-LISP-USER" "simple symbol package"))
-  (let ((sym (await (read1 @"|Alan| "))))
-    (assert= (\. sym |name|) @"Alan" "simple symbol name"))
-  ;; TODO Support escape syntax in the JavaScript String reader macro.
-  (let ((sym (await (read1 @"\\\\alan "))))
-    (assert= (\. sym |name|) @"aLAN" "simple symbol with escape")))
-
-(\. @|QUnit| (|module| @"Numerics"))
+  (with-label "nil and t"
+    (assert= nil @|null|)
+    (assert= 'nil @|null|)
+    (assert= t @|true|)
+    (assert= 't @|true|))
+  (with-label "uninterned"
+    (with-read "#:snoob "
+      (assert= (\. *object* |name|) @"SNOOB")
+      (assert= (\. *object* |packageName|) nil)))
+  (with-label "single escaped"
+    (with-read "somesym "
+      (assert= (\. *object* |name|) @"SOMESYM")
+      (assert= (\. *object* |packageName|) @"COMMON-LISP-USER"))
+    (with-read "\\\\alan "
+      (assert= (\. *object* |name|) @"aLAN")))
+  (with-label "multi escaped"
+    (with-read "|Alan| "
+      (assert= (\. *object* |name|) @"Alan"))))
+
+(in-module "Numerics")
 
 (deftest "Numeric functions"
   (assert= (zerop 1) nil)
@@ -113,7 +133,7 @@
   (assert-throws (- 1 'bar))
   )
 
-(\. @|QUnit| (|module| @"Control operators"))
+(in-module "Control operators")
 
 (deftest "JACL:%IF and CL:IF"
   (assert= (jacl:%if t 1) 1)
@@ -153,7 +173,7 @@
 
 (countdown 3)
 
-(\. @|QUnit| (|module| @"Iteration operators"))
+(in-module "Iteration operators")
 
 (deftest "CL:DOLIST"
   (let ((sum 0)
@@ -177,7 +197,7 @@
 
 (\. @|QUnit| (|start|))
 
-(\. @|QUnit| (|module| @"Functions"))
+(in-module "Functions")
 
 (deftest "Named JACL:%LAMBDA"
   (let* ((invocations 0)
@@ -222,3 +242,7 @@
 (deftest "Recursion"
   (assert= 7 (time @"tak" (tak 18 12 6))))
 
+;; Local Variables:
+;; eval: (put 'with-label 'lisp-indent-function 1)
+;; eval: (put 'with-read 'lisp-indent-function 1)
+;; End: