git » blacktide.git » master » tree

[master] / test / com / tailrecursion / blacktide / subset_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
(ns com.tailrecursion.blacktide.subset-test
  "The language boundary applies after macroexpansion, including dead code;
  callers may freely use Clojure outside the region. Quoted data stays opaque."
  (:require [clojure.test :refer [deftest is]]
            [com.tailrecursion.blacktide :refer [loophole label goto setq]]
            [com.tailrecursion.blacktide.backend-fixture :as backend]))

(defmacro hidden-function [] `(fn [] :hidden))
(defmacro hidden-label [] `(label ~'hidden))

(deftest excluded-forms-are-rejected-before-reachability
  (doseq [body '[(fn [] 1) (fn* [] 1) (letfn [(f [] 1)] (f)) (letfn* [f (fn* [] 1)] (f))
                (try 1 (catch Exception e 2) (finally nil)) (monitor-enter nil) (monitor-exit nil)
                (set! x 1) (def value 1) (declare value) (reify Object (toString [_] "x"))
                (loophole [] 1) (delay 1) (lazy-seq [1]) (future 1)
                (binding [*print-length* 1] 2) (locking (Object.) 1)
                (with-open [r (java.io.StringReader. "")] 1) (with-redefs [identity vector] 1)
                (com.tailrecursion.blacktide.subset-test/hidden-function)]
          prefix [[] ['(goto done)]]]
    (is (= :unsupported-form
           (:kind (backend/rejection (list* 'loophole '[x 0] (concat prefix [body '(label done)])))))
        (pr-str [prefix body]))))

(deftest operands-cannot-hide-transfers
  (doseq [body '[(identity (do (goto done) 1))
                ((do (goto done) identity) 1)
                (if (do (goto done) true) 1 2)
                (case (do (goto done) 1) 1 2 3)
                (let [a (do (goto done) 1)] a)
                (loop [a (do (goto done) 1)] a)
                (loop [a 0] (recur (do (goto done) 1)))
                (setq x (case 1 1 (goto done) 2))
                [(let [] (goto done) 1)]
                (identity (loop [] (goto done)))
                ^{:note (do (goto done) 1)} [1]
                (let [] (com.tailrecursion.blacktide.subset-test/hidden-label))]]
    (is (= :marker-position (:kind (backend/rejection (list 'loophole '[x 0] body '(label done))))) (pr-str body)))
  (is (= :ok (loophole [] (do (label a) (do (goto b))) :wrong (label b) :ok)))
  (is (= '(fn [] (goto missing)) (loophole [] '(fn [] (goto missing))))))

(deftest caller-functions-and-dynamic-extent
  (let [events (atom []) helper (fn [x] (try (inc x) (finally (swap! events conj :helper))))]
    (is (= 4 (try (loophole [x 0] (dotimes [_ 4] (setq x (helper x))) x)
                   (finally (swap! events conj :caller)))))
    (is (= [:helper :helper :helper :helper :caller] @events)))
  (letfn [(even-state [n] (if (zero? n) true (odd-state (dec n))))
          (odd-state [n] (if (zero? n) false (even-state (dec n))))]
    (is (= [true false] (loophole [] [(even-state 4) (odd-state 4)]))))
  (binding [*print-length* 1]
    (is (= "[1 ...]" (loophole [] (pr-str [1 2])))))
  (let [error (Exception. "caller handles it")]
    (is (identical? error (try (loophole [] (throw error)) (catch Exception e e))))))