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:
parent
7a9f031e2b
commit
34971edc32
|
@ -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
|
||||
|
|
|
@ -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))))))
|
||||
|
|
Loading…
Reference in a new issue