mirrors/janet
1
0
Fork 0
mirror of https://github.com/janet-lang/janet synced 2024-12-24 23:40:27 +00:00
Code Issues 1 Releases Wiki Activity

Just don't do backslashes.

Browse Source
This commit is contained in:
Calvin Rose 2024-05-25 16:43:51 -05:00
parent eb21d4fff4
commit 4fbc71c70d
2 changed files with 14 additions and 7 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

14
src/boot/boot.janet
View File

@ -4004,6 +4004,10 @@
[bundle-name filename] [bundle-name filename]
(string (dyn *syspath*) "/bundle/" bundle-name "/" filename)) (string (dyn *syspath*) "/bundle/" bundle-name "/" filename))
(defn- bundle-rpath
[path]
(string/replace-all "\\" "/" (os/realpath path)))
(defn- get-manifest-filename (defn- get-manifest-filename
[bundle-name] [bundle-name]
(bundle-file bundle-name "manifest.jdn")) (bundle-file bundle-name "manifest.jdn"))
@ -4066,7 +4070,7 @@
(def manifest (bundle/manifest bundle-name)) (def manifest (bundle/manifest bundle-name))
(def dir (os/cwd)) (def dir (os/cwd))
(def workdir (get manifest :local-source ".")) (def workdir (get manifest :local-source "."))
(def fixed-syspath (os/realpath (dyn *syspath*))) (def fixed-syspath (bundle-rpath (dyn *syspath*)))
(try (try
(os/cd workdir) (os/cd workdir)
([_] (print "cannot enter source directory " workdir " for bundle " bundle-name))) ([_] (print "cannot enter source directory " workdir " for bundle " bundle-name)))
@ -4187,12 +4191,10 @@
"Install a bundle from the local filesystem with a name `bundle-name`." "Install a bundle from the local filesystem with a name `bundle-name`."
[&opt path bundle-name &keys config] [&opt path bundle-name &keys config]
(default path ".") (default path ".")
(def path (os/realpath path)) (def path (bundle-rpath path))
(def clean (get config :clean)) (def clean (get config :clean))
(def check (get config :check)) (def check (get config :check))
(default bundle-name (default bundle-name (last (string/split sep path)))
(let [sep (if (string/find "\\" path) "\\" "/")]
(last (string/split sep path))))
(assert (not (string/check-set "\\/" bundle-name)) (assert (not (string/check-set "\\/" bundle-name))
(string "bundle-name " (string "bundle-name "
bundle-name bundle-name
@ -4256,7 +4258,7 @@
(def install-hook (string dest-dir "/bundle/init.janet")) (def install-hook (string dest-dir "/bundle/init.janet"))
(edefer (rmrf dest-dir) # don't leave garbage on failure (edefer (rmrf dest-dir) # don't leave garbage on failure
(def install-source @[]) (def install-source @[])
(def syspath (os/realpath (dyn *syspath*))) (def syspath (bundle-rpath (dyn *syspath*))
(when is-backup (copyrf (bundle-dir bundle-name) (string dest-dir "/old-bundle"))) (when is-backup (copyrf (bundle-dir bundle-name) (string dest-dir "/old-bundle")))
(each file files (each file files
(def {:mode mode :permissions perm} (os/stat file)) (def {:mode mode :permissions perm} (os/stat file))

7
test/suite-bundle.janet
View File

@ -24,6 +24,9 @@
(assert true) # smoke test (assert true) # smoke test
# Copy since not exposed in boot.janet # Copy since not exposed in boot.janet
(defn- bundle-rpath
[path]
(string/replace-all "\\" "/" (os/realpath path)))
(def- sep (if (= :windows (os/which)) "\\" "/")) (def- sep (if (= :windows (os/which)) "\\" "/"))
(defn- rmrf (defn- rmrf
"rm -rf in janet" "rm -rf in janet"
@ -40,8 +43,10 @@
(def syspath (string "." sep (string (math/random)) "_jpm_tree.tmp")) (def syspath (string "." sep (string (math/random)) "_jpm_tree.tmp"))
(rmrf syspath) (rmrf syspath)
(assert (os/mkdir syspath)) (assert (os/mkdir syspath))
(put root-env *syspath* (os/realpath syspath)) (put root-env *syspath* (bundle-rpath syspath))
#(setdyn *out* @"") #(setdyn *out* @"")
(pp (bundle/list))
(pp (bundle/topolist))
(assert (empty? (bundle/list)) "initial bundle/list") (assert (empty? (bundle/list)) "initial bundle/list")
(assert (empty? (bundle/topolist)) "initial bundle/topolist") (assert (empty? (bundle/topolist)) "initial bundle/topolist")