git » blacktide.git » master » tree

[master] / test / com / tailrecursion / blacktide / interop_values_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
(ns com.tailrecursion.blacktide.interop-values-test
  "Method values and adapters retain their behavior across recovered control.
  Bound references preserve identity; generated wrapper classes may differ."
  (:require [clojure.test :refer [deftest is]]
            [com.tailrecursion.blacktide.compiler.passes.structure :as structure]
            [com.tailrecursion.blacktide.backend-fixture :as backend]
            [com.tailrecursion.blacktide.jvm-fixture]))

(def flags [true false false true])

(deftest java-function-values-across-joins
  (let [target (proxy [java.util.HashMap] [] (compute [_ callback] callback))
        callback (fn [x y] [x y])]
    (doseq [[tail invoke]
            [['String/.length #(% "abc")]
             [(with-meta 'String/valueOf {:param-tags ['Object]}) #(% "abc")]
             [(with-meta 'String/new {:param-tags ['String]}) #(% "abc")]
             ['(let [^java.util.function.BiFunction f callback] f)
              #(.apply ^java.util.function.BiFunction % :left :right)]
             ['(java.util.Map/.compute target :key callback)
              #(.apply ^java.util.function.BiFunction % :left :right)]
             ['(com.tailrecursion.blacktide.jvm-fixture/map-compute target :key callback)
              #(.apply ^java.util.function.BiFunction % :left :right)]]
            mode [:default :dispatcher]]
      (let [ordinary (list 'let ['values '(if flag [1 2] [3 4])] (list 'vector 'values tail))
            compiled (list 'loophole '[a 0 b 0]
                           '(if flag (setq a 1 b 2) (setq a 3 b 4)) (list 'vector '[a b] tail))
            observe (fn [body mode]
                      (let [f ((backend/compile-program (list 'fn '[flag target callback] body) mode) nil)
                            results (mapv #(f % target callback) flags)]
                        (mapv (fn [[pair f]] [pair (invoke f)]) results)))]
        (is (= :structured (:op (backend/capture #'structure/recover
                                 (list 'fn '[flag target callback] compiled)))))
        (is (= (observe ordinary :ordinary) (observe compiled mode)) (pr-str [mode tail]))))))

(deftest bound-adapters-retain-identity-and-effects
  (doseq [mode [:default :dispatcher] flag [false true]]
    (let [events (atom []) callback (fn [x y] (swap! events conj [x y]) (+ x y))
          f ((backend/compile-program
               '(fn [flag callback]
                  (loophole [a 0 b 0 saved nil]
                    (if flag (setq a 1 b 2) (setq a 3 b 4))
                    (let [^java.util.function.BiFunction f (do (swap! events conj :adapt) callback)]
                      (setq saved f)
                      [(identical? saved f) (.apply f a b) saved]))) mode) events)
          [same? result adapter] (f flag callback)]
      (is same?)
      (is (= (if flag 3 7) result))
      (is (= 9 (.apply ^java.util.function.BiFunction adapter 4 5)))
      (is (= [:adapt (if flag [1 2] [3 4]) [4 5]] @events)))))