git » blacktide.git » master » tree

[master] / test / com / tailrecursion / blacktide / jvm_fixture.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
(ns com.tailrecursion.blacktide.jvm-fixture
  "Shared JVM dispatch fixtures, with a native Clojure outcome oracle."
  (:require [clojure.java.io :as io]
            [com.tailrecursion.blacktide :refer [loophole setq psetq label goto]]
            [com.tailrecursion.blacktide.backend-fixture :as backend]))

(def fixture-class
  (let [directory (.toFile (java.nio.file.Files/createTempDirectory "blacktide-jvm-fixture-"
                           (make-array java.nio.file.attribute.FileAttribute 0)))
        source (io/file directory "HostFixture.java")
        compiler (javax.tools.ToolProvider/getSystemJavaCompiler)]
    (try
      (with-open [input (io/input-stream (io/resource "com/tailrecursion/blacktide/fixtures/HostFixture.java"))]
        (io/copy input source))
      (when-not (zero? (.run compiler nil nil nil
                             (into-array String ["--release" "17" "-d" (.getPath directory) (.getPath source)])))
        (throw (ex-info "Java fixture compilation failed" {:directory directory})))
      (.defineClass ^clojure.lang.DynamicClassLoader (clojure.lang.RT/baseLoader)
                   "com.tailrecursion.blacktide.fixtures.HostFixture"
                   (java.nio.file.Files/readAllBytes
                     (.toPath (io/file directory "com/tailrecursion/blacktide/fixtures/HostFixture.class"))) nil)
      (finally (doseq [file (reverse (file-seq directory))] (io/delete-file file))))))

(definterface Choice
  (choose [^boolean x]) (choose [^long x]) (choose [^int x]) (choose [^double x])
  (choose [^String x]) (choose [^chars x]) (choose [^Object x]) (choose [^Number x]))
(def chooser
  (reify Choice
    (choose [_ ^boolean x] :boolean) (choose [_ ^long x] :long) (choose [_ ^int x] :int) (choose [_ ^double x] :double)
    (choose [_ ^String x] :string) (choose [_ ^chars x] :chars)
    (choose [_ ^Object x] :object) (choose [_ ^Number x] :number)))
(defn ^String text [] "x")
(defn primitive ^long [] 1)
(defn outcome [form]
  (try
    {:value (binding [*ns* (the-ns 'com.tailrecursion.blacktide.jvm-fixture)]
              (eval (list (list 'fn [] form))))}
    (catch Throwable error
      {:error (class (backend/root-error error))})))

(def java-map {:on 'java.util.Map :method-map {:map-compute :compute}})
(defn map-compute [_ k f] (f k :fallback))
(alter-meta! #'map-compute assoc :protocol #'java-map)