1
0
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:
Michael Albinus 2018-07-09 16:03:49 +02:00
parent 848f0f73e9
commit 917158f8c9
2 changed files with 54 additions and 38 deletions

View File

@ -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)))

View File

@ -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.