Skip to content


Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
Browse files

Support for overriding :clean-targets sanity checking (issue #1458).

Also made unit tests safer and faster using with-redefs to mock out
calls to delete-file-recursively.
Better error messages when a path is being protected.
  • Loading branch information...
commit a5cf442cf3c6db0f9d0bf272942d5fb7fb90173c 1 parent d4bedc9
@cpmcdaniel cpmcdaniel authored
4 sample.project.clj
@@ -268,6 +268,10 @@
;; :baz-config {:qux-path "qux"}
;; :clean-targets below lets `lein clean` remove files under "target",
;; "classes", "foo", "bar", "qux", and "out".
+ ;; By default, will protect paths outside the project root and within standard
+ ;; lein source directories ("src", "test", "resources", "doc", "project.clj").
+ ;; However, this protection can be overridden with metadata on the :clean-targets
+ ;; vector - ^{:protect false}
:clean-targets [:target-path :compile-path :foobar-paths
[:baz-config :qux-path] "out"]
;; Paths to include on the classpath from each project in the
48 src/leiningen/clean.clj
@@ -36,31 +36,47 @@ Raise an exception if any deletion fails unless silently is true."
(defn- protected-paths
"Returns a set of leiningen project source directories and important files."
- (->> [:source-paths :java-source-paths :test-paths :resource-paths]
- (select-keys project)
- vals
- flatten
- (cons "doc")
- (cons "project.clj")
- (map io/file)
- (map #(.getCanonicalPath %))
- set))
+ (let [root-dir (:root project)]
+ (->> [:source-paths :java-source-paths :test-paths :resource-paths]
+ (select-keys project)
+ vals
+ flatten
+ (cons (io/file root-dir "doc"))
+ (cons (io/file root-dir "project.clj"))
+ (map io/file)
+ (map #(.getCanonicalPath %))
+ set)))
(defn- protected-path?
- "Is dir one of the leiningen project files or directories (which we expect to be version controlled), or a descendant?"
- [project dir]
+ "Is path one of the leiningen project files or directories (which we expect to be version controlled), or a descendant?"
+ [project path]
(let [protected-paths (protected-paths project)]
- (or (protected-paths (.getCanonicalPath (io/file dir)))
- (some #(ancestor? % dir) protected-paths))))
+ (or (protected-paths (.getCanonicalPath (io/file path)))
+ (some #(ancestor? % path) protected-paths))))
+(defn- protect-clean-targets?
+ "Returns the value of :protect in the metadata map for the :clean-targets value"
+ [project]
+ (-> project :clean-targets meta (get :protect true)))
+(defn- error-msg [pre]
+ (str pre " "
+ "Check :clean-targets or override this behavior by adding metadata -> "
+ ":clean-targets ^{:protect false} [...targets...]"))
(defn- sanity-check
"Ensure that a clean-target string refers to a directory that is sensible to delete."
[project clean-target]
- (when (string? clean-target)
+ (when (and (string? clean-target)
+ (protect-clean-targets? project))
(cond (not (ancestor? (:root project) clean-target))
- (throw (IOException. "Deleting a directory outside of the project root is not allowed."))
+ (throw (IOException.
+ (error-msg
+ (format "Deleting a path outside of the project root [\"%s\"] is not allowed." clean-target))))
(protected-path? project clean-target)
- (throw (IOException. "Deleting non-target project directories is not allowed.")))))
+ (throw (IOException.
+ (error-msg
+ (format "Deleting non-target project paths [\"%s\"] is not allowed." clean-target)))))))
(defn clean
"Remove all files from paths in project's clean-targets."
114 test/leiningen/test/clean.clj
@@ -2,9 +2,7 @@
(:use [clojure.test]
[ :only [file make-parents writer]]
[leiningen.clean :only [clean]]
- [leiningen.test.helper :only [sample-project
- delete-file-recursively]]))
+ [leiningen.test.helper :only [sample-project]]))
(def target-1 (:target-path sample-project))
(def target-2 (str (file (:root sample-project) "target-2")))
@@ -12,21 +10,36 @@
(def target-dirs (map file [target-1 target-2 target-3]))
-(defn clean-test-dirs []
- (doseq [target-dir target-dirs]
- (delete-file-recursively
- target-dir true)))
+(def delete-calls (atom '()))
+(defn mock-delete-files
+ "This implementation of delete-files-recursively will simply track the parameters passed in a state atom."
+ [& params]
+ (swap! delete-calls #(cons params %)))
+(use-fixtures :each
+ (fn [f]
+ ;; start each test with empty state.
+ (swap! delete-calls empty)
-(use-fixtures :each (fn [f]
- (doseq [target-dir target-dirs]
- (make-parents (file target-dir "foo.tmp"))
- (.createNewFile (file target-dir "foo.tmp")))
- (f)
- (clean-test-dirs)))
+ ;; The original delete-file-recursively is potentially destructive, so let's mock it.
+ (with-redefs [leiningen.clean/delete-file-recursively mock-delete-files]
+ (f))))
+(defn assert-cleaned
+ "Asserts that the mock was called for the given target path."
+ [test-path]
+ (is (some #(= test-path (first %)) @delete-calls)
+ (format "delete-files-recursively was not called for %s" test-path)))
+(defn relative-to-absolute-project-path
+ "Converts a relative path to an absolute path within the sample project"
+ [path]
+ (str (file (:root sample-project) path)))
(deftest test-default-clean-target
(clean sample-project)
- (is (not (.exists (file target-1)))))
+ (is (= target-1 (ffirst @delete-calls))))
(deftest test-explicit-clean-targets-with-keywords
(let [modified-project
@@ -34,8 +47,8 @@
:target-path-2 target-2
:clean-targets [:target-path :target-path-2])]
(clean modified-project)
- (is (not (.exists (file target-1))))
- (is (not (.exists (file target-2))))))
+ (assert-cleaned target-1)
+ (assert-cleaned target-2)))
(deftest test-explicit-clean-targets-with-vector-of-keywords
(testing "clean targets that are deeply nested in the project map"
@@ -44,28 +57,69 @@
:nest-1 {:nest-2 {:target-path-3 target-3}}
:clean-targets [[:nest-1 :nest-2 :target-path-3]])]
(clean modified-project)
- (is (not (.exists (file target-3)))))))
+ (assert-cleaned target-3))))
(deftest test-explicit-clean-targets-with-valid-string-paths
(let [modified-project
(assoc sample-project
:clean-targets [target-2 target-3])]
(clean modified-project)
- (is (not (.exists (file target-2))))
- (is (not (.exists (file target-3))))))
+ (assert-cleaned target-2)
+ (assert-cleaned target-3)))
(deftest test-explicit-clean-targets-with-invalid-string-paths
- ;; This test could potentially be destructive, so I'm using
- ;; directory paths which do not (should not) exist.
- (testing "ancestor paths of the project root and project dirs"
- (doseq [test-dir ["../../xyz" "/xyz"
- "xsrc" "xtest" "xresources"
- "doc/foo"]]
+ ;; These are non-existent paths outside the project root -
+ ;; used in case someone tries to execute them with out the
+ ;; fixture. Deleting "/" might be bad for your mental health.
+ (testing "should not delete ancestor paths of the project root"
+ (doseq [test-dir ["../../xyz" "/xyz"]]
(let [modified-project
(assoc sample-project
- :test-paths ["xtest"]
- :resource-paths ["xresources"]
- :source-paths ["xsrc"]
:clean-targets [test-dir])]
- (is (thrown?
- (clean modified-project)))))))
+ (is (thrown-with-msg? #"project root"
+ (clean modified-project))))))
+ (testing "should not delete protected project paths"
+ (doseq [path-key [:test-paths :resource-paths :source-paths :java-source-paths]]
+ (let [test-path (relative-to-absolute-project-path "test-path")
+ modified-project
+ (assoc sample-project
+ path-key [test-path]
+ :clean-targets [test-path])]
+ (is (thrown-with-msg? #"non-target"
+ (clean modified-project))))))
+ (testing "should not delete project.clj"
+ (let [modified-project
+ (assoc sample-project
+ :clean-targets [(relative-to-absolute-project-path "project.clj")])]
+ (is (thrown-with-msg? #"non-target"
+ (clean modified-project)))))
+ (testing "should not delete docs"
+ (let [modified-project
+ (assoc sample-project
+ :clean-targets [(relative-to-absolute-project-path "doc/stuff.doc")])]
+ (is (thrown-with-msg? #"non-target"
+ (clean modified-project))))))
+(deftest test-protect-metadata-override
+ ;; This will override the sanity check by adding :protect false to
+ ;; the metadata for :clean-targets. Again, this could be destructive
+ ;; so I'm using a non-existent protected directory. The result will
+ ;; be that our mock delete-file-recursively will get called, and
+ ;; no exceptions should be thrown.
+ (testing "override protected path sanity checking"
+ (doseq [test-dir
+ (concat ["../../xyz" "/xyz"]
+ (map relative-to-absolute-project-path
+ ["xsrc" "xtest" "xresources"
+ "doc/foo" "project.clj"]))]
+ (let [modified-project
+ (assoc sample-project
+ :test-paths [(relative-to-absolute-project-path "xtest")]
+ :resource-paths [(relative-to-absolute-project-path "xresources")]
+ :source-paths [(relative-to-absolute-project-path "xsrc")]
+ :clean-targets ^{:protect false} [test-dir])]
+ (clean modified-project)
+ (assert-cleaned test-dir)))))
Please sign in to comment.
Something went wrong with that request. Please try again.