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

core: fix make-package multiple calls side effects 

Calling multiple times configuration-layer/make-package appends the
same layers to :owners, :pre-layers and :post-layers slot.

Use object-add-to-list instead of push.

Add some tests and mock some warning messages.
This commit is contained in:
syl20bnr 2016-09-05 15:01:35 -04:00
parent 7a9f031e2b
commit 34971edc32
2 changed files with 82 additions and 35 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

12
core/core-configuration-layer.el
View File

@ -549,6 +549,10 @@ If TOGGLEP is nil then `:toggle' parameter is ignored."
(min-version (when (listp pkg) (plist-get (cdr pkg) :min-version)))
(step (when (listp pkg) (plist-get (cdr pkg) :step)))
(toggle (when (listp pkg) (plist-get (cdr pkg) :toggle)))
;; (excluded (when (listp pkg)
;; (if (memq :excluded (cdr pkg))
;; (plist-get (cdr pkg) :excluded)
;; 'unspecified)))
(excluded (when (listp pkg) (plist-get (cdr pkg) :excluded)))
(location (when (listp pkg) (plist-get (cdr pkg) :location)))
(protected (when (listp pkg) (plist-get (cdr pkg) :protected)))
@ -567,6 +571,7 @@ If TOGGLEP is nil then `:toggle' parameter is ignored."
(when step (oset obj :step step))
(when toggle (oset obj :toggle toggle))
(oset obj :excluded (or excluded (oref obj :excluded)))
;; (unless (eq 'unspecified excluded) (oset obj :excluded excluded))
(when location
(if (and (listp location)
(eq (car location) 'recipe)
@ -598,9 +603,10 @@ If TOGGLEP is nil then `:toggle' parameter is ignored."
"replacing it with layer %S.")
pkg-name (car (oref obj :owners)) layer-name)))
;; last owner wins over the previous one
(push layer-name (oref obj :owners)))
(object-add-to-list obj :owners layer-name))
;; check consistency betwween package and defined init functions
(unless (or ownerp
(eq 'dotfile layer-name)
(fboundp pre-init-func)
(fboundp post-init-func)
(oref obj :excluded))
@ -619,9 +625,9 @@ If TOGGLEP is nil then `:toggle' parameter is ignored."
"layer %S does not own it.")
pkg-name layer-name)))
(when (fboundp pre-init-func)
(push layer-name (oref obj :pre-layers)))
(object-add-to-list obj :pre-layers layer-name))
(when (fboundp post-init-func)
(push layer-name (oref obj :post-layers)))
(object-add-to-list obj :post-layers layer-name))
obj))
(define-button-type 'help-dotfile-variable

105
tests/core/core-configuration-layer-utest.el
View File

@ -521,6 +521,36 @@
expected
(configuration-layer/make-package input 'layer-make-pkg-2)))))
(ert-deftest test-make-package--multiple-calls-invariants ()
(defun layer-make-pkg-3/init-testpkg nil)
(defun layer-make-pkg-4/pre-init-testpkg nil)
(defun layer-make-pkg-5/post-init-testpkg nil)
(let* (configuration-layer--used-layers
configuration-layer--protected-packages
(configuration-layer--indexed-layers (make-hash-table :size 1024))
(input '(testpkg :protected t))
(expected-pkg (cfgl-package "testpkg"
:name 'testpkg
:location 'elpa
:owners '(layer-make-pkg-3)
:pre-layers '(layer-make-pkg-4)
:post-layers '(layer-make-pkg-5)
:step nil
:protected t
:excluded nil))
(expected-protected-list '(testpkg)))
(helper--set-layers
`(,(cfgl-layer "layer-make-pkg-3" :name 'layer-make-pkg-3)
,(cfgl-layer "layer-make-pkg-4" :name 'layer-make-pkg-4)
,(cfgl-layer "layer-make-pkg-5" :name 'layer-make-pkg-5)) t)
(let ((obj (configuration-layer/make-package input 'layer-make-pkg-3)))
(dotimes (x 3)
(configuration-layer/make-package input 'layer-make-pkg-3 obj)
(configuration-layer/make-package input 'layer-make-pkg-4 obj)
(configuration-layer/make-package input 'layer-make-pkg-5 obj))
(should (equal expected-pkg obj))
(should (equal expected-protected-list
configuration-layer--protected-packages)))))
(ert-deftest test-make-package--can-override-toggle ()
(let (configuration-layer--used-layers
@ -779,7 +809,7 @@
(defun layer2/init-pkg1 nil)
(defun layer2/init-pkg3 nil)
(mocker-let
((configuration-layer//warning (m) ((:output nil))))
((configuration-layer//warning (msg &rest args) ((:output nil :occur 1))))
(configuration-layer/make-packages-from-layers '(layer2))
(should
(and (equal (cfgl-package "pkg3" :name 'pkg3 :owners '(layer2))
@ -928,12 +958,14 @@
(helper--set-layers (list layer13 layer14) t)
(defun layer13/init-pkg1 nil)
(defun layer14/init-pkg1 nil)
(configuration-layer/make-packages-from-layers '(layer13 layer14))
(should (equal (cfgl-package "pkg1"
:name 'pkg1
:owners '(layer14 layer13)
:location 'local)
(ht-get configuration-layer--indexed-packages 'pkg1)))))
(mocker-let
((configuration-layer//warning (msg &rest args) ((:output nil :occur 1))))
(configuration-layer/make-packages-from-layers '(layer13 layer14))
(should (equal (cfgl-package "pkg1"
:name 'pkg1
:owners '(layer14 layer13)
:location 'local)
(ht-get configuration-layer--indexed-packages 'pkg1))))))
(ert-deftest test-make-packages-from-layers--last-owner-can-overwrite-step-nil-to-pre ()
(let* ((layer15 (cfgl-layer "layer15"
@ -952,12 +984,14 @@
(helper--set-layers (list layer15 layer16) t)
(defun layer15/init-pkg1 nil)
(defun layer16/init-pkg1 nil)
(configuration-layer/make-packages-from-layers '(layer15 layer16))
(should (equal (cfgl-package "pkg1"
:name 'pkg1
:owners '(layer16 layer15)
:step 'pre)
(ht-get configuration-layer--indexed-packages 'pkg1)))))
(mocker-let
((configuration-layer//warning (msg &rest args) ((:output nil :occur 1))))
(configuration-layer/make-packages-from-layers '(layer15 layer16))
(should (equal (cfgl-package "pkg1"
:name 'pkg1
:owners '(layer16 layer15)
:step 'pre)
(ht-get configuration-layer--indexed-packages 'pkg1))))))
(ert-deftest test-make-packages-from-layers--last-owner-cannot-overwrite-step-pre-to-nil ()
(let* ((layer15 (cfgl-layer "layer15"
@ -976,12 +1010,14 @@
(helper--set-layers (list layer15 layer16) t)
(defun layer15/init-pkg1 nil)
(defun layer16/init-pkg1 nil)
(configuration-layer/make-packages-from-layers '(layer15 layer16))
(should (equal (cfgl-package "pkg1"
:name 'pkg1
:owners '(layer16 layer15)
:step 'pre)
(ht-get configuration-layer--indexed-packages 'pkg1)))))
(mocker-let
((configuration-layer//warning (msg &rest args) ((:output nil :occur 1))))
(configuration-layer/make-packages-from-layers '(layer15 layer16))
(should (equal (cfgl-package "pkg1"
:name 'pkg1
:owners '(layer16 layer15)
:step 'pre)
(ht-get configuration-layer--indexed-packages 'pkg1))))))
(ert-deftest test-make-packages-from-layers--last-owner-can-overwrite-exclude ()
(let* ((layer17 (cfgl-layer "layer17"
@ -1001,12 +1037,14 @@
(helper--set-layers (list layer17 layer18) t)
(defun layer17/init-pkg1 nil)
(defun layer18/init-pkg1 nil)
(configuration-layer/make-packages-from-layers '(layer17 layer18))
(should (equal (cfgl-package "pkg1"
:name 'pkg1
:owners '(layer18 layer17)
:excluded t)
(ht-get configuration-layer--indexed-packages 'pkg1)))))
(mocker-let
((configuration-layer//warning (msg &rest args) ((:output nil :occur 1))))
(configuration-layer/make-packages-from-layers '(layer17 layer18))
(should (equal (cfgl-package "pkg1"
:name 'pkg1
:owners '(layer18 layer17)
:excluded t)
(ht-get configuration-layer--indexed-packages 'pkg1))))))
(ert-deftest test-make-packages-from-layers--owner-layer-can-define-toggle ()
(let* ((layer19 (cfgl-layer "layer19"
@ -1071,12 +1109,14 @@
(helper--set-layers (list layer22 layer23) t)
(defun layer22/init-pkg1 nil)
(defun layer23/init-pkg1 nil)
(configuration-layer/make-packages-from-layers '(layer22 layer23))
(should (equal (cfgl-package "pkg1"
:name 'pkg1
:owners '(layer23 layer22)
:toggle '(bar-toggle))
(ht-get configuration-layer--indexed-packages 'pkg1)))))
(mocker-let
((configuration-layer//warning (msg &rest args) ((:output nil :occur 1))))
(configuration-layer/make-packages-from-layers '(layer22 layer23))
(should (equal (cfgl-package "pkg1"
:name 'pkg1
:owners '(layer23 layer22)
:toggle '(bar-toggle))
(ht-get configuration-layer--indexed-packages 'pkg1))))))
(ert-deftest test-make-packages-from-layers--not-selected-packages-are-not-excluded ()
(let* ((layer24 (cfgl-layer "layer24"
@ -1210,7 +1250,8 @@
(should
(and (equal (cfgl-package "pkg3" :name 'pkg3 :owners '(layer-dotfile-3))
(ht-get configuration-layer--indexed-packages 'pkg3))
(equal (cfgl-package "pkg2" :name 'pkg2 :owners '(layer-dotfile-3) :excluded t)
(equal (cfgl-package "pkg2" :name 'pkg2 :owners '(layer-dotfile-3)
:excluded t)
(ht-get configuration-layer--indexed-packages 'pkg2))
(equal (cfgl-package "pkg1" :name 'pkg1 :owners '(layer-dotfile-3))
(ht-get configuration-layer--indexed-packages 'pkg1))))))