mirror of
https://git.savannah.gnu.org/git/emacs.git
synced 2024-12-24 10:38:38 +00:00
Fix Bug#32090
* lisp/files-x.el (connection-local-normalize-criteria): Do not use PROPERTIES anymore. (connection-local-get-profiles): Rewrite, in order to accept any property as optional. (Bug#32090) (connection-local-set-profiles): Adapt ´connection-local-normalize-criteria' call. * test/lisp/files-x-tests.el (files-x-test-connection-local-set-profiles) (files-x-test-hack-connection-local-variables-apply): Extend tests.
This commit is contained in:
parent
848f0f73e9
commit
917158f8c9
@ -578,31 +578,33 @@ strings. All properties are optional; if CRITERIA is nil, it
|
|||||||
always applies.
|
always applies.
|
||||||
PROFILES is a list of connection profiles (symbols).")
|
PROFILES is a list of connection profiles (symbols).")
|
||||||
|
|
||||||
(defsubst connection-local-normalize-criteria (criteria &rest properties)
|
(defsubst connection-local-normalize-criteria (criteria)
|
||||||
"Normalize plist CRITERIA according to PROPERTIES.
|
"Normalize plist CRITERIA according to properties.
|
||||||
Return a new ordered plist list containing only property names from PROPERTIES."
|
Return a reordered plist."
|
||||||
(delq
|
(apply
|
||||||
nil
|
'append
|
||||||
(mapcar
|
(mapcar
|
||||||
(lambda (property)
|
(lambda (property)
|
||||||
(when (and (plist-member criteria property) (plist-get criteria property))
|
(when (and (plist-member criteria property) (plist-get criteria property))
|
||||||
(list property (plist-get criteria property))))
|
(list property (plist-get criteria property))))
|
||||||
properties)))
|
'(:application :protocol :user :machine))))
|
||||||
|
|
||||||
(defsubst connection-local-get-profiles (criteria)
|
(defsubst connection-local-get-profiles (criteria)
|
||||||
"Return the connection profiles list for CRITERIA.
|
"Return the connection profiles list for CRITERIA.
|
||||||
CRITERIA is a plist identifying a connection and the application
|
CRITERIA is a plist identifying a connection and the application
|
||||||
using this connection, see `connection-local-criteria-alist'."
|
using this connection, see `connection-local-criteria-alist'."
|
||||||
(or (cdr
|
(let (profiles)
|
||||||
(assoc
|
(dolist (crit-alist connection-local-criteria-alist)
|
||||||
(connection-local-normalize-criteria
|
(let ((crit criteria)
|
||||||
criteria :application :protocol :user :machine)
|
(match t))
|
||||||
connection-local-criteria-alist))
|
(while (and crit match)
|
||||||
;; Try it without :application.
|
(when (plist-member (car crit-alist) (car crit))
|
||||||
(cdr
|
(setq match (equal (plist-get (car crit-alist) (car crit))
|
||||||
(assoc
|
(plist-get criteria (car crit)))))
|
||||||
(connection-local-normalize-criteria criteria :protocol :user :machine)
|
(setq crit (cddr crit)))
|
||||||
connection-local-criteria-alist))))
|
(when match
|
||||||
|
(setq profiles (append profiles (cdr crit-alist))))))
|
||||||
|
(delete-dups profiles)))
|
||||||
|
|
||||||
;;;###autoload
|
;;;###autoload
|
||||||
(defun connection-local-set-profiles (criteria &rest profiles)
|
(defun connection-local-set-profiles (criteria &rest profiles)
|
||||||
@ -621,8 +623,7 @@ variables for a connection profile are defined using
|
|||||||
(dolist (profile profiles)
|
(dolist (profile profiles)
|
||||||
(unless (assq profile connection-local-profile-alist)
|
(unless (assq profile connection-local-profile-alist)
|
||||||
(error "No such connection profile `%s'" (symbol-name profile))))
|
(error "No such connection profile `%s'" (symbol-name profile))))
|
||||||
(let* ((criteria (connection-local-normalize-criteria
|
(let* ((criteria (connection-local-normalize-criteria criteria))
|
||||||
criteria :application :protocol :user :machine))
|
|
||||||
(slot (assoc criteria connection-local-criteria-alist)))
|
(slot (assoc criteria connection-local-criteria-alist)))
|
||||||
(if slot
|
(if slot
|
||||||
(setcdr slot (delete-dups (append (cdr slot) profiles)))
|
(setcdr slot (delete-dups (append (cdr slot) profiles)))
|
||||||
|
@ -101,15 +101,19 @@
|
|||||||
(setq files-x-test--criteria
|
(setq files-x-test--criteria
|
||||||
(append files-x-test--application files-x-test--protocol
|
(append files-x-test--application files-x-test--protocol
|
||||||
files-x-test--user files-x-test--machine))
|
files-x-test--user files-x-test--machine))
|
||||||
|
|
||||||
;; An empty variable list is accepted (but makes no sense).
|
;; An empty variable list is accepted (but makes no sense).
|
||||||
(connection-local-set-profiles files-x-test--criteria)
|
(connection-local-set-profiles files-x-test--criteria)
|
||||||
(should-not (connection-local-get-profiles files-x-test--criteria))
|
(should-not (connection-local-get-profiles files-x-test--criteria))
|
||||||
|
|
||||||
|
;; First test, all declared properties.
|
||||||
(connection-local-set-profiles
|
(connection-local-set-profiles
|
||||||
files-x-test--criteria 'remote-bash 'remote-ksh)
|
files-x-test--criteria 'remote-bash 'remote-ksh)
|
||||||
(should
|
(should
|
||||||
(equal
|
(equal
|
||||||
(connection-local-get-profiles files-x-test--criteria)
|
(connection-local-get-profiles files-x-test--criteria)
|
||||||
'(remote-bash remote-ksh)))
|
'(remote-bash remote-ksh)))
|
||||||
|
|
||||||
;; Changing the order of properties doesn't matter.
|
;; Changing the order of properties doesn't matter.
|
||||||
(setq files-x-test--criteria
|
(setq files-x-test--criteria
|
||||||
(append files-x-test--protocol files-x-test--application
|
(append files-x-test--protocol files-x-test--application
|
||||||
@ -118,12 +122,14 @@
|
|||||||
(equal
|
(equal
|
||||||
(connection-local-get-profiles files-x-test--criteria)
|
(connection-local-get-profiles files-x-test--criteria)
|
||||||
'(remote-bash remote-ksh)))
|
'(remote-bash remote-ksh)))
|
||||||
;; A further call adds profiles.
|
|
||||||
|
;; A further call adds profiles.
|
||||||
(connection-local-set-profiles files-x-test--criteria 'remote-nullfile)
|
(connection-local-set-profiles files-x-test--criteria 'remote-nullfile)
|
||||||
(should
|
(should
|
||||||
(equal
|
(equal
|
||||||
(connection-local-get-profiles files-x-test--criteria)
|
(connection-local-get-profiles files-x-test--criteria)
|
||||||
'(remote-bash remote-ksh remote-nullfile)))
|
'(remote-bash remote-ksh remote-nullfile)))
|
||||||
|
|
||||||
;; Adding existing profiles doesn't matter.
|
;; Adding existing profiles doesn't matter.
|
||||||
(connection-local-set-profiles
|
(connection-local-set-profiles
|
||||||
files-x-test--criteria 'remote-bash 'remote-nullfile)
|
files-x-test--criteria 'remote-bash 'remote-nullfile)
|
||||||
@ -132,31 +138,38 @@
|
|||||||
(connection-local-get-profiles files-x-test--criteria)
|
(connection-local-get-profiles files-x-test--criteria)
|
||||||
'(remote-bash remote-ksh remote-nullfile)))
|
'(remote-bash remote-ksh remote-nullfile)))
|
||||||
|
|
||||||
;; Use a criteria without application.
|
;; Use different properties.
|
||||||
(setq files-x-test--criteria
|
(dolist (criteria
|
||||||
(append files-x-test--protocol
|
`(;; All properties.
|
||||||
files-x-test--user files-x-test--machine))
|
,(append files-x-test--application files-x-test--protocol
|
||||||
(connection-local-set-profiles files-x-test--criteria 'remote-ksh)
|
files-x-test--user files-x-test--machine)
|
||||||
(should
|
;; Without :application.
|
||||||
(equal
|
,(append files-x-test--protocol
|
||||||
(connection-local-get-profiles files-x-test--criteria)
|
files-x-test--user files-x-test--machine)
|
||||||
'(remote-ksh)))
|
;; Without :protocol.
|
||||||
;; An application not used in any registered criteria matches also this.
|
,(append files-x-test--application
|
||||||
(setq files-x-test--criteria
|
files-x-test--user files-x-test--machine)
|
||||||
(append files-x-test--another-application files-x-test--protocol
|
;; Without :user.
|
||||||
files-x-test--user files-x-test--machine))
|
,(append files-x-test--application files-x-test--protocol
|
||||||
(should
|
files-x-test--machine)
|
||||||
(equal
|
;; Without :machine.
|
||||||
(connection-local-get-profiles files-x-test--criteria)
|
,(append files-x-test--application files-x-test--protocol
|
||||||
'(remote-ksh)))
|
files-x-test--user)
|
||||||
|
;; No property at all.
|
||||||
|
nil))
|
||||||
|
(should
|
||||||
|
(equal
|
||||||
|
(connection-local-get-profiles criteria)
|
||||||
|
'(remote-bash remote-ksh remote-nullfile))))
|
||||||
|
|
||||||
;; Using a nil criteria also works. Duplicate profiles are trashed.
|
;; Using a nil criteria also works. Duplicate profiles are trashed.
|
||||||
(connection-local-set-profiles
|
(connection-local-set-profiles
|
||||||
nil 'remote-bash 'remote-ksh 'remote-ksh 'remote-bash)
|
nil 'remote-bash 'remote-ksh 'remote-ksh 'remote-bash)
|
||||||
|
;; This matches also the existing profiles from other criteria.
|
||||||
(should
|
(should
|
||||||
(equal
|
(equal
|
||||||
(connection-local-get-profiles nil)
|
(connection-local-get-profiles nil)
|
||||||
'(remote-bash remote-ksh)))
|
'(remote-bash remote-ksh remote-nullfile)))
|
||||||
|
|
||||||
;; A criteria other than plist is wrong.
|
;; A criteria other than plist is wrong.
|
||||||
(should-error (connection-local-set-profiles 'dummy))))
|
(should-error (connection-local-set-profiles 'dummy))))
|
||||||
@ -235,7 +248,9 @@
|
|||||||
;; declare same variables as in `remote-bash'.
|
;; declare same variables as in `remote-bash'.
|
||||||
(should
|
(should
|
||||||
(equal connection-local-variables-alist
|
(equal connection-local-variables-alist
|
||||||
(nreverse (copy-tree files-x-test--variables1))))
|
(append
|
||||||
|
(nreverse (copy-tree files-x-test--variables3))
|
||||||
|
(nreverse (copy-tree files-x-test--variables1)))))
|
||||||
;; The variables exist also as local variables.
|
;; The variables exist also as local variables.
|
||||||
(should (local-variable-p 'remote-shell-file-name))
|
(should (local-variable-p 'remote-shell-file-name))
|
||||||
;; The proper variable value is set.
|
;; The proper variable value is set.
|
||||||
|
Loading…
Reference in New Issue
Block a user