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 2017-09-25 22:55:08 -04:00
parent ecf6faedb7
commit dc58801c7d
4 changed files with 174 additions and 149 deletions

View File

@ -116,15 +116,18 @@ ROOT is returned."
:initform 'unspecified :initform 'unspecified
:type (satisfies (lambda (x) (or (listp x) (eq 'unspecified x)))) :type (satisfies (lambda (x) (or (listp x) (eq 'unspecified x))))
:documentation :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 (can-shadow :initarg :can-shadow
:initform t :initform 'unspecified
:type boolean :type (satisfies (lambda (x) (or (listp x) (eq 'unspecified x))))
:documentation "If non-nil this layer can shadow other layers.") :documentation "A list of layers this layer can shadow."))
(shadowed-by :initarg :shadowed-by
:initform nil
:type list
:documentation "A list of layers that can shadow this layer."))
"A configuration layer.") "A configuration layer.")
(defmethod cfgl-layer-owned-packages ((layer cfgl-layer) &optional props) (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." "Accept nil as argument and return nil."
nil) nil)
(defmethod cfgl-layer-shadowed-p ((layer cfgl-layer)) (defmethod cfgl-layer-get-shadowing-layers ((layer cfgl-layer))
"Return the list of layers that shadow LAYER." "Return the list of used layers that shadow LAYER."
(let ((rank (cl-position (oref layer :name) configuration-layer--used-layers)) (let ((rank (cl-position (oref layer :name) configuration-layer--used-layers))
(shadow-candidates (oref layer :can-shadow))
shadowing-layers) shadowing-layers)
(when (numberp rank) (when (and (numberp rank)
(not (eq 'unspecified shadow-candidates))
(listp shadow-candidates))
(mapcar (mapcar
(lambda (other) (lambda (other)
(let ((orank (cl-position other configuration-layer--used-layers))) (let ((orank (cl-position other configuration-layer--used-layers)))
;; LAYER is shadowed by OTHER if and only if its rank is lower than ;; OTHER shadows LAYER if and only if OTHER's rank is bigger than
;; OTHER's rank. ;; LAYER's rank.
(when (and (numberp orank) (< rank orank)) (when (and (numberp orank) (< rank orank))
(add-to-list 'shadowing-layers other)))) (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)) shadowing-layers))
(defmethod cfgl-layer-get-packages ((layer cfgl-layer) &optional props) (defmethod cfgl-layer-get-packages ((layer cfgl-layer) &optional props)
"Return the list of packages for LAYER. "Return the list of packages for LAYER.
If PROPS is non-nil then return packages as lists along with their properties. If PROPS is non-nil then return packages as lists along with their properties."
Returns nil if the layer is shadowed by a layer."
(let ((all (eq 'all (oref layer :selected-packages)))) (let ((all (eq 'all (oref layer :selected-packages))))
(delq nil (mapcar (delq nil (mapcar
(lambda (x) (lambda (x)
@ -626,10 +634,10 @@ If USEDP or `configuration-layer--load-packages-files' is non-nil then the
'unspecified)) 'unspecified))
(variables (when (listp layer-specs) (variables (when (listp layer-specs)
(spacemacs/mplist-get layer-specs :variables))) (spacemacs/mplist-get layer-specs :variables)))
(can-shadow (shadow
(if (and (listp layer-specs) (if (and (listp layer-specs)
(memq :can-shadow layer-specs)) (memq :can-shadow layer-specs))
(nth 0 (spacemacs/mplist-get layer-specs :can-shadow)) (spacemacs/mplist-get layer-specs :can-shadow)
'unspecified)) 'unspecified))
(packages-file (concat dir "packages.el")) (packages-file (concat dir "packages.el"))
(packages (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 :disabled-for disabled)
(oset obj :enabled-for enabled) (oset obj :enabled-for enabled)
(oset obj :variables variables) (oset obj :variables variables)
(unless (eq 'unspecified can-shadow) (unless (eq 'unspecified shadow)
(oset obj :can-shadow can-shadow))) (oset obj :can-shadow shadow)))
(when packages (when packages
(oset obj :packages packages) (oset obj :packages packages)
(oset obj :selected-packages selected-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." USEDP if non-nil indicates that made packages are used packages."
(dolist (layer-name layer-names) (dolist (layer-name layer-names)
(let* ((layer (configuration-layer/get-layer layer-name)) (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 (if shadowed-by
(spacemacs-buffer/message (spacemacs-buffer/message
"Ignoring layer '%s' because it is shadowed by layer(s) '%s'." "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 distribution)))
(configuration-layer/declare-layer 'spacemacs-bootstrap))) (configuration-layer/declare-layer 'spacemacs-bootstrap)))
(defun configuration-layer/shadow-layers (layer-name shadowed-layers) (defun configuration-layer/declare-shadow-relation (layer-name &rest onames)
"Declare LAYER-NAME to shadow SHADOWED-LAYERS. "Declare 'can-shadow' relationship between LAYER_NAME and OTHER-NAMES layers.
LAYER-NAME is a the name symbol of an existing layer. LAYER-NAME is the name symbol of an existing layer.
SHADOWED-LAYERS is a list of layer name symbols." ONAMES is a list of other layer name symbols."
(mapc (lambda (x) (dolist (o onames)
(configuration-layer/shadow-layer layer-name x)) (configuration-layer//declare-shadow-relation layer-name o)))
shadowed-layers))
(defun configuration-layer/shadow-layer (layer-name shadowed-layer-name) (defun configuration-layer//declare-shadow-relation (lname rname)
"Declare LAYER-NAME to shadow SHADOWED-LAYER. "Declare 'can-shadow' relationship between LAYER_NAME and OTHER-NAMES layers.
LAYER-NAME is a the name symbol of an existing layer. LNAME is the name symbol of an existing layer.
SHADOWED-LAYER-NAME is the name symbol of an existing layer." RNAME is the name symbol of another existing layer."
(let* ((layer (configuration-layer/get-layer layer-name)) (let ((llayer (configuration-layer/get-layer lname))
(shadowed-layer (configuration-layer/get-layer shadowed-layer-name))) (rlayer (configuration-layer/get-layer rname)))
(if (and layer shadowed-layer) (if (and llayer rlayer)
(progn (let ((lshadow (oref llayer :can-shadow))
;; note: shadowing is commutative (rshadow (oref rlayer :can-shadow)))
(cl-pushnew layer-name (oref shadowed-layer :shadowed-by)) ;; lhs of the relation
(cl-pushnew shadowed-layer-name (oref layer :shadowed-by))) (cond
;; cannot find one or both layers ((eq 'unspecified lshadow)
(if (null layer) (when rshadow
(configuration-layer//warning "Unknown layer %s to shadow %s." (oset llayer :can-shadow `(,rname))))
layer-name shadowed-layer-name)) ((and lshadow (listp lshadow))
(if (null shadowed-layer) (when rshadow
(configuration-layer//warning "Unknown shadowed layer %s by %s." (cl-pushnew rname (oref llayer :can-shadow))))
shadowed-layer-name layer-name))))) ((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) (defun configuration-layer//set-layers-variables (layers)
"Set the configuration variables for the passed 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." "Return non-nil if LAYER-NAME is the name of a used and non-shadowed layer."
(or (eq 'dotfile layer-name) (or (eq 'dotfile layer-name)
(let ((obj (configuration-layer/get-layer 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)))))) (memq layer-name configuration-layer--used-layers))))))
(defalias 'configuration-layer/layer-usedp (defalias 'configuration-layer/layer-usedp
'configuration-layer/layer-used-p) 'configuration-layer/layer-used-p)

View File

@ -9,4 +9,4 @@
;; ;;
;;; License: GPLv3 ;;; License: GPLv3
(configuration-layer/shadow-layer 'helm 'ivy) (configuration-layer/declare-shadow-relation 'helm 'ivy)

View File

@ -9,7 +9,7 @@
;; ;;
;;; License: GPLv3 ;;; 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 ;; smex is handled by the `ivy' layer and we don't want
;; to use the ownership mechanism of layers because it is dependent ;; to use the ownership mechanism of layers because it is dependent

View File

@ -170,29 +170,48 @@
:selected-packages '(pkg-unknown)))) :selected-packages '(pkg-unknown))))
(should (null (cfgl-layer-get-packages layer))))) (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)) (let ((layer1 (cfgl-layer "layer1" :name 'layer1))
(layer2 (cfgl-layer "layer2" :name 'layer2)) (layer2 (cfgl-layer "layer2" :name 'layer2))
(configuration-layer--used-layers nil) (configuration-layer--used-layers nil)
(configuration-layer--indexed-layers (make-hash-table :size 1024))) (configuration-layer--indexed-layers (make-hash-table :size 1024)))
(helper--add-layers `(,layer1 ,layer2) 'used) (helper--add-layers `(,layer1 ,layer2) 'used)
(configuration-layer/shadow-layer 'layer2 'layer1) (configuration-layer/declare-shadow-relation 'layer1 'layer2)
(should (and (equal '(layer2) (cfgl-layer-shadowed-p layer1)) (should (and (equal '(layer2) (cfgl-layer-get-shadowing-layers layer1))
(not (cfgl-layer-shadowed-p layer2)))))) (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)) (let ((layer1 (cfgl-layer "layer1" :name 'layer1))
(layer2 (cfgl-layer "layer2" :name 'layer2)) (layer2 (cfgl-layer "layer2" :name 'layer2))
(configuration-layer--used-layers nil) (configuration-layer--used-layers nil)
(configuration-layer--indexed-layers (make-hash-table :size 1024))) (configuration-layer--indexed-layers (make-hash-table :size 1024)))
;; we just switched the order of used layers (helper--add-layers `(,layer1 ,layer2) 'used)
;; remember, shadowing is commutative (configuration-layer/declare-shadow-relation 'layer1 'layer2)
(helper--add-layers `(,layer2 ,layer1) 'used) (should (and (equal '(layer2) (cfgl-layer-get-shadowing-layers layer1))
(configuration-layer/shadow-layer 'layer2 'layer1) (equal '() (cfgl-layer-get-shadowing-layers layer2))))))
(should (and (equal '(layer1) (cfgl-layer-shadowed-p layer2))
(not (cfgl-layer-shadowed-p layer1)))))) (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 ;; configuration-layer/layer-used-p
@ -218,7 +237,7 @@
configuration-layer--used-layers configuration-layer--used-layers
(configuration-layer--indexed-layers (make-hash-table :size 1024))) (configuration-layer--indexed-layers (make-hash-table :size 1024)))
(helper--add-layers `(,usedlayer1 ,usedlayer2) 'used) (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))))) (should (not (configuration-layer/layer-used-p 'usedlayer1)))))
(ert-deftest test-layer-used-p--dotfile-layer-is-always-used () (ert-deftest test-layer-used-p--dotfile-layer-is-always-used ()
@ -949,7 +968,7 @@
:name 'layer :name 'layer
:dir spacemacs-start-directory)) :dir spacemacs-start-directory))
(layer-specs '(layer :disabled-for pkg8 pkg9 (layer-specs '(layer :disabled-for pkg8 pkg9
:can-shadow nil :can-shadow layer2 layer3
:variables foo bar toto 1)) :variables foo bar toto 1))
(layer-packages '(pkg1 pkg2 pkg3)) (layer-packages '(pkg1 pkg2 pkg3))
(mocker-mock-default-record-cls 'mocker-stub-record)) (mocker-mock-default-record-cls 'mocker-stub-record))
@ -959,7 +978,7 @@
(should (equal (cfgl-layer "layer" (should (equal (cfgl-layer "layer"
:name 'layer :name 'layer
:disabled-for '(pkg8 pkg9) :disabled-for '(pkg8 pkg9)
:can-shadow nil :can-shadow '(layer2 layer3)
:variables '(foo bar toto 1) :variables '(foo bar toto 1)
:packages '(pkg1 pkg2 pkg3) :packages '(pkg1 pkg2 pkg3)
:selected-packages 'all :selected-packages 'all
@ -971,13 +990,13 @@
:name 'layer :name 'layer
:dir spacemacs-start-directory)) :dir spacemacs-start-directory))
(layer-specs '(layer :disabled-for pkg8 pkg9 (layer-specs '(layer :disabled-for pkg8 pkg9
:can-shadow nil :can-shadow layer2
:variables foo bar toto 1)) :variables foo bar toto 1))
(layer-packages '(pkg1 pkg2 pkg3))) (layer-packages '(pkg1 pkg2 pkg3)))
(should (equal (cfgl-layer "layer" (should (equal (cfgl-layer "layer"
:name 'layer :name 'layer
:disabled-for nil :disabled-for nil
:can-shadow t :can-shadow 'unspecified
:variables nil :variables nil
:packages nil :packages nil
:selected-packages 'all :selected-packages 'all
@ -988,11 +1007,11 @@
(let ((layer (cfgl-layer "layer" (let ((layer (cfgl-layer "layer"
:name 'layer :name 'layer
:disabled-for '(pkg10) :disabled-for '(pkg10)
:can-shadow nil :can-shadow '()
:variables '(titi tata tutu 1) :variables '(titi tata tutu 1)
:dir spacemacs-start-directory)) :dir spacemacs-start-directory))
(layer-specs '(layer :disabled-for pkg8 pkg9 (layer-specs '(layer :disabled-for pkg8 pkg9
:can-shadow t :can-shadow layer2
:variables foo bar toto 1)) :variables foo bar toto 1))
(layer-packages '(pkg1 pkg2 pkg3)) (layer-packages '(pkg1 pkg2 pkg3))
(mocker-mock-default-record-cls 'mocker-stub-record)) (mocker-mock-default-record-cls 'mocker-stub-record))
@ -1002,7 +1021,7 @@
(should (equal (cfgl-layer "layer" (should (equal (cfgl-layer "layer"
:name 'layer :name 'layer
:disabled-for '(pkg8 pkg9) :disabled-for '(pkg8 pkg9)
:can-shadow t :can-shadow '(layer2)
:variables '(foo bar toto 1) :variables '(foo bar toto 1)
:packages '(pkg1 pkg2 pkg3) :packages '(pkg1 pkg2 pkg3)
:selected-packages 'all :selected-packages 'all
@ -1013,115 +1032,86 @@
(let ((layer (cfgl-layer "layer" (let ((layer (cfgl-layer "layer"
:name 'layer :name 'layer
:disabled-for '(pkg10) :disabled-for '(pkg10)
:can-shadow nil :can-shadow '()
:variables '(titi tata tutu 1) :variables '(titi tata tutu 1)
:packages '(pkg1 pkg2 pkg3) :packages '(pkg1 pkg2 pkg3)
:selected-packages 'all :selected-packages 'all
:dir spacemacs-start-directory)) :dir spacemacs-start-directory))
(layer-specs '(layer :disabled-for pkg8 pkg9 (layer-specs '(layer :disabled-for pkg8 pkg9
:can-shadow t :can-shadow '(layer2)
:variables foo bar toto 1)) :variables foo bar toto 1))
(mocker-mock-default-record-cls 'mocker-stub-record)) (mocker-mock-default-record-cls 'mocker-stub-record))
(should (equal (cfgl-layer "layer" (should (equal (cfgl-layer "layer"
:name 'layer :name 'layer
:disabled-for '(pkg10) :disabled-for '(pkg10)
:can-shadow nil :can-shadow '()
:variables '(titi tata tutu 1) :variables '(titi tata tutu 1)
:packages '(pkg1 pkg2 pkg3) :packages '(pkg1 pkg2 pkg3)
:selected-packages 'all :selected-packages 'all
:dir spacemacs-start-directory) :dir spacemacs-start-directory)
(configuration-layer/make-layer layer-specs layer))))) (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))) (let ((configuration-layer--indexed-layers (make-hash-table :size 1024)))
(helper--add-layers (helper--add-layers
`(,(cfgl-layer "layer-shadow-1" :name 'layer-shadow-1) `(,(cfgl-layer "layer-shadow-1" :name 'layer-shadow-1)
,(cfgl-layer "layer-shadow-2" :name 'layer-shadow-2))) ,(cfgl-layer "layer-shadow-2" :name 'layer-shadow-2)))
(configuration-layer/shadow-layer 'layer-shadow-1 'layer-shadow-2) (configuration-layer/declare-shadow-relation
(should (equal '(layer-shadow-1) 'layer-shadow-1
(oref (configuration-layer/get-layer 'layer-shadow-2) 'layer-shadow-2)
:shadowed-by))))) (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))) (let ((configuration-layer--indexed-layers (make-hash-table :size 1024)))
(helper--add-layers (helper--add-layers
`(,(cfgl-layer "layer-shadow-1" :name 'layer-shadow-1) `(,(cfgl-layer "layer-shadow-1" :name 'layer-shadow-1)
,(cfgl-layer "layer-shadow-2" :name 'layer-shadow-2))) ,(cfgl-layer "layer-shadow-2" :name 'layer-shadow-2)))
(configuration-layer/shadow-layer 'layer-shadow-1 'layer-shadow-2) (dotimes (i 3)
(should (equal '(layer-shadow-2) (configuration-layer/declare-shadow-relation
(oref (configuration-layer/get-layer 'layer-shadow-1) 'layer-shadow-1
:shadowed-by))))) 'layer-shadow-2))
(dotimes (i 3)
(ert-deftest test-shadow-layer--idempotency-and-commutatitivity () (configuration-layer/declare-shadow-relation
(let ((configuration-layer--indexed-layers (make-hash-table :size 1024))) 'layer-shadow-2
(helper--add-layers 'layer-shadow-1))
`(,(cfgl-layer "layer-shadow-1" :name 'layer-shadow-1) (should (and (equal '(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)
(oref (configuration-layer/get-layer 'layer-shadow-2) (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))) (let ((configuration-layer--indexed-layers (make-hash-table :size 1024)))
(helper--add-layers (helper--add-layers
`(,(cfgl-layer "layer-shadow-1" :name 'layer-shadow-1) `(,(cfgl-layer "layer-shadow-1" :name 'layer-shadow-1)
,(cfgl-layer "layer-shadow-2" :name 'layer-shadow-2) ,(cfgl-layer "layer-shadow-2" :name 'layer-shadow-2)
,(cfgl-layer "layer-shadow-3" :name 'layer-shadow-3))) ,(cfgl-layer "layer-shadow-3" :name 'layer-shadow-3)))
(configuration-layer/shadow-layer 'layer-shadow-1 'layer-shadow-2) (configuration-layer/declare-shadow-relation
(configuration-layer/shadow-layer 'layer-shadow-1 'layer-shadow-3) 'layer-shadow-1
(should (and (equal '(layer-shadow-1) 'layer-shadow-2
(oref (configuration-layer/get-layer 'layer-shadow-2) 'layer-shadow-3)
:shadowed-by)) (should (equal '(layer-shadow-1)
(equal '(layer-shadow-1) (oref (configuration-layer/get-layer 'layer-shadow-2)
(oref (configuration-layer/get-layer 'layer-shadow-3) :can-shadow)))
:shadowed-by)))))) (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))) (let ((configuration-layer--indexed-layers (make-hash-table :size 1024)))
(helper--add-layers (helper--add-layers
`(,(cfgl-layer "layer-shadow-2" :name 'layer-shadow-2))) `(,(cfgl-layer "layer-shadow-2" :name 'layer-shadow-2)))
@ -1129,11 +1119,14 @@
((configuration-layer//warning ((configuration-layer//warning
(msg &rest args) (msg &rest args)
((:record-cls 'mocker-stub-record :output nil :occur 1)))) ((:record-cls 'mocker-stub-record :output nil :occur 1))))
(configuration-layer/shadow-layer 'layer-shadow-1 'layer-shadow-2) (configuration-layer/declare-shadow-relation
(should (null (oref (configuration-layer/get-layer 'layer-shadow-2) 'layer-shadow-1
:shadowed-by)))))) '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))) (let ((configuration-layer--indexed-layers (make-hash-table :size 1024)))
(helper--add-layers (helper--add-layers
`(,(cfgl-layer "layer-shadow-1" :name 'layer-shadow-1))) `(,(cfgl-layer "layer-shadow-1" :name 'layer-shadow-1)))
@ -1141,15 +1134,15 @@
((configuration-layer//warning ((configuration-layer//warning
(msg &rest args) (msg &rest args)
((:record-cls 'mocker-stub-record :output nil :occur 1)))) ((: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))) (let ((configuration-layer--indexed-layers (make-hash-table :size 1024)))
(mocker-let (mocker-let
((configuration-layer//warning ((configuration-layer//warning
(msg &rest args) (msg &rest args)
((:record-cls 'mocker-stub-record :output nil :occur 2)))) ((: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 ;; configuration-layer//set-layers-variables