Fix eval-in-project and project/read.

This commit is contained in:
Phil Hagelberg 2011-11-22 13:47:52 -08:00
parent 760afd3e6c
commit da3028a514
4 changed files with 52 additions and 37 deletions

View file

@ -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

View file

@ -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)

View file

@ -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)

View file

@ -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))))))))