core: refactor shadow mechanism
Shadowing is now control by layer property ':can-shadow' only.
can-shadow is a commutative relation, if layer1 can shadow layer2 then layer2
can shadow layer1.
the shadow operator is a binary operator accepting two layer names, it is not
commutative and the order of the operands is determined by the order of the
layers in the dotfile (like the ownership stealing mechanism).
If ':can-shadow' is set explicity to nil in the dotfile then the layer won't
shadow any layer.
For instance to install both ivy and helm layer:
(setq dotspacemacs-configuration-layers
'(
ivy
(helm :can-shadow nil)
)
note that due to the commutative relation the above example can also be
written (in this case, ':can-shadow' should be read ':can-be-shawdowed'):
(setq dotspacemacs-configuration-layers
'(
(ivy :can-shadow nil)
helm
)
This commit is contained in:
syl20bnr
parent
ecf6faedb7
commit
dc58801c7d
|
|
@ -116,15 +116,18 @@ ROOT is returned."
|
|||
:initform 'unspecified
|
||||
:type (satisfies (lambda (x) (or (listp x) (eq 'unspecified x))))
|
||||
:documentation
|
||||
"A list of layers where this layer is enabled. (Takes precedence over `:disabled-for'.)")
|
||||
(concat "A list of layers where this layer is enabled. "
|
||||
"(Takes precedence over `:disabled-for'.)"))
|
||||
;; Note:
|
||||
;; 'can-shadow' is a commutative relation:
|
||||
;; if Y 'can-shadow' X then X 'can-shadow' Y
|
||||
;; but the 'shadow' operation is not commutative, the order of the operands
|
||||
;; is determined by the order of the layers in the dotfile
|
||||
;; (variable: dotspacemacs-configuration-layers)
|
||||
(can-shadow :initarg :can-shadow
|
||||
:initform t
|
||||
:type boolean
|
||||
:documentation "If non-nil this layer can shadow other layers.")
|
||||
(shadowed-by :initarg :shadowed-by
|
||||
:initform nil
|
||||
:type list
|
||||
:documentation "A list of layers that can shadow this layer."))
|
||||
:initform 'unspecified
|
||||
:type (satisfies (lambda (x) (or (listp x) (eq 'unspecified x))))
|
||||
:documentation "A list of layers this layer can shadow."))
|
||||
"A configuration layer.")
|
||||
|
||||
(defmethod cfgl-layer-owned-packages ((layer cfgl-layer) &optional props)
|
||||
|
|
@ -142,25 +145,30 @@ LAYER has to be installed for this method to work properly."
|
|||
"Accept nil as argument and return nil."
|
||||
nil)
|
||||
|
||||
(defmethod cfgl-layer-shadowed-p ((layer cfgl-layer))
|
||||
"Return the list of layers that shadow LAYER."
|
||||
(defmethod cfgl-layer-get-shadowing-layers ((layer cfgl-layer))
|
||||
"Return the list of used layers that shadow LAYER."
|
||||
(let ((rank (cl-position (oref layer :name) configuration-layer--used-layers))
|
||||
(shadow-candidates (oref layer :can-shadow))
|
||||
shadowing-layers)
|
||||
(when (numberp rank)
|
||||
(when (and (numberp rank)
|
||||
(not (eq 'unspecified shadow-candidates))
|
||||
(listp shadow-candidates))
|
||||
(mapcar
|
||||
(lambda (other)
|
||||
(let ((orank (cl-position other configuration-layer--used-layers)))
|
||||
;; LAYER is shadowed by OTHER if and only if its rank is lower than
|
||||
;; OTHER's rank.
|
||||
;; OTHER shadows LAYER if and only if OTHER's rank is bigger than
|
||||
;; LAYER's rank.
|
||||
(when (and (numberp orank) (< rank orank))
|
||||
(add-to-list 'shadowing-layers other))))
|
||||
(oref layer :shadowed-by)))
|
||||
;; since the 'can-shadow' relation is commutative it is safe to use this
|
||||
;; list, i.e. if LAYER can shadow layers X and Y then X and Y can shadow
|
||||
;; LAYER.
|
||||
shadow-candidates))
|
||||
shadowing-layers))
|
||||
|
||||
(defmethod cfgl-layer-get-packages ((layer cfgl-layer) &optional props)
|
||||
"Return the list of packages for LAYER.
|
||||
If PROPS is non-nil then return packages as lists along with their properties.
|
||||
Returns nil if the layer is shadowed by a layer."
|
||||
If PROPS is non-nil then return packages as lists along with their properties."
|
||||
(let ((all (eq 'all (oref layer :selected-packages))))
|
||||
(delq nil (mapcar
|
||||
(lambda (x)
|
||||
|
|
@ -626,10 +634,10 @@ If USEDP or `configuration-layer--load-packages-files' is non-nil then the
|
|||
'unspecified))
|
||||
(variables (when (listp layer-specs)
|
||||
(spacemacs/mplist-get layer-specs :variables)))
|
||||
(can-shadow
|
||||
(shadow
|
||||
(if (and (listp layer-specs)
|
||||
(memq :can-shadow layer-specs))
|
||||
(nth 0 (spacemacs/mplist-get layer-specs :can-shadow))
|
||||
(spacemacs/mplist-get layer-specs :can-shadow)
|
||||
'unspecified))
|
||||
(packages-file (concat dir "packages.el"))
|
||||
(packages
|
||||
|
|
@ -649,8 +657,8 @@ If USEDP or `configuration-layer--load-packages-files' is non-nil then the
|
|||
(oset obj :disabled-for disabled)
|
||||
(oset obj :enabled-for enabled)
|
||||
(oset obj :variables variables)
|
||||
(unless (eq 'unspecified can-shadow)
|
||||
(oset obj :can-shadow can-shadow)))
|
||||
(unless (eq 'unspecified shadow)
|
||||
(oset obj :can-shadow shadow)))
|
||||
(when packages
|
||||
(oset obj :packages packages)
|
||||
(oset obj :selected-packages selected-packages))
|
||||
|
|
@ -1048,7 +1056,7 @@ If SKIP-LAYER-DISCOVERY is non-nil then do not check for new layers."
|
|||
USEDP if non-nil indicates that made packages are used packages."
|
||||
(dolist (layer-name layer-names)
|
||||
(let* ((layer (configuration-layer/get-layer layer-name))
|
||||
(shadowed-by (cfgl-layer-shadowed-p layer)))
|
||||
(shadowed-by (cfgl-layer-get-shadowing-layers layer)))
|
||||
(if shadowed-by
|
||||
(spacemacs-buffer/message
|
||||
"Ignoring layer '%s' because it is shadowed by layer(s) '%s'."
|
||||
|
|
@ -1350,32 +1358,56 @@ wether the declared layer is an used one or not."
|
|||
(configuration-layer/declare-layer distribution)))
|
||||
(configuration-layer/declare-layer 'spacemacs-bootstrap)))
|
||||
|
||||
(defun configuration-layer/shadow-layers (layer-name shadowed-layers)
|
||||
"Declare LAYER-NAME to shadow SHADOWED-LAYERS.
|
||||
LAYER-NAME is a the name symbol of an existing layer.
|
||||
SHADOWED-LAYERS is a list of layer name symbols."
|
||||
(mapc (lambda (x)
|
||||
(configuration-layer/shadow-layer layer-name x))
|
||||
shadowed-layers))
|
||||
(defun configuration-layer/declare-shadow-relation (layer-name &rest onames)
|
||||
"Declare 'can-shadow' relationship between LAYER_NAME and OTHER-NAMES layers.
|
||||
LAYER-NAME is the name symbol of an existing layer.
|
||||
ONAMES is a list of other layer name symbols."
|
||||
(dolist (o onames)
|
||||
(configuration-layer//declare-shadow-relation layer-name o)))
|
||||
|
||||
(defun configuration-layer/shadow-layer (layer-name shadowed-layer-name)
|
||||
"Declare LAYER-NAME to shadow SHADOWED-LAYER.
|
||||
LAYER-NAME is a the name symbol of an existing layer.
|
||||
SHADOWED-LAYER-NAME is the name symbol of an existing layer."
|
||||
(let* ((layer (configuration-layer/get-layer layer-name))
|
||||
(shadowed-layer (configuration-layer/get-layer shadowed-layer-name)))
|
||||
(if (and layer shadowed-layer)
|
||||
(progn
|
||||
;; note: shadowing is commutative
|
||||
(cl-pushnew layer-name (oref shadowed-layer :shadowed-by))
|
||||
(cl-pushnew shadowed-layer-name (oref layer :shadowed-by)))
|
||||
;; cannot find one or both layers
|
||||
(if (null layer)
|
||||
(configuration-layer//warning "Unknown layer %s to shadow %s."
|
||||
layer-name shadowed-layer-name))
|
||||
(if (null shadowed-layer)
|
||||
(configuration-layer//warning "Unknown shadowed layer %s by %s."
|
||||
shadowed-layer-name layer-name)))))
|
||||
(defun configuration-layer//declare-shadow-relation (lname rname)
|
||||
"Declare 'can-shadow' relationship between LAYER_NAME and OTHER-NAMES layers.
|
||||
LNAME is the name symbol of an existing layer.
|
||||
RNAME is the name symbol of another existing layer."
|
||||
(let ((llayer (configuration-layer/get-layer lname))
|
||||
(rlayer (configuration-layer/get-layer rname)))
|
||||
(if (and llayer rlayer)
|
||||
(let ((lshadow (oref llayer :can-shadow))
|
||||
(rshadow (oref rlayer :can-shadow)))
|
||||
;; lhs of the relation
|
||||
(cond
|
||||
((eq 'unspecified lshadow)
|
||||
(when rshadow
|
||||
(oset llayer :can-shadow `(,rname))))
|
||||
((and lshadow (listp lshadow))
|
||||
(when rshadow
|
||||
(cl-pushnew rname (oref llayer :can-shadow))))
|
||||
((null lshadow)
|
||||
(spacemacs-buffer/message
|
||||
(concat "Ignore shadow relation between layers %s and %s because "
|
||||
":can-shadow of layer %s has been set to nil by the user.")
|
||||
lname rname lname)))
|
||||
;; rhs of the relation
|
||||
(cond
|
||||
((eq 'unspecified rshadow)
|
||||
(when lshadow
|
||||
(oset rlayer :can-shadow `(,lname))))
|
||||
((and rshadow (listp rshadow))
|
||||
(when lshadow
|
||||
(cl-pushnew lname (oref rlayer :can-shadow))))
|
||||
((null rshadow)
|
||||
(spacemacs-buffer/message
|
||||
(concat "Ignore shadow relation between layers %s and %s because "
|
||||
":can-shadow of layer %s has been set to nil by the user.")
|
||||
rname lname rname))))
|
||||
(when (null llayer)
|
||||
(configuration-layer//warning
|
||||
"Unknown layer %s to declare lshadow relationship."
|
||||
lname))
|
||||
(when (null rlayer)
|
||||
(configuration-layer//warning
|
||||
"Unknown layer %s to declare lshadow relationship."
|
||||
rname)))))
|
||||
|
||||
(defun configuration-layer//set-layers-variables (layers)
|
||||
"Set the configuration variables for the passed LAYERS."
|
||||
|
|
@ -1403,7 +1435,7 @@ SHADOWED-LAYER-NAME is the name symbol of an existing layer."
|
|||
"Return non-nil if LAYER-NAME is the name of a used and non-shadowed layer."
|
||||
(or (eq 'dotfile layer-name)
|
||||
(let ((obj (configuration-layer/get-layer layer-name)))
|
||||
(when obj (and (not (cfgl-layer-shadowed-p obj))
|
||||
(when obj (and (not (cfgl-layer-get-shadowing-layers obj))
|
||||
(memq layer-name configuration-layer--used-layers))))))
|
||||
(defalias 'configuration-layer/layer-usedp
|
||||
'configuration-layer/layer-used-p)
|
||||
|
|
|
|||
|
|
@ -9,4 +9,4 @@
|
|||
;;
|
||||
;;; License: GPLv3
|
||||
|
||||
(configuration-layer/shadow-layer 'helm 'ivy)
|
||||
(configuration-layer/declare-shadow-relation 'helm 'ivy)
|
||||
|
|
|
|||
|
|
@ -9,7 +9,7 @@
|
|||
;;
|
||||
;;; License: GPLv3
|
||||
|
||||
(configuration-layer/shadow-layer 'ivy 'helm)
|
||||
(configuration-layer/declare-shadow-relation 'ivy 'helm)
|
||||
|
||||
;; smex is handled by the `ivy' layer and we don't want
|
||||
;; to use the ownership mechanism of layers because it is dependent
|
||||
|
|
|
|||
|
|
@ -170,29 +170,48 @@
|
|||
:selected-packages '(pkg-unknown))))
|
||||
(should (null (cfgl-layer-get-packages layer)))))
|
||||
|
||||
;; method: cfgl-layer-shadowed-p
|
||||
;; method: cfgl-layer-get-shadowing-layers
|
||||
|
||||
(ert-deftest test-cfgl-layer-shadowed-p--layer2-shadows-layer1 ()
|
||||
(ert-deftest test-cfgl-layer-get-shadowing-layers--l2-declared-after-l1-shadows-l1 ()
|
||||
(let ((layer1 (cfgl-layer "layer1" :name 'layer1))
|
||||
(layer2 (cfgl-layer "layer2" :name 'layer2))
|
||||
(configuration-layer--used-layers nil)
|
||||
(configuration-layer--indexed-layers (make-hash-table :size 1024)))
|
||||
(helper--add-layers `(,layer1 ,layer2) 'used)
|
||||
(configuration-layer/shadow-layer 'layer2 'layer1)
|
||||
(should (and (equal '(layer2) (cfgl-layer-shadowed-p layer1))
|
||||
(not (cfgl-layer-shadowed-p layer2))))))
|
||||
(configuration-layer/declare-shadow-relation 'layer1 'layer2)
|
||||
(should (and (equal '(layer2) (cfgl-layer-get-shadowing-layers layer1))
|
||||
(equal '() (cfgl-layer-get-shadowing-layers layer2))))))
|
||||
|
||||
(ert-deftest test-cfgl-layer-shadowed-p--layer1-shadows-layer2 ()
|
||||
(ert-deftest test-cfgl-layer-get-shadowing-layers--l1-declared-after-l2-shadows-l2 ()
|
||||
(let ((layer1 (cfgl-layer "layer1" :name 'layer1))
|
||||
(layer2 (cfgl-layer "layer2" :name 'layer2))
|
||||
(configuration-layer--used-layers nil)
|
||||
(configuration-layer--indexed-layers (make-hash-table :size 1024)))
|
||||
;; we just switched the order of used layers
|
||||
;; remember, shadowing is commutative
|
||||
(helper--add-layers `(,layer2 ,layer1) 'used)
|
||||
(configuration-layer/shadow-layer 'layer2 'layer1)
|
||||
(should (and (equal '(layer1) (cfgl-layer-shadowed-p layer2))
|
||||
(not (cfgl-layer-shadowed-p layer1))))))
|
||||
(helper--add-layers `(,layer1 ,layer2) 'used)
|
||||
(configuration-layer/declare-shadow-relation 'layer1 'layer2)
|
||||
(should (and (equal '(layer2) (cfgl-layer-get-shadowing-layers layer1))
|
||||
(equal '() (cfgl-layer-get-shadowing-layers layer2))))))
|
||||
|
||||
(ert-deftest test-cfgl-layer-get-shadowing-layers--prevent-l2-from-shadowing-l1 ()
|
||||
(let ((layer1 (cfgl-layer "layer1" :name 'layer1))
|
||||
(layer2 (cfgl-layer "layer2" :name 'layer2 :can-shadow nil))
|
||||
(configuration-layer--used-layers nil)
|
||||
(configuration-layer--indexed-layers (make-hash-table :size 1024)))
|
||||
(helper--add-layers `(,layer1 ,layer2) 'used)
|
||||
(configuration-layer/declare-shadow-relation 'layer2 'layer1)
|
||||
(should (null (cfgl-layer-get-shadowing-layers layer1)))))
|
||||
|
||||
(ert-deftest test-cfgl-layer-get-shadowing-layers--prevent-l2-from-shadowing-l1-alternative ()
|
||||
;; using the commutative property of the can-shadow relation
|
||||
;; setting :can-shadow to nil on layer1 produces the same effect as the more
|
||||
;; intuitive test-cfgl-layer-get-shadowing-layers--prevent-l2-from-shadowing-l1
|
||||
(let ((layer1 (cfgl-layer "layer1" :name 'layer1 :can-shadow nil))
|
||||
(layer2 (cfgl-layer "layer2" :name 'layer2))
|
||||
(configuration-layer--used-layers nil)
|
||||
(configuration-layer--indexed-layers (make-hash-table :size 1024)))
|
||||
(helper--add-layers `(,layer1 ,layer2) 'used)
|
||||
(configuration-layer/declare-shadow-relation 'layer2 'layer1)
|
||||
(should (null (cfgl-layer-get-shadowing-layers layer1)))))
|
||||
|
||||
;; ---------------------------------------------------------------------------
|
||||
;; configuration-layer/layer-used-p
|
||||
|
|
@ -218,7 +237,7 @@
|
|||
configuration-layer--used-layers
|
||||
(configuration-layer--indexed-layers (make-hash-table :size 1024)))
|
||||
(helper--add-layers `(,usedlayer1 ,usedlayer2) 'used)
|
||||
(configuration-layer/shadow-layer 'usedlayer2 'usedlayer1)
|
||||
(configuration-layer/declare-shadow-relation 'usedlayer2 'usedlayer1)
|
||||
(should (not (configuration-layer/layer-used-p 'usedlayer1)))))
|
||||
|
||||
(ert-deftest test-layer-used-p--dotfile-layer-is-always-used ()
|
||||
|
|
@ -949,7 +968,7 @@
|
|||
:name 'layer
|
||||
:dir spacemacs-start-directory))
|
||||
(layer-specs '(layer :disabled-for pkg8 pkg9
|
||||
:can-shadow nil
|
||||
:can-shadow layer2 layer3
|
||||
:variables foo bar toto 1))
|
||||
(layer-packages '(pkg1 pkg2 pkg3))
|
||||
(mocker-mock-default-record-cls 'mocker-stub-record))
|
||||
|
|
@ -959,7 +978,7 @@
|
|||
(should (equal (cfgl-layer "layer"
|
||||
:name 'layer
|
||||
:disabled-for '(pkg8 pkg9)
|
||||
:can-shadow nil
|
||||
:can-shadow '(layer2 layer3)
|
||||
:variables '(foo bar toto 1)
|
||||
:packages '(pkg1 pkg2 pkg3)
|
||||
:selected-packages 'all
|
||||
|
|
@ -971,13 +990,13 @@
|
|||
:name 'layer
|
||||
:dir spacemacs-start-directory))
|
||||
(layer-specs '(layer :disabled-for pkg8 pkg9
|
||||
:can-shadow nil
|
||||
:can-shadow layer2
|
||||
:variables foo bar toto 1))
|
||||
(layer-packages '(pkg1 pkg2 pkg3)))
|
||||
(should (equal (cfgl-layer "layer"
|
||||
:name 'layer
|
||||
:disabled-for nil
|
||||
:can-shadow t
|
||||
:can-shadow 'unspecified
|
||||
:variables nil
|
||||
:packages nil
|
||||
:selected-packages 'all
|
||||
|
|
@ -988,11 +1007,11 @@
|
|||
(let ((layer (cfgl-layer "layer"
|
||||
:name 'layer
|
||||
:disabled-for '(pkg10)
|
||||
:can-shadow nil
|
||||
:can-shadow '()
|
||||
:variables '(titi tata tutu 1)
|
||||
:dir spacemacs-start-directory))
|
||||
(layer-specs '(layer :disabled-for pkg8 pkg9
|
||||
:can-shadow t
|
||||
:can-shadow layer2
|
||||
:variables foo bar toto 1))
|
||||
(layer-packages '(pkg1 pkg2 pkg3))
|
||||
(mocker-mock-default-record-cls 'mocker-stub-record))
|
||||
|
|
@ -1002,7 +1021,7 @@
|
|||
(should (equal (cfgl-layer "layer"
|
||||
:name 'layer
|
||||
:disabled-for '(pkg8 pkg9)
|
||||
:can-shadow t
|
||||
:can-shadow '(layer2)
|
||||
:variables '(foo bar toto 1)
|
||||
:packages '(pkg1 pkg2 pkg3)
|
||||
:selected-packages 'all
|
||||
|
|
@ -1013,115 +1032,86 @@
|
|||
(let ((layer (cfgl-layer "layer"
|
||||
:name 'layer
|
||||
:disabled-for '(pkg10)
|
||||
:can-shadow nil
|
||||
:can-shadow '()
|
||||
:variables '(titi tata tutu 1)
|
||||
:packages '(pkg1 pkg2 pkg3)
|
||||
:selected-packages 'all
|
||||
:dir spacemacs-start-directory))
|
||||
(layer-specs '(layer :disabled-for pkg8 pkg9
|
||||
:can-shadow t
|
||||
:can-shadow '(layer2)
|
||||
:variables foo bar toto 1))
|
||||
(mocker-mock-default-record-cls 'mocker-stub-record))
|
||||
(should (equal (cfgl-layer "layer"
|
||||
:name 'layer
|
||||
:disabled-for '(pkg10)
|
||||
:can-shadow nil
|
||||
:can-shadow '()
|
||||
:variables '(titi tata tutu 1)
|
||||
:packages '(pkg1 pkg2 pkg3)
|
||||
:selected-packages 'all
|
||||
:dir spacemacs-start-directory)
|
||||
(configuration-layer/make-layer layer-specs layer)))))
|
||||
|
||||
;; shadow layers
|
||||
|
||||
(ert-deftest test-make-layer--by-default-layer-can-shadow-other-layers ()
|
||||
(let ((layer-specs 'layer)
|
||||
(mocker-mock-default-record-cls 'mocker-stub-record))
|
||||
(should
|
||||
(equal (cfgl-layer "layer"
|
||||
:name 'layer
|
||||
:dir spacemacs-start-directory
|
||||
:can-shadow t)
|
||||
(configuration-layer/make-layer layer-specs nil nil
|
||||
spacemacs-start-directory)))))
|
||||
|
||||
(ert-deftest test-make-layer--force-used-layer-to-not-shadow-other-layers ()
|
||||
(let ((layer-specs '(layer :can-shadow nil))
|
||||
(mocker-mock-default-record-cls 'mocker-stub-record))
|
||||
(should
|
||||
(equal (cfgl-layer "layer"
|
||||
:name 'layer
|
||||
:dir spacemacs-start-directory
|
||||
:can-shadow nil)
|
||||
(configuration-layer/make-layer layer-specs nil 'used
|
||||
spacemacs-start-directory)))))
|
||||
(ert-deftest test-make-layer--unused-layer-can-always-shadow-other-layers ()
|
||||
(let ((layer-specs '(layer :can-shadow nil))
|
||||
(mocker-mock-default-record-cls 'mocker-stub-record))
|
||||
(should
|
||||
(equal (cfgl-layer "layer"
|
||||
:name 'layer
|
||||
:dir spacemacs-start-directory
|
||||
:can-shadow t)
|
||||
(configuration-layer/make-layer layer-specs nil nil
|
||||
spacemacs-start-directory)))))
|
||||
|
||||
;; ---------------------------------------------------------------------------
|
||||
;; configuration-layer//shadow-layer
|
||||
;; configuration-layer//declare-shadow-relation
|
||||
;; ---------------------------------------------------------------------------
|
||||
|
||||
(ert-deftest test-shadow-layer--layer-1-shadows-layer2 ()
|
||||
(ert-deftest test-declare-shadow-relation--is-commutative ()
|
||||
(let ((configuration-layer--indexed-layers (make-hash-table :size 1024)))
|
||||
(helper--add-layers
|
||||
`(,(cfgl-layer "layer-shadow-1" :name 'layer-shadow-1)
|
||||
,(cfgl-layer "layer-shadow-2" :name 'layer-shadow-2)))
|
||||
(configuration-layer/shadow-layer 'layer-shadow-1 'layer-shadow-2)
|
||||
(should (equal '(layer-shadow-1)
|
||||
(oref (configuration-layer/get-layer 'layer-shadow-2)
|
||||
:shadowed-by)))))
|
||||
(configuration-layer/declare-shadow-relation
|
||||
'layer-shadow-1
|
||||
'layer-shadow-2)
|
||||
(should (and
|
||||
(equal '(layer-shadow-1) (oref (configuration-layer/get-layer
|
||||
'layer-shadow-2)
|
||||
:can-shadow))
|
||||
(equal '(layer-shadow-2) (oref (configuration-layer/get-layer
|
||||
'layer-shadow-1)
|
||||
:can-shadow))))))
|
||||
|
||||
(ert-deftest test-shadow-layer--layer-2-shadows-layer1-as-well--commutativity ()
|
||||
(ert-deftest test-declare-shadow-relation--is-idempotent ()
|
||||
(let ((configuration-layer--indexed-layers (make-hash-table :size 1024)))
|
||||
(helper--add-layers
|
||||
`(,(cfgl-layer "layer-shadow-1" :name 'layer-shadow-1)
|
||||
,(cfgl-layer "layer-shadow-2" :name 'layer-shadow-2)))
|
||||
(configuration-layer/shadow-layer 'layer-shadow-1 'layer-shadow-2)
|
||||
(should (equal '(layer-shadow-2)
|
||||
(oref (configuration-layer/get-layer 'layer-shadow-1)
|
||||
:shadowed-by)))))
|
||||
|
||||
(ert-deftest test-shadow-layer--idempotency-and-commutatitivity ()
|
||||
(let ((configuration-layer--indexed-layers (make-hash-table :size 1024)))
|
||||
(helper--add-layers
|
||||
`(,(cfgl-layer "layer-shadow-1" :name 'layer-shadow-1)
|
||||
,(cfgl-layer "layer-shadow-2" :name 'layer-shadow-2)))
|
||||
(dotimes (i 2)
|
||||
(configuration-layer/shadow-layer 'layer-shadow-1 'layer-shadow-2))
|
||||
(dotimes (i 2)
|
||||
(configuration-layer/shadow-layer 'layer-shadow-2 'layer-shadow-1))
|
||||
(should (and (equal '(layer-shadow-2)
|
||||
(oref (configuration-layer/get-layer 'layer-shadow-1)
|
||||
:shadowed-by))
|
||||
(equal '(layer-shadow-1)
|
||||
(dotimes (i 3)
|
||||
(configuration-layer/declare-shadow-relation
|
||||
'layer-shadow-1
|
||||
'layer-shadow-2))
|
||||
(dotimes (i 3)
|
||||
(configuration-layer/declare-shadow-relation
|
||||
'layer-shadow-2
|
||||
'layer-shadow-1))
|
||||
(should (and (equal '(layer-shadow-1)
|
||||
(oref (configuration-layer/get-layer 'layer-shadow-2)
|
||||
:shadowed-by))))))
|
||||
:can-shadow))
|
||||
(equal '(layer-shadow-2)
|
||||
(oref (configuration-layer/get-layer 'layer-shadow-1)
|
||||
:can-shadow))))))
|
||||
|
||||
(ert-deftest test-shadow-layer--layer-1-shadows-multiple-layers ()
|
||||
(ert-deftest test-declare-shadow-relation--layer-1-shadows-multiple-layers ()
|
||||
(let ((configuration-layer--indexed-layers (make-hash-table :size 1024)))
|
||||
(helper--add-layers
|
||||
`(,(cfgl-layer "layer-shadow-1" :name 'layer-shadow-1)
|
||||
,(cfgl-layer "layer-shadow-2" :name 'layer-shadow-2)
|
||||
,(cfgl-layer "layer-shadow-3" :name 'layer-shadow-3)))
|
||||
(configuration-layer/shadow-layer 'layer-shadow-1 'layer-shadow-2)
|
||||
(configuration-layer/shadow-layer 'layer-shadow-1 'layer-shadow-3)
|
||||
(should (and (equal '(layer-shadow-1)
|
||||
(oref (configuration-layer/get-layer 'layer-shadow-2)
|
||||
:shadowed-by))
|
||||
(equal '(layer-shadow-1)
|
||||
(oref (configuration-layer/get-layer 'layer-shadow-3)
|
||||
:shadowed-by))))))
|
||||
(configuration-layer/declare-shadow-relation
|
||||
'layer-shadow-1
|
||||
'layer-shadow-2
|
||||
'layer-shadow-3)
|
||||
(should (equal '(layer-shadow-1)
|
||||
(oref (configuration-layer/get-layer 'layer-shadow-2)
|
||||
:can-shadow)))
|
||||
(should (equal '(layer-shadow-1)
|
||||
(oref (configuration-layer/get-layer 'layer-shadow-3)
|
||||
:can-shadow)))
|
||||
(should (equal '(layer-shadow-3 layer-shadow-2)
|
||||
(oref (configuration-layer/get-layer 'layer-shadow-1)
|
||||
:can-shadow)))))
|
||||
|
||||
(ert-deftest test-shadow-layer--unknown-layer-shadows-existing-layer ()
|
||||
(ert-deftest test-declare-shadow-relation--unknown-layer-shadows-known-layer ()
|
||||
(let ((configuration-layer--indexed-layers (make-hash-table :size 1024)))
|
||||
(helper--add-layers
|
||||
`(,(cfgl-layer "layer-shadow-2" :name 'layer-shadow-2)))
|
||||
|
|
@ -1129,11 +1119,14 @@
|
|||
((configuration-layer//warning
|
||||
(msg &rest args)
|
||||
((:record-cls 'mocker-stub-record :output nil :occur 1))))
|
||||
(configuration-layer/shadow-layer 'layer-shadow-1 'layer-shadow-2)
|
||||
(should (null (oref (configuration-layer/get-layer 'layer-shadow-2)
|
||||
:shadowed-by))))))
|
||||
(configuration-layer/declare-shadow-relation
|
||||
'layer-shadow-1
|
||||
'layer-shadow-2)
|
||||
(should (eq 'unspecified
|
||||
(oref (configuration-layer/get-layer 'layer-shadow-2)
|
||||
:can-shadow))))))
|
||||
|
||||
(ert-deftest test-shadow-layer--existing-layer-shadows-non-existing-layer ()
|
||||
(ert-deftest test-declare-shadow-relation--known-layer-shadows-unknown-layer ()
|
||||
(let ((configuration-layer--indexed-layers (make-hash-table :size 1024)))
|
||||
(helper--add-layers
|
||||
`(,(cfgl-layer "layer-shadow-1" :name 'layer-shadow-1)))
|
||||
|
|
@ -1141,15 +1134,15 @@
|
|||
((configuration-layer//warning
|
||||
(msg &rest args)
|
||||
((:record-cls 'mocker-stub-record :output nil :occur 1))))
|
||||
(configuration-layer/shadow-layer 'layer-shadow-1 'layer-shadow-2))))
|
||||
(configuration-layer/declare-shadow-relation 'layer-shadow-1 'layer-shadow-2))))
|
||||
|
||||
(ert-deftest test-shadow-layer--unknown-layer-shadows-unknown-layer ()
|
||||
(ert-deftest test-declare-shadow-relation--unknown-layer-shadows-unknown-layer ()
|
||||
(let ((configuration-layer--indexed-layers (make-hash-table :size 1024)))
|
||||
(mocker-let
|
||||
((configuration-layer//warning
|
||||
(msg &rest args)
|
||||
((:record-cls 'mocker-stub-record :output nil :occur 2))))
|
||||
(configuration-layer/shadow-layer 'layer-shadow-1 'layer-shadow-2))))
|
||||
(configuration-layer/declare-shadow-relation 'layer-shadow-1 'layer-shadow-2))))
|
||||
|
||||
;; ---------------------------------------------------------------------------
|
||||
;; configuration-layer//set-layers-variables
|
||||
|
|
|
|||
Loading…
Reference in New Issue