청소

test/expand/core_test.clj

@@ -0,0 +1,86 @@
+(ns expand.core-test
+  (:require
+   [clojure.spec.alpha :as s]
+   [clojure.test :as t]
+   [expand.core :as sut]
+   [expand.scm :as scm]))
+
+(t/deftest nearest-test
+  (t/is (= '#{#{a b}}
+           (sut/nearest '#{a b c}
+                        '[#{a} #{a b} #{a d}]))
+        "unambiguous")
+  (t/is (= '#{#{a b} #{a c}}
+           (sut/nearest
+            '#{a b c} '[#{a} #{a b} #{a c}]))
+        "ambiguous")
+  (t/is (= #{}
+           (sut/nearest
+            '#{a b c} '[#{d} #{d e} #{f}]))
+        "undefined"))
+
+(t/deftest lookup-test
+  (t/is (= [:primitive 'lambda]
+           (sut/lookup #scm/stx [lambda #{}]
+                       {[:global 'lambda] [:primitive 'lambda]}
+                       {['lambda #{}] [:global 'lambda]})))
+  (t/is (= [:primitive 'lambda]
+           (sut/lookup #scm/stx [lambda #{a b c}]
+                       {[:global 'lambda] [:primitive 'lambda]}
+                       {['lambda #{}] [:global 'lambda]})))
+  (t/is (= [:var]
+           (sut/lookup #scm/stx [x #{a b c}]
+                       '{[:lexical x A] [:var]
+                         [:lexical x B] [:primitive lambda]}
+                       '{[x #{a b}] [:lexical x A]
+                         [x #{a}] [:lexical x B]}))))
+
+(defn- expand [stx]
+  (-> #:library {:name '(user)
+                 :declarations [[:import '(primitives+builtins)]
+                                [:begin stx]]}
+      sut/expand-library
+      :library/declarations
+      second
+      second
+      scm/syntax->datum))
+
+(t/deftest expand-test
+  (t/is (thrown? Exception (expand #scm/stx x)))
+  (t/testing "primitive forms"
+    (t/testing "lambda"
+      (t/is (= '(lambda (x) x)
+               (expand #scm/stx (#scm/stx lambda
+                                 #scm/stx (#scm/stx x)
+                                 #scm/stx x)))))
+    (t/testing "let"
+      (t/is (= '(let ((x 123))
+                  x)
+               (expand #scm/stx (#scm/stx let
+                                 #scm/stx (#scm/stx (#scm/stx x
+                                                     #scm/stx 123))
+                                 #scm/stx x)))))
+    (t/testing "if"
+      (t/is (= '(if 123 true false)
+               (expand #scm/stx (#scm/stx if
+                                 #scm/stx 123
+                                 #scm/stx true
+                                 #scm/stx false)))))))
+
+
+;;; specs
+
+(t/deftest spec-lambda-formals-test
+  (t/are [x] (s/valid? ::sut/lambda-formals x)
+    #scm/stx ()
+    #scm/stx (#scm/stx a #scm/stx b)
+    #scm/stx xs
+    (scm/datum->syntax
+     (scm/improper-list #scm/stx a
+                        #scm/stx b))))
+
+(t/deftest spec-prim-lambda-test
+  (t/are [x] (s/valid? ::sut/prim-lambda x)
+    #scm/stx (#scm/stx lambda
+              #scm/stx (#scm/stx a)
+              #scm/stx a)))

test/expand/scm_test.clj

@@ -0,0 +1,70 @@
+(ns expand.scm-test
+  (:require [clojure.test :as t]
+            [expand.scm :as sut])
+  (:import (expand.scm ISyntax Syntax)))
+
+(t/deftest read-test
+  (t/testing "boolean"
+    (t/is (= true (sut/read "#t")))
+    (t/is (= true (sut/read "#true")))
+    (t/is (= false (sut/read "#f")))
+    (t/is (= false (sut/read "#false"))))
+  (t/testing "symbol"
+    (t/is (= 'abc (sut/read "abc")))
+    (t/is (= 'truth-nuke (sut/read "truth-nuke"))))
+  (t/testing "list"
+    (t/is (= (list) (sut/read "()")))
+    (t/is (= (list 1 2 3) (sut/read "(1 2 3)")))
+    (t/is (= (sut/improper-list 1 2 3) (sut/read "(1 2 . 3)"))))
+  (t/testing "number"
+    (t/is (= 123 (sut/read "123")))
+    (t/is (= 123 (sut/read "+123")))
+    (t/is (= -123 (sut/read "-123"))))
+  (t/testing "library"
+    (t/are [s] (thrown?
+                Exception
+                (sut/read s :throw? true
+                          :library? true))
+      "" "()"
+      "(define-library ())"
+      ;; broken
+      #_"(define-library (blah -123))")
+    (t/is (= '#:library
+             {:name (my cool lib)
+              :declarations
+              ([:import (scheme base)]
+               [:export square]
+               [:begin (define (square n) (* n n))])}
+             (sut/read "(define-library (my cool lib)
+                          (import (scheme base))
+                          (export square)
+                          (begin (define (square n) (* n n))))"
+                       :library? true)))))
+
+(t/deftest read-syntax-test
+  (t/is (sut/unresolved? (sut/read-syntax "123")))
+  (t/is (sut/unresolved? (sut/read-syntax "(1 2 3)"))))
+
+(t/deftest improper-list?-test
+  (t/is (sut/improper-list? (sut/improper-list 1 2 3))))
+
+(t/deftest improper-list-test
+  (t/is (= [1 2] (:initial (sut/improper-list 1 2 3))))
+  (t/is (= 3 (:dot (sut/improper-list 1 2 3)))))
+
+(t/deftest constant?-test
+  (t/is (sut/constant? 123))
+  (t/is (sut/constant? #scm/stx 123)))
+
+(t/deftest syntax-test
+  (t/is (not (sut/syntax? 123)))
+  (t/is (sut/syntax? #scm/stx 123))
+  (t/is (sut/syntax? #scm/stx [123 #{}]))
+  (t/is (= 123 (sut/syntax-e #scm/stx [123 #{}]))))
+
+(t/deftest unresolved?-test
+  (t/is (sut/unresolved? (sut/->Syntax 123 nil)))
+  (t/is (sut/unresolved? #scm/stx 123)))
+
+(t/deftest resolved?-test
+  (t/is (sut/resolved? (sut/->Syntax 123 '#{a}))))

test/expand/syntax_rules_test.clj

@@ -2,7 +2,8 @@
   (:require [expand.syntax-rules :as sut]
             [clojure.core.match :refer [match]]
             [clojure.test :as t]
-            [clojure.walk :as walk]))
+            [clojure.walk :as walk]
+            [expand.scm :as scm]))
 
 (defmacro broken-is [form]
   `(t/is (not ~form)