More bug fixes after #70 and #73

- When determining whether two classloaders are compatible?, also check for java class names, not just clj namespaces. This identifies JarHell as a major source of compile errors and non-determinism
- gen_build: Make clojure_library targets depend on clojure.core.specs.alpha rather than clojure.core. This fixes a bug where clojure.core.specs.alpha gets compiled into user jars, causing false positives in compatibility checks.
- minor comments and code golfing

Author: arohner

src/rules_clojure/compile.clj

@@ -1,11 +1,10 @@
 (ns rules-clojure.compile
-  (:refer-clojure :exclude [agent send await])
   (:require [clojure.java.io :as io]
             [clojure.string :as str]
             [rules-clojure.java.classpath :as cp]
             [rules-clojure.namespace.parse :as parse]
             [rules-clojure.fs :as fs]
-            [rules-clojure.util :refer [shasum]])
+            [rules-clojure.util :refer [shasum debug]])
   (:import [java.util.concurrent CompletableFuture]))
 
 (set! *warn-on-reflection* true)
@@ -15,9 +14,6 @@
 ;; dependencies. If we require a new clojure version, that requires
 ;; all users to upgrade so try to do that sparingly as well.
 
-(defn debug [& args]
-  #_ (println (locking true (apply print-str args))))
-
 (defn deref!
   "throw `ex` if *f does not complete within timeout"
   [*f timeout ex]
@@ -30,23 +26,25 @@
 (defn src-resource-name [ns]
   (.substring ^String (#'clojure.core/root-resource ns) 1))
 
+(defn resource
+  [path]
+  (assert (instance? ClassLoader (.getContextClassLoader (Thread/currentThread))))
+  (assert (= (.getContextClassLoader (Thread/currentThread))
+             (.getClassLoader (class resource)))
+          (print-str "context classloader:" (.getContextClassLoader (Thread/currentThread))
+                     "#'resource loader:" (.getClassLoader (class resource))))
+  (io/resource path))
+
 (defn src-resource
   "given a namespace symbol, return a tuple of [filename URL] where the
   backing .clj is located, or nil if it couldn't be found"
   [ns]
   {:pre [(symbol? ns)]}
   (->> [".clj" ".cljc"]
-       (map (fn [ext]
+       (some (fn [ext]
               (let [src-path (str (src-resource-name ns) ext)
-                    src-resource (io/resource src-path)]
-                (when src-resource
-                  [src-path src-resource]))))
-       (filter identity)
-         ;; ((fn [srcs]
-         ;;    (when (> (count srcs) 1)
-         ;;      (println "WARNING multiple copies of" ns "found:" srcs))
-         ;;    srcs))
-       (first)))
+                    src-resource (resource src-path)]
+                src-resource)))))
 
 (defn loaded? [ns]
   {:pre [(symbol? ns)]}
@@ -62,6 +60,13 @@
 
   (contains? (loaded-libs) ns))
 
+(defn loaded?-str [ns]
+  {:pre [(string? ns)]
+   :post [(boolean? %)]}
+  ;; called from the worker's class loader, so we can't pass a
+  ;; `symbol` through
+  (loaded? (symbol ns)))
+
 ;; we can be asked to AOT a namespace after it is already loaded. If
 ;; the namespace contains protocols AND it's already loaded, that
 ;; would break all downstream users of the protocol. Also, we want to
@@ -84,21 +89,24 @@
 ;; the class files from temp directory. We fingerprint namespaces
 ;; using the SHA of the file contents
 
-
-
-(defn ns->resource-name
-  "given a namespace symbol, return the name of the resource where it can
-be found"
+(defn ns->class-resource-name
+  "given a namespace symbol, return the name of classfile that will load it"
   [ns]
   (-> ns
       (munge)
       (str/replace #"\." "/")
       (str "__init.class")))
 
 (defn compiled?
-  "truthy if the namespace has AOT .class files on the classpath"
   [ns]
-  (io/resource (ns->resource-name ns)))
+  ;; We could use Class/forName, but that would attempt to load the
+  ;; class. Use resource instead to avoid the side effect
+  (resource (ns->class-resource-name ns)))
+
+(defn add-classpath! [dir]
+  (let [dir-f (fs/path->file dir)]
+    (assert (.exists dir-f) (print-str dir-f "not found"))
+    (.addURL (.getClassLoader (class add-classpath!)) (.toURL dir-f))))
 
 ;; root directory for all compiles. Each compile will be a subdir of
 ;; this
@@ -111,10 +119,10 @@ be found"
   "return the hash of the ns file contents"
   [ns]
   {:pre [(symbol? ns)]}
-  (assert (src-resource ns) (print-str "couldn't find src resource for" ns))
+  (let [cl (.getContextClassLoader (Thread/currentThread))]
+    (assert (src-resource ns) (print-str "couldn't find src resource" (src-resource ns) " for" ns "with context classloader" cl (cp/classpath cl))))
   (-> ns
       (src-resource)
-      second
       (io/input-stream)
       (.readAllBytes)
       (shasum)))
@@ -193,14 +201,12 @@ be found"
       java.io.PushbackReader.))
 
 (defn ns-deps- [ns]
-  (assert (src-resource ns) (print-str "couldn't find resource for" ns))
-  (-> ns
-      src-resource
-      second
-      reader
-      parse/read-ns-decl
-      parse/deps-from-ns-decl
-      (disj ns)))
+  (some-> ns
+          src-resource
+          reader
+          parse/read-ns-decl
+          parse/deps-from-ns-decl
+          (disj ns)))
 
 (def ns-deps (memoize ns-deps-))
 
@@ -217,6 +223,7 @@ be found"
                  :bound-require? (bound? #'clojure.core/require)
                  :sha sha))
         (assert (not (loaded? ns)) (print-str ns :compiled? (compiled? ns) :loaded? (loaded? ns) :sha sha))
+        (add-classpath! classes-dir)
         (binding [*compile-path* (str classes-dir)]
           (compile ns)
           (assert (seq (fs/ls-r classes-dir)) (print-str "compile-: no .class files found in" classes-dir)))))))
@@ -251,17 +258,17 @@ be found"
 (defn context-classloader-conveyor-fn [f]
   ;; context classloaders are not conveyed by default in futures, but we set it in rules-clojure.jar/compile!
   (let [cl (.getContextClassLoader (Thread/currentThread))]
-    (fn
-      ([]
-       (.setContextClassLoader (Thread/currentThread) cl)
-       (f)))))
+    (fn []
+      (.setContextClassLoader (Thread/currentThread) cl)
+      (f))))
 
 (defn binding-conveyor-fn [f]
-  ;; don't use clojure.core/binding-conveyor-fn, because that usees
-  ;; clone/reset ThreadBindings, rather than push/pop. We use push and
-  ;; pop because clone shares TBoxes, which store the threadId they
-  ;; came from, which breaks clojure.lang.Compiler when an in-progress
-  ;; compile attempts to Var/set! from a new thread
+  ;; don't use clojure.core/binding-conveyor-fn, because that uses
+  ;; clone/reset ThreadBindings; It allows the conveyed thread to read
+  ;; bindings, but not set! them (because it clones TBoxes and the
+  ;; cloned tbox stores the thread.id), which breaks
+  ;; clojure.lang.Compiler.  Instead, use push/pop ThreadBindings
+  ;; which creates new tboxes and allows set! to work.
   (let [bindings (clojure.lang.Var/getThreadBindings)]
     (fn []
       (try
@@ -292,7 +299,6 @@ be found"
   [ns f]
   {:pre [(symbol? ns)]
    :post [(future? %)]}
-  (debug "ns-send-sync" ns)
   (-> ns-futures
       (swap! update ns (fn [**f]
                          (or **f
@@ -412,7 +418,7 @@ be found"
                 (debug "WARNING no ns found for" p)) true)]}
   (->> [".clj" ".cljc"]
        (keep (fn [ext]
-               (io/resource (load-path (str p ext)))))
+               (resource (load-path (str p ext)))))
        (keep (fn [r]
               (with-open [rdr (java.io.PushbackReader. (io/reader r))]
                 (let [ns (parse/name-from-ns-decl (parse/read-ns-decl rdr))]
@@ -421,13 +427,11 @@ be found"
 
 (defn spy-load [& paths]
   (let [ns-sym (symbol (str *ns*))]
-    (debug "spy-load"  paths)
     (->> paths
          (mapv (fn [p]
                  (if-let [dep-ns (load->ns p)]
                    @(pcompile ns-sym dep-ns)
-                   (real-load p)))))
-    (debug "spy-load" ns-sym paths "done")))
+                   (real-load p)))))))
 
 (defn spy-require [& args]
   ;; the ns block will add `ns` to clojure.core/*loaded-libs*, so it won't be eval'd twice.
@@ -441,7 +445,6 @@ be found"
 
 (defn spy-load-one
   [lib need-ns require]
-  (debug "spy-load-one" lib)
   (spy-load (root-resource lib))
   (throw-if (and need-ns (not (find-ns lib)))
             "namespace '%s' not found after loading '%s'"
@@ -453,7 +456,6 @@ be found"
 ;; we need this because dtype-next calls load-lib directly rather than `load` or `require` ಠ_ಠ
 (defn spy-load-lib
   [prefix lib & options]
-  (debug "spy-load-lib" lib)
   (throw-if (and prefix (pos? (.indexOf (name lib) (int \.))))
             "Found lib name '%s' containing period with prefix '%s'.  lib names inside prefix lists must not contain periods"
             (name lib) prefix)
@@ -474,10 +476,8 @@ be found"
     (binding [clojure.core/*loading-verbosely* (or @#'clojure.core/*loading-verbosely* verbose)]
       (if load
         (try
-          (debug "spy-load-lib actually loading" load lib)
           (load lib need-ns require)
           (catch Exception e
-            (debug "spy-load-lib while loading" lib e)
             (when undefined-on-entry
               (remove-ns lib))
             (throw e)))
@@ -528,9 +528,9 @@ be found"
 (defn compile! [classes-dir aot-nses out]
   {:pre [(string? classes-dir)
          (every? string? aot-nses)]}
+  ;; make sure this is loaded before any compile so it doesn't end up in user jars
+  @(pcompile nil 'clojure.core.specs.alpha)
   (binding [*out* out]
-    (when (seq aot-nses)
-      (debug "compile!" (seq aot-nses)))
     (with-spy
       (let [aot-nses (map symbol aot-nses)]
         (doseq [n aot-nses]

src/rules_clojure/gen_build.clj

@@ -258,7 +258,7 @@
         class-file (str (.substring ^String root-resource  1) "__init.class")]
     (some #(= class-file %) (classpath-files path))))
 
-(def special-namespaces '#{clojure.core.specs.alpha})
+(def special-namespaces '#{})
 
 (defn should-compile-namespace? [deps-bazel path ns]
   (and (not (contains? special-namespaces ns))

src/rules_clojure/jar.clj

@@ -67,7 +67,8 @@
     (try
       (util/shim-invoke cl "rules-clojure.compile" "compile!" classes-dir aot-arr *out*)
       (catch Throwable t
-        (throw (ex-info "while compiling" {:args args} t))))))
+        (throw (ex-info "while compiling" {:args args
+                                           :classloader cl} t))))))
 
 (defn create-jar [{:keys [src-dir classes-dir output-jar resources aot-nses] :as args}]
   (s/assert ::compile args)

src/rules_clojure/namespace/find.clj

@@ -99,9 +99,7 @@
   both defined in clojure.tools.namespace.find."
   {:added "0.3.0"}
   [^JarFile jar-file platform]
-  {:pre [(do (when-not (jarfile? jar-file)
-               (println "filenames-in-jar:" jar-file (class jar-file))) true)
-         (jarfile? jar-file) platform]}
+  {:pre [(jarfile? jar-file) platform]}
   (let [{:keys [extensions]} platform]
     (->> jar-file
          (.entries)

src/rules_clojure/persistentClassLoader.clj

@@ -57,7 +57,6 @@
 (set! *warn-on-reflection* true)
 
 (defn clojure-find-class [this name]
-  {:post [(do (util/print-err "found class in-mem" %) true)]}
   (when-let [rt-class ^Class (.parentFindClass this "clojure.lang.RT")]
     (let [baseloader-method (.getDeclaredMethod rt-class "baseLoader" (into-array Class []))
           loader (.invoke baseloader-method rt-class (into-array Object []))]
@@ -68,5 +67,5 @@
   [this name]
   (locking this
     (or
-    (.parentFindClass this name)
-    (clojure-find-class this name))))
+     (.parentFindClass this name)
+     (clojure-find-class this name))))