(ns com.tailrecursion.blacktide.jvm-test
"Native Clojure is the dispatch oracle; event traces test receivers, pending
operands and assignment effects that result-only comparisons cannot observe."
(: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.jvm-fixture :refer [chooser text primitive outcome]]
[com.tailrecursion.blacktide :refer [loophole setq psetq label goto]])
(:import [com.tailrecursion.blacktide.jvm_fixture Choice]))
(def ^:dynamic *value* :root)
(defmacro .answer [] 42)
(defmacro constructed. [] 43)
(defmacro inferred-tag [sym] (list 'quote (:tag (get &env sym))))
(deftest overloads-preserve-source-types
(doseq [expr '[1 1.5 1N 1M 1/2 "x" nil false \a
(int 1) (long 1) (double 1) (char-array [\a])
(String. "x") (.substring "xyz" 1) (instance? String "x")
(identity "x") (identity nil) (inc 1) (+ 1 2)
(if true nil "x") (if true "x" nil) (if true 1 nil)
(if true nil 1) (if true 1 2.0) (if true (int 1) (int 2))
(let [a "x"] a) (text) (primitive) Integer/MAX_VALUE
(.-x (java.awt.Point. 1 2)) (String/valueOf 1) (do nil "x") ^Object (if true 1 2) ^Object (let [x 1] x)]
wrap [identity #(list 'if true % %)
#(list 'let ['value %] '(if true nil nil) 'value)]]
(let [arg (wrap expr) form (list '.choose (with-meta 'chooser {:tag 'Choice}) arg)]
(is (= (outcome form) (outcome (list 'loophole [] form))) (pr-str arg)))))
(deftest host-syntax-and-typing
(is (= 3 (loophole [] (. "abc" (length)))))
(is (= 4 (loophole [] (.length (StringBuilder. "abcd"))))))
(deftest source-tags-follow-native-metadata-rules
(doseq [tag [Object String Long/TYPE :ignored 42 false]
form [(list 'let [(with-meta 'x {:tag tag}) 1] 'x)
(list 'let ['x 1] (with-meta 'x {:tag tag}))
(list '.choose (with-meta 'chooser {:tag 'Choice}) (with-meta '(identity "x") {:tag tag}))
(list '.choose (with-meta 'chooser {:tag 'Choice}) (with-meta '(.length "x") {:tag tag}))]]
(is (= (outcome form) (outcome (list 'loophole [] form))) (pr-str [tag form])))
(is (= :string (loophole [] (.choose ^Choice chooser (^String identity "x")))))
(is (= :string (loophole [] (loop [] (.choose ^Choice chooser (text))))))
(doseq [tag ["String" "java.lang.String"]]
(let [form (list 'let [(with-meta 'x {:tag tag}) '(identity "word")] '(.length x))]
(is (= {:value 4} (outcome form) (outcome (list 'loophole [] form))))))
(let [form (list (with-meta 'Math/abs {:param-tags [Integer/TYPE]}) -2)]
(is (= {:value 2} (outcome form) (outcome (list 'loophole [] form))))))
(deftest caller-facts-and-qualified-operations
(is (= 42 (loophole [] (.answer))))
(is (= 43 (loophole [] (constructed.))))
(is (= "java.lang.String" (loophole [] (.getName String))))
(let [values (java.util.ArrayList. [10 20 30]) index (int 1)]
(is (= [20 [10 30]] (loophole [] [(.remove values index) (vec values)]))))
(is (= 2 (loophole [x 0] (String/.length (String/new (do (setq x 1) "ab"))))))
(is (= 7 (loophole [] (^{:param-tags [String]} Integer/parseInt "7"))))
(is (= "7" (loophole [] (^{:param-tags [Object]} String/valueOf 7))))
(is (= "ab" (loophole [] (^{:param-tags [String]} String/new "ab"))))
(is (= 3 (loophole [] (let [length String/.length] (length "abc")))))
(is (= "13" (loophole [] (let [convert ^{:param-tags [Object]} String/valueOf] (convert 13)))))
(is (= Integer/MAX_VALUE (loophole [] (Integer/MAX_VALUE))))
(is (= "3" (loophole [String nil] (. String valueOf 3))))
(is (= (outcome '(let [nil-value nil] (.choose ^Choice chooser nil-value)))
(outcome '(let [nil-value nil] (loophole [] (.choose ^Choice chooser nil-value)))))))
(deftest binding-hints-and-macro-environments
(is (= 'java.lang.String (loophole [] (let [s (text)] (inferred-tag s)))))
(is (= [true false]
(loophole []
(let [^java.util.function.Predicate predicate odd?]
(if true nil nil)
[(.test predicate 1) (.test predicate 2)]))))
(doseq [form '[(let [^Object value 1] value)
(let [value 1] ^double value)
(let [^Object value (primitive)] value)
(.choose ^Choice chooser ^double (.length "abc"))
(let [value ^double (.length "abc")] (.choose ^Choice chooser value))]]
(is (= (outcome form) (outcome (list 'loophole [] form))) (pr-str form))))
(deftest inline-expansion-and-arithmetic
(is (= 30 (loophole [x 0] (+ (do (setq x 10) x) (do (setq x 20) x)))))
(is (= [1 2] (loophole [+ vector] (+ 1 2))))
(doseq [unchecked [false true :warn-on-boxed]
[boxed? form] '[[false (+ Long/MAX_VALUE 1)] [false (inc Long/MAX_VALUE)]
[false (* Long/MAX_VALUE 2)] [false (int Long/MAX_VALUE)]
[false (let [x 4] (+ x (if true 2 3)))]
[true (let [x (identity Long/MAX_VALUE)] (+ x 1))]]]
(let [warnings (java.io.StringWriter.)]
(binding [*unchecked-math* unchecked *err* warnings]
(is (= (outcome form) (outcome (list 'loophole [] form))) (pr-str [unchecked form])))
;; Only the deliberately Object-typed addition warns, once per compiler.
(is (= (if (and boxed? (= :warn-on-boxed unchecked)) 2 0)
(count (re-seq #"Boxed math warning" (str warnings)))) (pr-str [unchecked form])))))
(defn numeric-expression [depth locals]
(let [leaf (gen/elements (into [-13 -1 0 1 7 2.5 1/2] locals))]
(if (zero? depth) leaf
(let [child (numeric-expression (dec depth) locals)]
(gen/one-of
[leaf
(gen/let [a child b child] (list '+ a b))
(gen/let [test child a child b child] (list 'if (list 'neg? test) a b))
(gen/let [name (gen/elements '[x y]) init child
body (numeric-expression (dec depth) (conj locals name))]
(list 'let [name init] body))
(gen/fmap #(list '.length (list 'StringBuilder. (list 'str %))) child)
(gen/let [a child b child] (list 'Math/max (list 'double a) (list 'double b)))
(gen/let [a child b child] (list 'aget (list 'long-array [a b]) (list 'int 1)))
(gen/fmap #(list 'alength (list 'char-array (list 'str %))) child)
(gen/let [a child b child] (list 'do a b))])))))
(defspec generated-host-and-inline-expressions {:num-tests 180 :seed 112358}
(prop/for-all [form (numeric-expression 3 [])]
(let [expected (outcome form)]
(every? true?
(for [variant [form (list 'do form) (list 'let ['unused nil] form)]]
(= expected (outcome (list 'loophole [] variant))))))))
(defn failure-trace [form]
(binding [*ns* (the-ns 'com.tailrecursion.blacktide.jvm-test)]
(eval (list 'let ['events '(atom [])]
(list 'try form
'(catch Throwable error [(class error) @events]))))))
(deftest conversions-happen-before-later-operands
(doseq [form '[(0 (do (swap! events conj :argument) 1))
(String/.substring (do (swap! events conj :receiver) 7)
(do (swap! events conj :argument) 1))
(^{:param-tags [long long]} Math/max
(do (swap! events conj :first) nil)
(do (swap! events conj :second) 1))
(String. ^bytes (do (swap! events conj :first) "wrong")
(do (swap! events conj :second) (java.nio.charset.Charset/defaultCharset)))
]]
(is (= (failure-trace form) (failure-trace (list 'loophole [] form))) (pr-str form))))
(defn direct-fixed [x] [:fixed x])
(defn direct-rest [x & xs] [x (vec xs)])
(defn direct-primitive ^long [^long x] (inc x))
(defn ^:redef redefinable [x] [:original x])
(def ^:dynamic *direct-dynamic* identity)
(deftest direct-linking-and-redefinitions
(doseq [direct? [false true]
form '[(direct-fixed 1) (direct-rest 1) (direct-rest 1 2 3)
(direct-primitive 4) (redefinable 5) (*direct-dynamic* 6)]]
(let [[native rewritten]
(binding [*ns* (the-ns 'com.tailrecursion.blacktide.jvm-test)
*compiler-options* {:direct-linking direct?}]
[(eval (list 'fn [] form)) (eval (list 'fn [] (list 'loophole [] form)))])]
(with-redefs [direct-fixed (constantly :changed)
direct-rest (constantly :changed)
direct-primitive (fn ^long [^long _] 99)
redefinable (constantly :changed)
*direct-dynamic* (constantly :changed)]
(is (= (native) (rewritten)) (pr-str [direct? form]))))))
(definterface BoxChoice
(boxChoice [^Integer x ^String y]) (boxChoice [^Long x ^String y]))
(def box-chooser
(reify BoxChoice
(boxChoice [_ ^Integer x ^String y] :integer)
(boxChoice [_ ^Long x ^String y] :long)))
(defmacro integer-constant [] (Integer/valueOf 1000))
(deftest reflective-calls-preserve-boxed-operands
(is (= :integer
(.boxChoice ^BoxChoice box-chooser (integer-constant) (identity "s"))
(loophole [] (.boxChoice ^BoxChoice box-chooser (integer-constant) (identity "s"))))))
(def ^:const constant-number 7)
(defmacro var-inline [value] (list #'inc value))
(defmacro var-macro [value] (list #'when true value))
(defmacro var-marker [value] (list #'setq 'x value))
(deftest constant-vars-and-var-operators
(is (= :long (loophole [] (.choose ^Choice chooser constant-number))))
(is (= 8 (loophole [] (var-inline constant-number))))
(is (= :body (loophole [] (var-macro :body))))
(is (= 9 (loophole [x 0] (var-marker 9) x)))
(is (= [2 [3 4] [1 2 3 4]]
(loophole [] (let [[_ a & more :as all] [1 2 3 4]] [a more all]))))
(is (= [1 9]
(loophole [x 0] (let [{:keys [a] :or {a (setq x 9)}} {:a 1}] [a x])))))
(deftest overlapping-field-and-method-names
(doseq [form '[com.tailrecursion.blacktide.fixtures.HostFixture/clash
(com.tailrecursion.blacktide.fixtures.HostFixture/clash)
(com.tailrecursion.blacktide.fixtures.HostFixture/clash "x")
(.choose ^Choice chooser com.tailrecursion.blacktide.fixtures.HostFixture/clash)
(com.tailrecursion.blacktide.fixtures.HostFixture/argumentOnly "x")
(.choose ^Choice chooser com.tailrecursion.blacktide.fixtures.HostFixture/argumentOnly)
^{:param-tags []} com.tailrecursion.blacktide.fixtures.HostFixture/fieldOnly]]
(is (= (outcome form) (outcome (list 'loophole [] form))) (pr-str form))))
(deftest unreachable-source-still-receives-native-validation
(doseq [form '[(Math/abs 1 2 3) Math/MISSING (String. 1 2 3 4 5)]
wrap [identity #(list 'do %)]]
(let [body (wrap form)
expected (outcome body)
actual (outcome (list 'loophole [] '(goto done) body '(label done)))]
(is (:error expected) (pr-str {:form body :native expected}))
(is (= (:error expected) (:error actual)) (pr-str {:form body :native expected :actual actual}))))
;; Instance reflection reports a missing overload only when executed.
(is (nil? (loophole [] (goto done) (.substring "abc" 1 2 3) (label done))))
(let [events (atom [])]
(is (nil? (loophole [] (goto done)
(swap! events conj :expression)
(identity (swap! events conj :after)) (label done))))
(is (empty? @events))))