Fix eval-in-project and project/read.
This commit is contained in:
parent
760afd3e6c
commit
da3028a514
4 changed files with 52 additions and 37 deletions
|
@ -7,7 +7,7 @@
|
||||||
|
|
||||||
;; Basically just for re-throwing a more comprehensible error.
|
;; Basically just for re-throwing a more comprehensible error.
|
||||||
(defn- read-dependency-project [dep]
|
(defn- read-dependency-project [dep]
|
||||||
(let [project (.getAbsolutePath (file dep "project.clj"))]
|
(let [project (.getAbsolutePath (io/file dep "project.clj"))]
|
||||||
(try (project/read project)
|
(try (project/read project)
|
||||||
(catch Exception e
|
(catch Exception e
|
||||||
(throw (Exception. (format "Problem loading %s" project) e))))))
|
(throw (Exception. (format "Problem loading %s" project) e))))))
|
||||||
|
@ -23,7 +23,7 @@
|
||||||
(for [d (:checkout-deps-shares project [:source-path
|
(for [d (:checkout-deps-shares project [:source-path
|
||||||
:compile-path
|
:compile-path
|
||||||
:resources-path])]
|
:resources-path])]
|
||||||
(io/file "checkouts" (.getName dep) (d proj))))))
|
(str (io/file "checkouts" (.getName dep) (d proj)))))))
|
||||||
|
|
||||||
(defn resolve-dependencies
|
(defn resolve-dependencies
|
||||||
"Simply delegate regular dependencies to pomegranate. This will
|
"Simply delegate regular dependencies to pomegranate. This will
|
||||||
|
|
|
@ -6,6 +6,36 @@
|
||||||
[leiningen.core.classpath :as classpath])
|
[leiningen.core.classpath :as classpath])
|
||||||
(:import (java.io PushbackReader)))
|
(:import (java.io PushbackReader)))
|
||||||
|
|
||||||
|
;; # OS detection
|
||||||
|
|
||||||
|
(defn- get-by-pattern
|
||||||
|
"Gets a value from map m, but uses the keys as regex patterns, trying
|
||||||
|
to match against k instead of doing an exact match."
|
||||||
|
[m k]
|
||||||
|
(m (first (drop-while #(nil? (re-find (re-pattern %) k))
|
||||||
|
(keys m)))))
|
||||||
|
|
||||||
|
(def ^{:private true} native-names
|
||||||
|
{"Mac OS X" :macosx "Windows" :windows "Linux" :linux
|
||||||
|
"FreeBSD" :freebsd "OpenBSD" :openbsd
|
||||||
|
"amd64" :x86_64 "x86_64" :x86_64 "x86" :x86 "i386" :x86
|
||||||
|
"arm" :arm "SunOS" :solaris "sparc" :sparc "Darwin" :macosx})
|
||||||
|
|
||||||
|
(defn get-os
|
||||||
|
"Returns a keyword naming the host OS."
|
||||||
|
[]
|
||||||
|
(get-by-pattern native-names (System/getProperty "os.name")))
|
||||||
|
|
||||||
|
(defn get-arch
|
||||||
|
"Returns a keyword naming the host architecture"
|
||||||
|
[]
|
||||||
|
(get-by-pattern native-names (System/getProperty "os.arch")))
|
||||||
|
|
||||||
|
(defn platform-nullsink []
|
||||||
|
(io/file (if (= :windows (get-os))
|
||||||
|
"NUL"
|
||||||
|
"/dev/null")))
|
||||||
|
|
||||||
;; # Form Wrangling
|
;; # Form Wrangling
|
||||||
|
|
||||||
(defn- injected-forms
|
(defn- injected-forms
|
||||||
|
@ -14,7 +44,7 @@
|
||||||
[project]
|
[project]
|
||||||
;; TODO: expose a way to disable these
|
;; TODO: expose a way to disable these
|
||||||
(with-open [rdr (-> "robert/hooke.clj" io/resource io/reader PushbackReader.)]
|
(with-open [rdr (-> "robert/hooke.clj" io/resource io/reader PushbackReader.)]
|
||||||
`(do (ns ~'leiningen.util.injected)
|
`(do (ns ~'leiningen.core.injected)
|
||||||
~@(doall (take 6 (rest (repeatedly #(read rdr)))))
|
~@(doall (take 6 (rest (repeatedly #(read rdr)))))
|
||||||
(ns ~'user))))
|
(ns ~'user))))
|
||||||
|
|
||||||
|
@ -41,7 +71,7 @@
|
||||||
|
|
||||||
;; TODO: this needs to be totally reworked; it doesn't fit well into
|
;; TODO: this needs to be totally reworked; it doesn't fit well into
|
||||||
;; the whole leiningen-core separation.
|
;; the whole leiningen-core separation.
|
||||||
(defn prep [{:keys [compile-path checksum-deps] :as project} skip-auto-compile]
|
(defn prep [{:keys [compile-path checksum-deps] :as project}]
|
||||||
;; (when (and (not (or ;; *skip-auto-compile*
|
;; (when (and (not (or ;; *skip-auto-compile*
|
||||||
;; skip-auto-compile)) compile-path
|
;; skip-auto-compile)) compile-path
|
||||||
;; (empty? (.list (io/file compile-path))))
|
;; (empty? (.list (io/file compile-path))))
|
||||||
|
@ -56,40 +86,12 @@
|
||||||
|
|
||||||
;; # Subprocess stuff
|
;; # Subprocess stuff
|
||||||
|
|
||||||
(defn- get-by-pattern
|
|
||||||
"Gets a value from map m, but uses the keys as regex patterns, trying
|
|
||||||
to match against k instead of doing an exact match."
|
|
||||||
[m k]
|
|
||||||
(m (first (drop-while #(nil? (re-find (re-pattern %) k))
|
|
||||||
(keys m)))))
|
|
||||||
|
|
||||||
(def ^{:private true} native-names
|
|
||||||
{"Mac OS X" :macosx "Windows" :windows "Linux" :linux
|
|
||||||
"FreeBSD" :freebsd "OpenBSD" :openbsd
|
|
||||||
"amd64" :x86_64 "x86_64" :x86_64 "x86" :x86 "i386" :x86
|
|
||||||
"arm" :arm "SunOS" :solaris "sparc" :sparc "Darwin" :macosx})
|
|
||||||
|
|
||||||
(defn get-os
|
|
||||||
"Returns a keyword naming the host OS."
|
|
||||||
[]
|
|
||||||
(get-by-pattern native-names (System/getProperty "os.name")))
|
|
||||||
|
|
||||||
(defn get-arch
|
|
||||||
"Returns a keyword naming the host architecture"
|
|
||||||
[]
|
|
||||||
(get-by-pattern native-names (System/getProperty "os.arch")))
|
|
||||||
|
|
||||||
(defn native-arch-path
|
(defn native-arch-path
|
||||||
"Path to the os/arch-specific directory containing native libs."
|
"Path to the os/arch-specific directory containing native libs."
|
||||||
[project]
|
[project]
|
||||||
(when (and (get-os) (get-arch))
|
(when (and (get-os) (get-arch))
|
||||||
(io/file (:native-path project) (name (get-os)) (name (get-arch)))))
|
(io/file (:native-path project) (name (get-os)) (name (get-arch)))))
|
||||||
|
|
||||||
(defn platform-nullsink []
|
|
||||||
(io/file (if (= :windows (get-os))
|
|
||||||
"NUL"
|
|
||||||
"/dev/null")))
|
|
||||||
|
|
||||||
(defn- as-str [x]
|
(defn- as-str [x]
|
||||||
(if (instance? clojure.lang.Named x)
|
(if (instance? clojure.lang.Named x)
|
||||||
(name x)
|
(name x)
|
||||||
|
@ -160,7 +162,7 @@
|
||||||
set correctly for the project. If the form depends on any requires, put them
|
set correctly for the project. If the form depends on any requires, put them
|
||||||
in the init arg to avoid the Gilardi Scenario: http://technomancy.us/143"
|
in the init arg to avoid the Gilardi Scenario: http://technomancy.us/143"
|
||||||
([project form init]
|
([project form init]
|
||||||
(prep project skip-auto-compile)
|
(prep project)
|
||||||
;; might only make sense to stringify the form in :subprocess eval
|
;; might only make sense to stringify the form in :subprocess eval
|
||||||
(let [form-string (get-form-string project form init)]
|
(let [form-string (get-form-string project form init)]
|
||||||
;; TODO: support :eval-in :leiningen, :subprocess, or :classloader (default)
|
;; TODO: support :eval-in :leiningen, :subprocess, or :classloader (default)
|
||||||
|
|
|
@ -40,7 +40,7 @@
|
||||||
(defmacro defproject
|
(defmacro defproject
|
||||||
"The project.clj file must either def a project map or call this macro."
|
"The project.clj file must either def a project map or call this macro."
|
||||||
[project-name version & {:as args}]
|
[project-name version & {:as args}]
|
||||||
`(let [args# (apply hash-map [~@(unquote-project args)])]
|
`(let [args# ~(unquote-project args)]
|
||||||
(def ~'project
|
(def ~'project
|
||||||
(merge defaults (add-repositories args#)
|
(merge defaults (add-repositories args#)
|
||||||
{:name ~(name project-name)
|
{:name ~(name project-name)
|
||||||
|
|
|
@ -1,7 +1,8 @@
|
||||||
(ns leiningen.core.test.classpath
|
(ns leiningen.core.test.classpath
|
||||||
(:use [clojure.test]
|
(:use [clojure.test]
|
||||||
[leiningen.core.classpath])
|
[leiningen.core.classpath])
|
||||||
(:require [clojure.java.io :as io]))
|
(:require [clojure.java.io :as io]
|
||||||
|
[clojure.set :as set]))
|
||||||
|
|
||||||
(defn m2-file [f]
|
(defn m2-file [f]
|
||||||
(io/file (System/getProperty "user.home") ".m2" "repository" f))
|
(io/file (System/getProperty "user.home") ".m2" "repository" f))
|
||||||
|
@ -44,7 +45,19 @@
|
||||||
|
|
||||||
(deftest test-classpath
|
(deftest test-classpath
|
||||||
;; Can't test user plugins because anything could be installed.
|
;; Can't test user plugins because anything could be installed.
|
||||||
(with-redefs [leiningen.core.user/plugins (constantly [])]
|
(with-redefs [leiningen.core.user/plugins (constantly [])
|
||||||
|
leiningen.core.classpath/checkout-deps-paths (constantly [])]
|
||||||
(is (= classpath (get-classpath project)))))
|
(is (= classpath (get-classpath project)))))
|
||||||
|
|
||||||
(deftest test-checkout-deps)
|
(deftest test-checkout-deps
|
||||||
|
(let [d1 (io/file (:root project) "checkouts" "d1")]
|
||||||
|
(try
|
||||||
|
(.mkdirs d1)
|
||||||
|
(spit (io/file d1 "project.clj")
|
||||||
|
(pr-str '(def project {:source-path "src" :compile-path "classes"
|
||||||
|
:resources-path "resources"})))
|
||||||
|
(is (= ["checkouts/d1/src" "checkouts/d1/classes" "checkouts/d1/resources"]
|
||||||
|
(#'leiningen.core.classpath/checkout-deps-paths project)))
|
||||||
|
(finally
|
||||||
|
;; can't recur from finally
|
||||||
|
#_(dorun (map #(.delete %) (reverse (file-seq d1))))))))
|
Loading…
Reference in a new issue