diff --git a/CHANGELOG.md b/CHANGELOG.md index c4b24591..14018e1f 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -9,6 +9,7 @@ A preview of the next release can be installed from - Fix [#1401](https://github.com/babashka/babashka/issues/1401): mutation of `deftype` field should be visible in protocol method - Fix [#1405](https://github.com/babashka/babashka/issues/1405): drop name metadata from conditionally defined var +- [#602](https://github.com/babashka/babashka/issues/602): add lib tests for clj-commons/fs ([@bobisageek](https://github.com/bobisageek)) ## 1.0.164 (2022-10-17) diff --git a/deps.edn b/deps.edn index 8cc78c93..54e38584 100644 --- a/deps.edn +++ b/deps.edn @@ -156,7 +156,9 @@ :git/sha "ca115fe00a0abf3a2f78452ab309c3aa4c00fc4e" :deps/manifest :deps} lambdaisland/uri {:git/url "https://github.com/lambdaisland/uri" - :git/sha "ac4f1f9c8e4f45a088db1c6383ce2191c973987c"}} + :git/sha "ac4f1f9c8e4f45a088db1c6383ce2191c973987c" + :deps/manifest :deps} + clj-commons/fs {:mvn/version "1.6.310"}} :classpath-overrides {org.clojure/clojure nil org.clojure/spec.alpha nil}} :clj-nvd diff --git a/doc/libraries.csv b/doc/libraries.csv index b6d89c55..f6b5e674 100644 --- a/doc/libraries.csv +++ b/doc/libraries.csv @@ -11,6 +11,7 @@ camel-snake-kebab/camel-snake-kebab,https://github.com/clj-commons/camel-snake-k circleci/bond,https://github.com/circleci/bond cli-matic/cli-matic,https://github.com/l3nz/cli-matic.git clj-commons/clj-yaml,https://github.com/clj-commons/clj-yaml +clj-commons/fs,https://github.com/clj-commons/fs clj-commons/multigrep,https://github.com/clj-commons/multigrep clj-stacktrace/clj-stacktrace,https://github.com/mmcgrana/clj-stacktrace clojure-csv/clojure-csv,https://github.com/davidsantiago/clojure-csv diff --git a/test-resources/lib_tests/bb-tested-libs.edn b/test-resources/lib_tests/bb-tested-libs.edn index 90b5c914..c852169f 100644 --- a/test-resources/lib_tests/bb-tested-libs.edn +++ b/test-resources/lib_tests/bb-tested-libs.edn @@ -167,4 +167,5 @@ :git-sha "ca115fe00a0abf3a2f78452ab309c3aa4c00fc4e" :test-paths ["test"] :test-namespaces [exoscale.interceptor-test]} + clj-commons/fs {:git-url "https://github.com/clj-commons/fs", :test-namespaces (me.raynes.core-test), :git-sha "60026817c44015da8656925411d4af1d8210bad0"} } diff --git a/test-resources/lib_tests/me/raynes/core_test.clj b/test-resources/lib_tests/me/raynes/core_test.clj new file mode 100644 index 00000000..9effc484 --- /dev/null +++ b/test-resources/lib_tests/me/raynes/core_test.clj @@ -0,0 +1,467 @@ +(ns me.raynes.core-test + (:refer-clojure :exclude [name parents]) + (:require [me.raynes.fs :refer :all] + ;; BB-TEST-PATCH: remove compression ns (requires unavailable classes from apache commons) + #_[me.raynes.fs.compression :refer :all] + ;; BB-TEST-PATCH: remove midje (needs currently unavailable classes) and add mock midje ns + #_[midje.sweet :refer :all] + [me.raynes.mock-midje :refer [fact]] + [clojure.java.io :as io] + [clojure.string :as string]) + (:import java.io.File)) + +(def system-tempdir (System/getProperty "java.io.tmpdir")) + +(def fs-supports-symlinks? (not (.startsWith (System/getProperty "os.name") "Windows"))) + +(defn create-walk-dir [] + (let [root (temp-dir "fs-")] + (mkdir (file root "a")) + (mkdir (file root "b")) + (spit (file root "1") "1") + (spit (file root "a" "2") "1") + (spit (file root "b" "3") "1") + root)) + +(fact "Makes paths absolute." + (file ".") => *cwd* + (file "foo") => (io/file *cwd* "foo")) + + +(fact "Expands path to current user." + (let [user (System/getProperty "user.home")] + (expand-home "~") => (file user) + (expand-home (str "~" File/separator "foo")) => (file user "foo"))) + +(fact "Expands to given user." + (let [user (System/getProperty "user.home") + name (System/getProperty "user.name")] + (expand-home (str "~" name)) => (file user) + (expand-home (format "~%s/foo" name)) => (file user "foo"))) + +(fact "Expand a path w/o tilde just returns path" + (let [user (System/getProperty "user.home")] + (expand-home (str user File/separator "foo")) => (io/file user "foo"))) + +;; BB-TEST-PATCH: commented tests use midje functionality that isn't currently converted and/or +;; the compression ns + +;; BB-TEST-PATCH: made binding to adapt paths to bb folder structure +(def libtest-files-path "test-resources/lib_tests/me/raynes/testfiles") + +;(fact (list-dir ".") => (has every? #(instance? File %))) +; +;;; Want to change these files to be tempfiles at some point. +;(when unix-root (against-background +; [(around :contents (let [f (io/file "test/me/raynes/testfiles/bar")] +; (.setExecutable f false) +; (.setReadable f false) +; (.setWritable f false) +; ?form +; (.setExecutable f true) +; (.setReadable f true) +; (.setWritable f true)))] +; (fact +; (executable? "test/me/raynes/testfiles/foo") => true +; (executable? "test/me/raynes/testfiles/bar") => false) +; +; (fact +; (readable? "test/me/raynes/testfiles/foo") => true +; (readable? "test/me/raynes/testfiles/bar") => false) +; +; (fact +; (writeable? "test/me/raynes/testfiles/foo") => true +; (writeable? "test/me/raynes/testfiles/bar") => false))) + +;; BB-TEST-PATCH: update these paths to use bb folder structure + +(fact + (file? (str libtest-files-path "/foo")) => true + (file? ".") => false) + +(fact + (exists? (str libtest-files-path "/foo")) => true + (exists? "ewjgnr4ig43j") => false) + +(fact + (let [f (io/file (str libtest-files-path "/baz"))] + (.createNewFile f) + (delete f) + (exists? f) => false)) + +(fact + (directory? ".") => true + (directory? (str libtest-files-path "/foo")) => false) + +(fact + (file? ".") => false + (file? (str libtest-files-path "/foo")) => true) + +(fact + (let [tmp (temp-file "fs-")] + (exists? tmp) => true + (file? tmp) => true + (delete tmp))) + +(fact + (let [tmp (temp-dir "fs-")] + (exists? tmp) => true + (directory? tmp) => true + (delete tmp))) + +(fact + (let [tmp (ephemeral-file "fs-")] + (exists? tmp) => true + (file? tmp) => true)) ;; is deleted on JVM exit + +(fact + (let [tmp (ephemeral-dir "fs-")] + (exists? tmp) => true + (directory? tmp) => true)) ;; is deleted on JVM exit + +(fact + (absolute "foo") => (io/file *cwd* "foo")) + +(fact + (normalized ".") => *cwd*) + +(fact + (base-name "foo/bar") => "bar" + (base-name "foo/bar.txt" true) => "bar" + (base-name "bar.txt" ".txt") => "bar" + (base-name "foo/bar.txt" ".png") => "bar.txt") + +(fact + (let [tmp (temp-file "fs-")] + (> (mod-time tmp) 0) => true + (delete tmp))) + +(fact + (let [f (temp-file "fs-")] + (spit f "abc") + (size f) => 3 + (delete f))) + +(fact + (let [root (create-walk-dir) + result (delete-dir root)] + (exists? root) => false)) + +(fact + (let [f (temp-file "fs-")] + (delete f) + (mkdir f) + (directory? f) => true + (delete-dir f))) + +(fact + (let [f (temp-file "fs-") + sub (file f "a" "b")] + (delete f) + (mkdirs sub) + (directory? sub) => true + (delete-dir f))) + +;(fact +; (split (file "test/fs")) => (has-suffix ["test" "fs"])) + +(when unix-root + (fact + (split (file "/tmp/foo/bar.txt")) => '("/" "tmp" "foo" "bar.txt") + (split (file "/")) => '("/") + (split "/") => '("/") + (split "") => '(""))) + +(fact + (let [f (temp-file "fs-") + new-f (str f "-new")] + (rename f new-f) + (exists? f) => false + (exists? new-f) => true + (delete new-f))) + +;(fact +; (let [root (create-walk-dir)] +; (walk vector root) => (contains [[root #{"b" "a"} #{"1"}] +; [(file root "a") #{} #{"2"}] +; [(file root "b") #{} #{"3"}]] +; :in-any-order) +; (delete-dir root))) + +(fact + (let [from (temp-file "fs-") + to (temp-file "fs-") + data "What's up Doc?"] + (delete to) + (spit from data) + (copy from to) + (slurp from) => (slurp to) + (delete from) + (delete to))) + +(fact + (let [f (temp-file "fs-") + t (mod-time f)] + (Thread/sleep 1000) + (touch f) + (> (mod-time f) t) => true + (let [t2 3000] + (touch f t2) + (mod-time f) => t2) + (delete f))) + +(fact + (let [f (temp-file "fs-")] + (chmod "+x" f) + (executable? f) => true + (when-not (re-find #"Windows" (System/getProperty "os.name")) + (chmod "-x" f) + (executable? f) => false) + (delete f))) + +(fact + (let [f (temp-file "fs-")] + (chmod "777" f) + (executable? f) => true + (readable? f) => true + (writeable? f) => true + (chmod "000" f) + (when-not (re-find #"Windows" (System/getProperty "os.name")) + (chmod "-x" f) + (executable? f) => false + (readable? f) => false + (writeable? f) => false) + (delete f))) + +;(fact +; (let [from (create-walk-dir) +; to (temp-dir "fs-") +; path (copy-dir from to) +; dest (file to (base-name from))] +; path => dest +; (walk vector to) => (contains [[to #{(base-name from)} #{}] +; [dest #{"b" "a"} #{"1"}] +; [(file dest "a") #{} #{"2"}] +; [(file dest "b") #{} #{"3"}]] +; :in-any-order) +; (delete-dir from) +; (delete-dir to))) +; +;(fact "copy-dir-into works as expected." +; (let [from (create-walk-dir) +; to (temp-dir "fs-")] +; (copy-dir-into from to) +; (walk vector to) => (contains [[(file to) #{"a" "b"} #{"1"}] +; [(file to "a") #{} #{"2"}] +; [(file to "b") #{} #{"3"}]] +; :in-any-order) +; (delete-dir from) +; (delete-dir to))) + +(when (System/getenv "HOME") + (fact + (let [env-home (io/file (System/getenv "HOME"))] + (home) => env-home + (home "") => env-home + (home (System/getProperty "user.name")) => env-home))) + +;(tabular +; (fact (split-ext ?file) => ?ext) +; +; ?file ?ext +; "fs.clj" ["fs" ".clj"] +; "fs." ["fs" "."] +; "fs.clj.bak" ["fs.clj" ".bak"] +; "/path/to/fs" ["fs" nil] +; "" [(base-name (System/getProperty "user.dir")) nil] +; "~user/.bashrc" [".bashrc" nil]) +; +;(tabular +; (fact (extension ?file) => ?ext) +; +; ?file ?ext +; "fs.clj" ".clj" +; "fs." "." +; "fs.clj.bak" ".bak" +; "/path/to/fs" nil +; "" nil +; ".bashrc" nil) +; +;(tabular +; (fact (name ?file) => ?ext) +; +; ?file ?ext +; "fs.clj" "fs" +; "fs." "fs" +; "fs.clj.bak" "fs.clj" +; "/path/to/fs" "fs" +; "" (base-name (System/getProperty "user.dir")) +; ".bashrc" ".bashrc") + +(fact "Can change cwd with with-cwd." + (let [old *cwd*] + (with-cwd "foo" + *cwd* => (io/file old "foo")))) + +(fact "Can change cwd mutably with with-mutable-cwd" + (let [old *cwd*] + (with-mutable-cwd + (chdir "foo") + *cwd* => (io/file old "foo")))) + +;(with-cwd "test/me/raynes/testfiles" +; (fact +; (unzip "ggg.zip" "zggg") +; (exists? "zggg/ggg") => true +; (exists? "zggg/hhh/jjj") => true +; (delete-dir "zggg")) +; +; (fact (zip "fro.zip" ["bbb.txt" "bbb"]) +; (exists? "fro.zip") => true +; (unzip "fro.zip" "fro") +; (exists? "fro/bbb.txt") => true +; (rename "fro.zip" "fro2.zip") => true +; (delete "fro2.zip") +; (delete-dir "fro")) +; +; (fact "about zip round trip" +; (zip "round.zip" ["some.txt" "some text"]) +; (unzip "round.zip" "round") +; (slurp (file "round/some.txt")) => "some text") +; +; (fact "zip-files" +; (zip-files "foobar.zip" ["foo" "bar"]) +; (exists? "foobar.zip") +; (unzip "foobar.zip" "foobar") +; (exists? "foobar/foo") => true +; (exists? "foobar/bar") => true +; (delete "foobar.zip") +; (delete-dir "foobar")) +; +; (fact +; (untar "ggg.tar" "zggg") +; (exists? "zggg/ggg") => true +; (exists? "zggg/hhh/jjj") => true +; (delete-dir "zggg")) +; +; (fact +; (gunzip "ggg.gz" "ggg") +; (exists? "ggg") => true +; (delete "ggg")) +; +; (fact +; (bunzip2 "bbb.bz2" "bbb") +; (exists? "bbb") => true +; (delete "bbb")) +; +; (fact +; (unxz "xxx.xz" "xxx") +; (exists? "xxx") => true +; (delete "xxx")) +; +; (fact "zip-slip vulnerability" +; (unzip "zip-slip.zip" "zip-slip") => (throws Exception "Expanding entry would be created outside target dir") +; (untar "zip-slip.tar" "zip-slip") => (throws Exception "Expanding entry would be created outside target dir") +; (exists? "/tmp/evil.txt") => false +; (delete-dir "zip-slip"))) + +;(let [win-root (when-not unix-root "c:")] +; (fact +; (parents (str win-root "/foo/bar/baz")) => (just [(file (str win-root "/foo")) +; (file (str win-root "/foo/bar")) +; (file (str win-root "/"))] +; :in-any-order) +; (parents (str win-root "/")) => nil)) +; +;(fact +; (child-of? "/foo/bar" "/foo/bar/baz") => truthy +; (child-of? "/foo/bar/baz" "/foo/bar") => falsey) + +(fact + (path-ns "foo/bar/baz_quux.clj") => 'foo.bar.baz-quux) + +;(fact +; (str (ns-path 'foo.bar.baz-quux)) => (has-suffix (string/join File/separator ["foo" "bar" "baz_quux.clj"]))) + +(fact + (let [win-root (when-not unix-root "c:")] + (absolute? (str win-root "/foo/bar")) => true + (absolute? (str win-root "/foo/")) => true + (absolute? "foo/bar") => false + (absolute? "foo/") => false)) + +(defmacro run-java-7-tests [] + (when (try (import '[java.nio.file Files Path LinkOption StandardCopyOption FileAlreadyExistsException] + '[java.nio.file.attribute FileAttribute]) + (catch Exception _ nil)) + '(do + ;; BB-TEST-PATCH: change path to match bb folders + (def test-files-path "test-resources/lib_tests/me/raynes/testfiles") + + (fact + (let [files (find-files test-files-path #"ggg\.*") + gggs (map #(file (str test-files-path "/ggg." %)) '(gz tar zip))] + (every? (set gggs) files) => true)) + + (fact + (let [fs1 (find-files test-files-path #"ggg\.*") + fs2 (find-files* test-files-path #(re-matches #"ggg\.*" (.getName %)))] + (= fs1 fs2) => true)) + + (fact + (let [f (touch (io/file test-files-path ".hidden"))] + (hidden? f) + (delete f))) + + (fact + (let [target (io/file test-files-path "ggg.tar") + hard (link (io/file test-files-path "hard.link") target)] + (file? hard) => true + (delete hard))) + + (when fs-supports-symlinks? + (fact + (let [target (io/file test-files-path "ggg.tar") + soft (sym-link (io/file test-files-path "soft.link") target)] + (file? soft) => true + (link? soft) => true + (= (read-sym-link soft) target) + (delete soft))) + + (fact + (let [soft (sym-link (io/file test-files-path "soft.link") test-files-path)] + (link? soft) => true + (file? soft) => false + (directory? soft) => true + (directory? soft LinkOption/NOFOLLOW_LINKS) => false + (delete soft))) + + (fact + (let [root (create-walk-dir) + soft-a (sym-link (io/file root "soft-a.link") (io/file root "a")) + soft-b (sym-link (io/file root "soft-b.link") (io/file root "b"))] + (delete-dir soft-a LinkOption/NOFOLLOW_LINKS) + (exists? (io/file root "a" "2")) => true + (delete-dir soft-b) + (exists? (io/file root "b" "3")) => false + (delete-dir root) + (exists? root) => false))) + + (fact "`move` moves files" + (let [source (io/file test-files-path "foo") + target (io/file test-files-path "foo.moved") + existing-target (io/file test-files-path "bar")] + (move source target) + (exists? target) => true + (exists? source) => false + (move target source) + (exists? target) => false + (exists? source) => true +; (move source existing-target) => (throws FileAlreadyExistsException) + (copy source target) + (move source target StandardCopyOption/REPLACE_EXISTING) + (exists? target) => true + (exists? source) => false + (move target source)))))) + +(run-java-7-tests) diff --git a/test-resources/lib_tests/me/raynes/mock_midje.clj b/test-resources/lib_tests/me/raynes/mock_midje.clj new file mode 100644 index 00000000..6724496f --- /dev/null +++ b/test-resources/lib_tests/me/raynes/mock_midje.clj @@ -0,0 +1,38 @@ +;; BB-TEST-PATCH: add this file to mock the midje 'fact' macro + +(ns me.raynes.mock-midje + (:require [rewrite-clj.paredit :as rcp] + [rewrite-clj.zip :as rcz] + [clojure.string :as str] + [clojure.test :refer [deftest is testing]])) + +(defn- up-until-nil [z] + (if-let [new-z (rcz/up z)] + (recur new-z) + z)) + +(defn- replace-arrow [form-zipper-at-arrow] + (let [lhs (-> form-zipper-at-arrow rcz/left rcz/node) + rhs (-> form-zipper-at-arrow rcz/right rcz/node)] + (-> form-zipper-at-arrow + (rcp/wrap-around :list) + rcp/slurp-backward + rcp/slurp-forward + rcz/up + (rcz/replace `(is (= ~lhs ~rhs))) + up-until-nil))) + +(defn- replace-arrows [form-zipper] + (if-let [next-arrow (rcz/find-next-value form-zipper rcz/next '=>)] + (let [rd (replace-arrow next-arrow)] + (recur rd)) + (rcz/sexpr form-zipper))) + +(defmacro fact + "mockup of midje's fact that just transforms `=>` into `is` checks and uses deftest" + [& _] ;operating on &form + (let [[nameish body] (if (string? (second &form)) + [(str/replace (second &form) #"[^\w\d]" "-") (nnext &form)] + ["test" (next &form)]) + transformed-body (replace-arrows (rcz/of-string (pr-str body)))] + `(deftest ~(gensym nameish) ~@transformed-body))) diff --git a/test-resources/lib_tests/me/raynes/testfiles/bar b/test-resources/lib_tests/me/raynes/testfiles/bar new file mode 100644 index 00000000..e69de29b diff --git a/test-resources/lib_tests/me/raynes/testfiles/bbb.bz2 b/test-resources/lib_tests/me/raynes/testfiles/bbb.bz2 new file mode 100644 index 00000000..5910bdb8 Binary files /dev/null and b/test-resources/lib_tests/me/raynes/testfiles/bbb.bz2 differ diff --git a/test-resources/lib_tests/me/raynes/testfiles/foo b/test-resources/lib_tests/me/raynes/testfiles/foo new file mode 100644 index 00000000..e69de29b diff --git a/test-resources/lib_tests/me/raynes/testfiles/ggg.gz b/test-resources/lib_tests/me/raynes/testfiles/ggg.gz new file mode 100644 index 00000000..09cf4842 Binary files /dev/null and b/test-resources/lib_tests/me/raynes/testfiles/ggg.gz differ diff --git a/test-resources/lib_tests/me/raynes/testfiles/ggg.tar b/test-resources/lib_tests/me/raynes/testfiles/ggg.tar new file mode 100644 index 00000000..c83a6633 Binary files /dev/null and b/test-resources/lib_tests/me/raynes/testfiles/ggg.tar differ diff --git a/test-resources/lib_tests/me/raynes/testfiles/ggg.zip b/test-resources/lib_tests/me/raynes/testfiles/ggg.zip new file mode 100644 index 00000000..eaddda38 Binary files /dev/null and b/test-resources/lib_tests/me/raynes/testfiles/ggg.zip differ diff --git a/test-resources/lib_tests/me/raynes/testfiles/xxx.xz b/test-resources/lib_tests/me/raynes/testfiles/xxx.xz new file mode 100644 index 00000000..f36dec0d Binary files /dev/null and b/test-resources/lib_tests/me/raynes/testfiles/xxx.xz differ diff --git a/test-resources/lib_tests/me/raynes/testfiles/zip-slip.tar b/test-resources/lib_tests/me/raynes/testfiles/zip-slip.tar new file mode 100644 index 00000000..264b2506 Binary files /dev/null and b/test-resources/lib_tests/me/raynes/testfiles/zip-slip.tar differ diff --git a/test-resources/lib_tests/me/raynes/testfiles/zip-slip.zip b/test-resources/lib_tests/me/raynes/testfiles/zip-slip.zip new file mode 100644 index 00000000..38b3f499 Binary files /dev/null and b/test-resources/lib_tests/me/raynes/testfiles/zip-slip.zip differ