Make read-namespace handle read conditionals gracefully (#145)

Fixes #142

CHANGELOG.md

@@ -11,6 +11,10 @@
   * added `orchard.xref/fn-deps-class` as a lower level API so you can still get the main functions deps only
   * added `orchard.xref/fn-transitive-deps`
 
+### Bugs fixed
+
+* [142](https://github.com/clojure-emacs/orchard/issues/142): Make read-namespace handle read conditionals gracefully
+
 ## 0.8.0 (2021-12-15)
 
 ### Changes

src/orchard/namespace.clj

@@ -6,7 +6,6 @@
   {:author "Jeff Valk"
    :added "0.5"}
   (:require
-   [clojure.edn :as edn]
    [clojure.java.io :as io]
    [clojure.string :as str]
    [orchard.java.classpath :as cp]
@@ -20,13 +19,21 @@
 (defn read-namespace
   "Returns the namespace name from the first top-level `ns` form in the file."
   [url]
-  (try
-    (with-open [r (PushbackReader. (io/reader url))]
-      (->> (repeatedly #(edn/read r))
-           (filter #(and (list? %) (= (first %) 'ns))) ; ns form
-           (map second)                                ; ns name
-           (first)))
-    (catch Exception _)))
+  (with-open [r (PushbackReader. (io/reader url))]
+    (loop []
+      (let [found (try
+                    (binding [*read-eval* false]
+                      (read {:read-cond :allow
+                             :eof ::eof}
+                            r))
+                    (catch Exception _
+                      ::fail))]
+        (cond
+          (#{::eof ::fail} found) nil
+          (and (list? found)
+               (-> found first #{`ns 'ns}))
+          (second found)
+          :else (recur))))))
 
 (defn canonical-source
   "Returns the URL of the source file for the namespace object or symbol,

test/orchard/namespace_test.clj

@@ -4,18 +4,18 @@
    [clojure.string :as str]
    [clojure.test :refer [deftest is testing]]
    [orchard.misc :as misc]
-   [orchard.namespace :as n]))
+   [orchard.namespace :as sut]))
 
 (deftest project-namespaces-test
-  (is (contains? (into #{} (n/project-namespaces))
+  (is (contains? (into #{} (sut/project-namespaces))
                  'orchard.namespace)))
 
 (deftest loaded-namespaces-test
   ;; If we don't pass the second arg, some cider ns will be returned
-  (is (some #(re-find #".*orchard" %) (n/loaded-namespaces)))
+  (is (some #(re-find #".*orchard" %) (sut/loaded-namespaces)))
   ;; Shouldn't return any orchard namespaces
   (is (not-any? #(re-find #".*orchard" %)
-                (n/loaded-namespaces [".*orchard"]))))
+                (sut/loaded-namespaces [".*orchard"]))))
 
 (defn- change-case
   "Utility fn to change the case of a URL path, to help with case sensitivity
@@ -28,43 +28,48 @@
      (if (= string lower) upper lower))))
 
 (deftest project-nses-ignore-case-on-windows-test
-  (let [orig-project-root n/project-root]
+  (let [orig-project-root sut/project-root]
     (testing "Project nses is case sensitive on non Windows oses"
       (with-redefs [misc/os-windows? (constantly false)
-                    n/project-root   (change-case orig-project-root)]
-        (is (not (seq (n/project-namespaces))))))
+                    sut/project-root   (change-case orig-project-root)]
+        (is (not (seq (sut/project-namespaces))))))
     (testing "Project nses ignore cases on Windows oses"
       (with-redefs [misc/os-windows? (constantly true)
-                    n/project-root   (change-case orig-project-root)]
-        (is (seq (n/project-namespaces)))))))
+                    sut/project-root   (change-case orig-project-root)]
+        (is (seq (sut/project-namespaces)))))))
 
 (deftest has-tests-errors
-  (is (n/has-tests? (find-ns 'orchard.namespace-test))))
+  (is (sut/has-tests? (find-ns 'orchard.namespace-test))))
 
-(deftest namespace-parsing
+(deftest read-namespace-test
   (testing "Namespace parsing"
     (let [url (-> (System/getProperty "java.io.tmpdir")
                   (io/file "orchard.namespace-test.txt")
                   (io/as-url))
           uri (.toURI url)]
       (testing "of an empty file"
         (spit url "")
-        (is (nil? (n/read-namespace uri))))
+        (is (nil? (sut/read-namespace uri))))
       (testing "of an unparsable file"
         (spit url "(]$@(")
-        (is (nil? (n/read-namespace uri))))
+        (is (nil? (sut/read-namespace uri))))
       (testing "of non-list tokens"
         (spit url "these are (still) tokens")
-        (is (nil? (n/read-namespace uri))))
+        (is (nil? (sut/read-namespace uri))))
       (testing "when tokens precede the ns form"
         (spit url "there [is a] (ns here) after all")
-        (is (= (n/read-namespace uri) 'here)))
+        (is (= 'here (sut/read-namespace uri))))
       (testing "when multiple ns forms are present"
         (spit url "(ns ns1) (ns ns2) (ns ns3)")
-        (is (= (n/read-namespace uri) 'ns1)))
+        (is (= 'ns1 (sut/read-namespace uri))))
       (testing "of top-level forms only"
         (spit url "(comment (ns ns1)) (ns ns2) (ns ns3)")
-        (is (= (n/read-namespace uri) 'ns2)))
+        (is (= 'ns2 (sut/read-namespace uri))))
+      (testing "of namespace with read conditionals in its `ns` form"
+        (is (= 'orchard.test-ns (-> "orchard/test_ns.cljc"
+                                    io/resource
+                                    io/as-url
+                                    sut/read-namespace))))
       (io/delete-file url))))
 
 (deftest namespace-resolution
@@ -76,8 +81,8 @@
                  orchard.namespace
                  orchard.cljs.test-canonical-source]]
       (testing "namespace symbols to source files"
-        (is (every? identity (map n/canonical-source nses))))
+        (is (every? identity (map sut/canonical-source nses))))
       (testing "source files to namespace symbols"
-        (is (= nses (map (comp n/read-namespace    ; src -> ns
-                               n/canonical-source) ; ns -> src
+        (is (= nses (map (comp sut/read-namespace    ; src -> ns
+                               sut/canonical-source) ; ns -> src
                          nses)))))))