TakeV/spacemacs
1
0
Fork 0
Code Issues Pull requests Packages Projects Releases Wiki Activity

core: perform local path existence check at configuration time

Browse source 
In order to be able to log the not found path as a warning instead
of crashing.

Also adds unit test to test both valid and invalid local paths.
This commit is contained in:
syl20bnr 2015-10-22 22:39:53 -04:00
parent feeab93a1c
commit 3dec1ce9ec
2 changed files with 49 additions and 17 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

38
core/core-configuration-layer.el
View file

@ -103,8 +103,7 @@
(location :initarg :location
:initform elpa
:type (satisfies (lambda (x)
(or (and (stringp x)
(file-directory-p x))
(or (stringp x)
(member x '(built-in local elpa))
(and (listp x) (eq 'recipe (car x))))))
:documentation "Location of the package.")
@ -749,21 +748,26 @@ path."
(format "%S ignored since it has no owner layer." pkg-name)))
(t
;; load-path
(cond
((stringp (oref pkg :location))
(push (file-name-as-directory (oref pkg :location)) load-path))
((and (eq 'local (oref pkg :location))
(eq 'dotfile (oref pkg :owner)))
(push (file-name-as-directory
(concat configuration-layer-private-directory "local/"
(symbol-name (oref pkg :name))))
load-path))
((eq 'local (oref pkg :location))
(let* ((owner (object-assoc (oref pkg :owner) :name configuration-layer--layers))
(dir (when owner (oref owner :dir))))
(push (format "%slocal/%S/" dir pkg-name) load-path)
;; TODO remove extensions in 0.105.0
(push (format "%sextensions/%S/" dir pkg-name) load-path))))
(let ((location (oref pkg :location)))
(cond
((stringp location)
(if (file-directory-p location)
(push (file-name-as-directory location) load-path)
(spacemacs-buffer/warning
"Location path for package %S does not exists (value: %s)."
pkg location)))
((and (eq 'local location)
(eq 'dotfile (oref pkg :owner)))
(push (file-name-as-directory
(concat configuration-layer-private-directory "local/"
(symbol-name (oref pkg :name))))
load-path))
((eq 'local location)
(let* ((owner (object-assoc (oref pkg :owner) :name configuration-layer--layers))
(dir (when owner (oref owner :dir))))
(push (format "%slocal/%S/" dir pkg-name) load-path)
;; TODO remove extensions in 0.105.0
(push (format "%sextensions/%S/" dir pkg-name) load-path)))))
;; configuration
(cond
((eq 'dotfile (oref pkg :owner))

28
tests/core/core-configuration-layer-utest.el
View file

@ -677,6 +677,34 @@
(configuration-layer//configure-packages-2 `(,pkg))
(should (equal load-path old-load-path)))))
(ert-deftest
test-configure-packages-2--local-package-w/-string-location-update-load-path()
(let ((pkg (cfgl-package "pkg"
:name 'pkg
:owner 'dotfile
:location spacemacs-docs-directory))
(expected-load-path load-path)
(mocker-mock-default-record-cls 'mocker-stub-record))
(mocker-let
((spacemacs-buffer/loading-animation nil ((:output nil))))
(configuration-layer//configure-packages-2 `(,pkg))
(push spacemacs-docs-directory expected-load-path)
(should (equal expected-load-path load-path)))))
(ert-deftest
test-configure-packages-2--local-package-w/-bad-string-location-gives-warning()
(let ((pkg (cfgl-package "pkg"
:name 'pkg
:owner 'dotfile
:location "/this/directory/does/not/exist/"))
(mocker-mock-default-record-cls 'mocker-stub-record))
(mocker-let
((spacemacs-buffer/loading-animation nil ((:output nil)))
(spacemacs-buffer/warning
(msg &rest args)
((:record-cls 'mocker-stub-record :output nil :occur 1))))
(configuration-layer//configure-packages-2 `(,pkg)))))
;; ---------------------------------------------------------------------------
;; configuration-layer//sort-packages
;; ---------------------------------------------------------------------------