git » blacktide.git » master » tree

[master] / test / com / tailrecursion / blacktide / algorithms_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
56
57
58
59
60
61
62
(ns com.tailrecursion.blacktide.algorithms-test
  "Partitioning and small parsers compared with independent collection/regex
  models. These programs are also used in the public examples."
  (:require [clojure.test :refer [deftest is]]
            [clojure.test.check.clojure-test :refer [defspec]]
            [clojure.test.check.generators :as gen]
            [clojure.test.check.properties :as prop]
            [com.tailrecursion.blacktide :refer [loophole label goto setq]]
            [blacktide.algorithms :refer [tokens partition! decimal-prefix]]))

(defn- partition-reference [xs]
  (when (seq xs)
    (let [pivot (first xs)]
      (loop [xs (vec xs) left -1 right (count xs)]
        (let [left (first (drop-while #(< (xs %) pivot) (range (inc left) (count xs))))
              right (first (drop-while #(> (xs %) pivot) (range (dec right) -1 -1)))]
          (if (>= left right) [right xs]
              (recur (assoc xs left (xs right) right (xs left)) left right)))))))

(defn- decimal-reference [s]
  (when-let [[token sign digits] (re-find #"^([+-]?)([0-9]+)" s)]
    [(* (if (= sign "-") -1 1) (bigint (java.math.BigInteger. digits))) (count token)]))

(defn- even-flips? [xs]
  (loophole [i 0 even-state true valid true]
    (label scan)
    (when (= i (count xs)) (goto done))
    (case (nth xs i)
      :flip (setq even-state (not even-state))
      :hold nil
      (do (setq valid false) (goto done)))
    (setq i (inc i)) (goto scan)
    (label done) (and valid even-state)))

(defn token-reference [s]
  (->> s (partition-by #(Character/isWhitespace ^char %))
       (remove #(Character/isWhitespace ^char (first %))) (mapv #(apply str %))))

(deftest parsing-and-partition-boundaries
  (doseq [s ["" "-" "+" "x" "0" "-0" "+0001" "-9223372036854775809!"
             "9999999999999999999999999999999999999999999999999"]]
    (is (= (decimal-reference s) (decimal-prefix s))))
  (doseq [s ["" " " "a" " a " "one two\tthree\nfour" "a\u2003b\u00a0c"]]
    (is (= (token-reference s) (tokens s))))
  (doseq [xs [[] [1] [2 1] [1 1 1] [0 -1 2 -3] [Long/MAX_VALUE Long/MIN_VALUE 0]]]
    (let [a (long-array xs)]
      (is (= (partition-reference xs) (when (seq xs) [(partition! a) (vec a)]))))))

(defspec deterministic-parser-and-mutation-differentials {:num-tests 300 :seed 424242}
  (prop/for-all [xs (gen/vector (gen/choose -15 15) 0 34)
                 number (gen/let [sign (gen/elements ["" "-" "+"])
                                   digits (gen/vector (gen/elements (vec "0123456789")) 0 24)
                                   suffix (gen/elements ["" "x" " 3"])]
                          (str sign (apply str digits) suffix))
                 text (gen/fmap #(apply str %) (gen/vector (gen/elements [\a \b \space \tab \newline \u2003 \u00a0]) 0 39))
                 states (gen/vector (gen/elements [:flip :hold :hold :bad]) 0 34)]
    (let [a (long-array xs)]
      (and (= (partition-reference xs) (when (seq xs) [(partition! a) (vec a)]))
           (= (decimal-reference number) (decimal-prefix number))
           (= (token-reference text) (tokens text))
           (= (and (every? #{:flip :hold} states) (even? (count (filter #{:flip} states))))
              (even-flips? states))))))