Add normalization unit tests

src/dhall_clj/beta_normalize.clj

@@ -31,7 +31,8 @@
                   \backspace "\\b"
                   \newline "\\n"
                   \return "\\r"
-                  \tab "\\t"}
+                  \tab "\\t"
+                  \formfeed "\\f"}
         escape-control (fn [char]
                          (if (<= (int char) 30)
                            (format "\\u%04x" (int char))
@@ -476,7 +477,7 @@
       (if (and (= 1 (count new-chunks))
                (not (string? (first new-chunks))))
         (first new-chunks)
-        (->TextLit new-chunks))))
+        (->TextLit (compact-chunks new-chunks)))))
 
   dhall_clj.ast.TextAppend
   (beta-normalize [{:keys [a b]}]
@@ -512,9 +513,9 @@
     (let [decide (fn [l r]
                    (cond
                      (and (instance? ListLit l)
-                          (empty? l))            r
+                          (empty? (:exprs l)))   r
                      (and (instance? ListLit r)
-                          (empty? r))            l
+                          (empty? (:exprs r)))   l
                      (and (instance? ListLit l)
                           (instance? ListLit r)) (update l :exprs concat (:exprs r))
                      :else                       (->ListAppend l r)))]
@@ -592,9 +593,9 @@
     (letfn [(decide [l r]
               (cond
                 (and (instance? RecordLit l)
-                     (empty? l))              r
+                     (empty? (:kvs l)))       r
                 (and (instance? RecordLit r)
-                     (empty? r))              l
+                     (empty? (:kvs r)))       l
                 (and (instance? RecordLit l)
                      (instance? RecordLit r)) (->RecordLit
                                                 (->> (merge-with decide (:kvs l) (:kvs r))
@@ -607,9 +608,9 @@
     (letfn [(decide [l r]
               (cond
                 (and (instance? RecordT l)
-                     (empty? l))            r
+                     (empty? (:kvs l)))     r
                 (and (instance? RecordT r)
-                     (empty? r))            l
+                     (empty? (:kvs r)))     l
                 (and (instance? RecordT l)
                      (instance? RecordT r)) (->RecordT
                                               (->> (merge-with decide (:kvs l) (:kvs r))
@@ -622,9 +623,9 @@
     (letfn [(decide [l r]
               (cond
                 (and (instance? RecordLit l)
-                     (empty? l))              r
+                     (empty? (:kvs l)))       r
                 (and (instance? RecordLit r)
-                     (empty? r))              l
+                     (empty? (:kvs r)))       l
                 (and (instance? RecordLit l)
                      (instance? RecordLit r)) (->RecordLit
                                                 (->> (merge (:kvs l) (:kvs r))
@@ -672,7 +673,9 @@
           (if (every? (fn [k] (contains? kvs k)) ks)
             (beta-normalize (->RecordLit (select-keys kvs ks)))
             (->Project (->RecordLit (map-vals beta-normalize kvs)) ks)))
-        (assoc this :e e'))))
+        (if-not (seq ks)
+          (->RecordLit {})
+          (assoc this :e e')))))
 
   dhall_clj.ast.ImportAlt
   (beta-normalize [this]

src/dhall_clj/parse.clj

@@ -460,6 +460,7 @@
 (defmethod expr :labels [{:keys [c t]}]
   (->> c
      rest
+     butlast
      (take-nth 2)
      (mapv expr)))
 

test/dhall_clj/beta_normalize_test.clj

@@ -5,6 +5,7 @@
              [dhall-clj.parse :refer [parse expr]]
              [dhall-clj.import :refer [resolve-imports]]
              [dhall-clj.beta-normalize :refer [beta-normalize]]
+             [dhall-clj.alpha-normalize :refer [alpha-normalize]]
              [dhall-clj.state :as s]
              [dhall-clj.test-utils :refer :all]
              [me.raynes.fs :as fs]
@@ -74,15 +75,21 @@
 (deftest normalization-suite
   (let [import-cache (s/new)]
     (doseq [[testcase {:keys [actual expected]}] (valid-testcases)]
-      (let [parent (fs/parent testcase)
-            f #(fs/with-mutable-cwd
-                 (fs/chdir parent)
-                 (-> %
-                    parse
-                    expr
-                    (resolve-imports import-cache)
-                    beta-normalize))]
+      (let [parent (fs/parent testcase)]
         (println "TESTCASE" testcase)
         (testing testcase
-          (is (= (f actual)
-                 (f expected))))))))
+          (is (= (fs/with-mutable-cwd
+                   (fs/chdir parent)
+                   (-> expected
+                      parse
+                      expr
+                      (resolve-imports import-cache)
+                      alpha-normalize))
+                 (fs/with-mutable-cwd
+                   (fs/chdir parent)
+                   (-> actual
+                      parse
+                      expr
+                      (resolve-imports import-cache)
+                      beta-normalize
+                      alpha-normalize)))))))))

test/dhall_clj/import_test.clj

@@ -99,9 +99,9 @@
           _ (fs/delete cache-file)
           [pr1 time-uncached] (time' (core/input-ast to-eval))
           [pr2 time-cached]   (time' (core/input-ast to-eval))]
-      (println "Time to fetch the uncached Prelude is > 1s")
-      (is (> time-uncached 1000))
-      (println "Time to fetch the cached Prelude is < 1s")
-      (is (< time-cached) 1000)
+      (println "Time to fetch the uncached Prelude is > 0.5s")
+      (is (> time-uncached 500))
+      (println "Time to fetch the cached Prelude is < 0.5s")
+      (is (< time-cached) 500)
       (println "The two Preludes are the same")
       (is (= (alpha-normalize pr1) pr2)))))

test/dhall_clj/parser_test.clj

@@ -269,13 +269,13 @@
                {:headers? nil
                 :url (uri "https://localhost/file")})})]
 
-   ["https://user:pass:more@localhost:8888/file?test#aaaa"
+   ["https://user:pass:more@localhost:8888/file?test"
     (map->Import
       {:mode :code
        :hash? nil
        :data (map->Remote
                {:headers? nil
-                :url (uri "https://user:pass:more@localhost:8888/file?test#aaaa")})})]
+                :url (uri "https://user:pass:more@localhost:8888/file?test")})})]
 
    ["http://user@example.com/some/file.dhall"
     (map->Import
@@ -317,8 +317,7 @@
    ["dhall-lang" "tests" "parser" "success" "importAlt"]
    ["dhall-lang" "tests" "parser" "success" "asText"]
    ["dhall-lang" "tests" "parser" "success" "unicodePaths"]
-   ;; Something's broken
-   ["dhall-lang" "tests" "parser" "success" "largeExpression"]
+   ["dhall-lang" "tests" "parser" "success" "spaceAfterListAppend"]
 
    ;; Waiting on issue #28
    ["dhall-lang" "tests" "parser" "success" "quotedPaths"]])

test/dhall_clj/test_utils.clj

@@ -25,7 +25,8 @@
   for the 'successful' test cases."
   [test-folder]
   (let [files (->> (list-files test-folder)
-                 (remove failure-case?))
+                 (remove failure-case?)
+                 (remove #(string/includes? (str %) ".md")))
         map-of-testcases (group-by #(-> % str
                                        (string/replace #"A.dhall" "")
                                        (string/replace #"B.dhall" ""))