git » blacktide.git » master » tree

[master] / test / com / tailrecursion / nanopass / language_test.clj 

 1
 2
 3
 4
 5
 6
 7
 8
 9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
(ns com.tailrecursion.nanopass.language-test
  "Derivation, syntax rejection, and terminal opacity independent of the checker."
  (:require [clojure.test :refer [deftest is]]
            [com.tailrecursion.nanopass.language :as l]
            [com.tailrecursion.nanopass.fixtures :as f]))

(defn failure [f]
  (try (f) nil (catch clojure.lang.ExceptionInfo e (:kind (ex-data e)))))

(deftest derivation
  (is (not (contains? (loaded-libs) 'typed.clojure)))
  (is (= #{:literal :read :assign :group :many}
         (set (map l/tag (l/alternatives (get-in f/Source [:types 'Expr]))))))
  (is (= #{:literal :read :write :group :many}
         (set (map l/tag (l/alternatives (get-in f/Core [:types 'Expr]))))))
  (is (= 'com.tailrecursion.nanopass.fixtures/Core-Expr (l/type-name f/Core 'Expr)))
  (let [types (l/type-forms [f/Core])
        symbols (set (filter symbol? (tree-seq coll? seq types)))]
    (is (symbols 'com.tailrecursion.nanopass.fixtures/Core-Binding))
    (is (not (symbols 'com.tailrecursion.nanopass.fixtures/Source-Expr))))
  (is (= '(quote Expr) (l/instantiate f/Core '(quote Expr))))
  (is (= '(typed.clojure/Val Expr) (l/instantiate f/Core '(typed.clojure/Val Expr))))
  (is (= '(typed.clojure/Val {:symbol Expr})
         (l/qualify *ns* '#{Expr} '(clojure.core.typed/Val {:symbol Expr}))))
  (is (= '(typed.clojure/HMap :mandatory {:op (quote :binding) :name typed.clojure/Sym
                                         :value com.tailrecursion.nanopass.fixtures/Literals-Expr}
                            :complete? true)
         (l/instantiate f/Literals (get-in f/Literals [:types 'Binding])))))

(deftest invalid-grammars
  (doseq [[expected form]
          '[[:invalid-hmap (typed.clojure/HMap :mandatory {:op ':a})]
            [:invalid-hmap (typed.clojure/HMap :mandatory {:x Expr} :optional {:x Expr} :complete? true)]
            [:invalid-tag (typed.clojure/HMap :mandatory {:op typed.clojure/Keyword} :complete? true)]
            [:duplicate-tag (typed.clojure/U (typed.clojure/HMap :mandatory {:op ':a} :complete? true)
                                           (typed.clojure/HMap :mandatory {:op ':a} :complete? true))]
            [:duplicate-tag (typed.clojure/U (typed.clojure/HMap :mandatory {:op ':a} :complete? true)
                                           (typed.clojure/U (typed.clojure/HMap :mandatory {:op ':a} :complete? true)))]
            [:invalid-tuple (typed.clojure/HVec [Expr] :rest Expr)]
            [:invalid-type (typed.clojure/Map Expr)]
            [:unsupported-recursion (typed.clojure/IFn [Expr :-> Expr])]]]
    (is (= expected (failure #(l/language 'example/L {'Expr form}))) (pr-str form)))
  (is (= :unknown-type (failure #(l/qualify *ns* '#{Expr} 'Missing))))
  (is (= :unsupported-type (failure #(l/qualify *ns* '#{Expr} '(quote [Expr])))))
  (is (= :unsupported-type (failure #(l/qualify *ns* '#{Expr} '(quote {:value Expr})))))
  (is (= :unknown-production
         (failure #(l/derive 'example/L f/Source '{:remove {Expr #{:absent}}})))))

(deftest extension-validation
  (doseq [[expected changes]
          [[:invalid-extension '{:remove {Expr #{:read}} :replace {Expr typed.clojure/Any}}]
           [:unknown-nonterminal '{:remove {Missing #{:read}}}]
           [:invalid-extension '{:extra {}}]
           [:duplicate-tag {:add {'Expr [(first (l/alternatives (get-in f/Source [:types 'Expr]))) ]}}]]]
    (is (= expected (failure #(l/derive 'example/L f/Source changes))))))