Commit 917158f8 authored by Michael Albinus's avatar Michael Albinus

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.
parent 848f0f73
......@@ -578,31 +578,33 @@ strings. All properties are optional; if CRITERIA is nil, it
always applies.
PROFILES is a list of connection profiles (symbols).")
(defsubst connection-local-normalize-criteria (criteria &rest properties)
"Normalize plist CRITERIA according to PROPERTIES.
Return a new ordered plist list containing only property names from PROPERTIES."
(delq
nil
(defsubst connection-local-normalize-criteria (criteria)
"Normalize plist CRITERIA according to properties.
Return a reordered plist."
(apply
'append
(mapcar
(lambda (property)
(when (and (plist-member criteria property) (plist-get criteria property))
(list property (plist-get criteria property))))
properties)))
'(:application :protocol :user :machine))))
(defsubst connection-local-get-profiles (criteria)
"Return the connection profiles list for CRITERIA.
CRITERIA is a plist identifying a connection and the application
using this connection, see `connection-local-criteria-alist'."
(or (cdr
(assoc
(connection-local-normalize-criteria
criteria :application :protocol :user :machine)
connection-local-criteria-alist))
;; Try it without :application.
(cdr
(assoc
(connection-local-normalize-criteria criteria :protocol :user :machine)
connection-local-criteria-alist))))
(let (profiles)
(dolist (crit-alist connection-local-criteria-alist)
(let ((crit criteria)
(match t))
(while (and crit match)
(when (plist-member (car crit-alist) (car crit))
(setq match (equal (plist-get (car crit-alist) (car crit))
(plist-get criteria (car crit)))))
(setq crit (cddr crit)))
(when match
(setq profiles (append profiles (cdr crit-alist))))))
(delete-dups profiles)))
;;;###autoload
(defun connection-local-set-profiles (criteria &rest profiles)
......@@ -621,8 +623,7 @@ variables for a connection profile are defined using
(dolist (profile profiles)
(unless (assq profile connection-local-profile-alist)
(error "No such connection profile `%s'" (symbol-name profile))))
(let* ((criteria (connection-local-normalize-criteria
criteria :application :protocol :user :machine))
(let* ((criteria (connection-local-normalize-criteria criteria))
(slot (assoc criteria connection-local-criteria-alist)))
(if slot
(setcdr slot (delete-dups (append (cdr slot) profiles)))
......
......@@ -101,15 +101,19 @@
(setq files-x-test--criteria
(append files-x-test--application files-x-test--protocol
files-x-test--user files-x-test--machine))
;; An empty variable list is accepted (but makes no sense).
(connection-local-set-profiles files-x-test--criteria)
(should-not (connection-local-get-profiles files-x-test--criteria))
;; First test, all declared properties.
(connection-local-set-profiles
files-x-test--criteria 'remote-bash 'remote-ksh)
(should
(equal
(connection-local-get-profiles files-x-test--criteria)
'(remote-bash remote-ksh)))
;; Changing the order of properties doesn't matter.
(setq files-x-test--criteria
(append files-x-test--protocol files-x-test--application
......@@ -118,12 +122,14 @@
(equal
(connection-local-get-profiles files-x-test--criteria)
'(remote-bash remote-ksh)))
;; A further call adds profiles.
;; A further call adds profiles.
(connection-local-set-profiles files-x-test--criteria 'remote-nullfile)
(should
(equal
(connection-local-get-profiles files-x-test--criteria)
'(remote-bash remote-ksh remote-nullfile)))
;; Adding existing profiles doesn't matter.
(connection-local-set-profiles
files-x-test--criteria 'remote-bash 'remote-nullfile)
......@@ -132,31 +138,38 @@
(connection-local-get-profiles files-x-test--criteria)
'(remote-bash remote-ksh remote-nullfile)))
;; Use a criteria without application.
(setq files-x-test--criteria
(append files-x-test--protocol
files-x-test--user files-x-test--machine))
(connection-local-set-profiles files-x-test--criteria 'remote-ksh)
(should
(equal
(connection-local-get-profiles files-x-test--criteria)
'(remote-ksh)))
;; An application not used in any registered criteria matches also this.
(setq files-x-test--criteria
(append files-x-test--another-application files-x-test--protocol
files-x-test--user files-x-test--machine))
(should
(equal
(connection-local-get-profiles files-x-test--criteria)
'(remote-ksh)))
;; Use different properties.
(dolist (criteria
`(;; All properties.
,(append files-x-test--application files-x-test--protocol
files-x-test--user files-x-test--machine)
;; Without :application.
,(append files-x-test--protocol
files-x-test--user files-x-test--machine)
;; Without :protocol.
,(append files-x-test--application
files-x-test--user files-x-test--machine)
;; Without :user.
,(append files-x-test--application files-x-test--protocol
files-x-test--machine)
;; Without :machine.
,(append files-x-test--application files-x-test--protocol
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.
(connection-local-set-profiles
nil 'remote-bash 'remote-ksh 'remote-ksh 'remote-bash)
;; This matches also the existing profiles from other criteria.
(should
(equal
(connection-local-get-profiles nil)
'(remote-bash remote-ksh)))
'(remote-bash remote-ksh remote-nullfile)))
;; A criteria other than plist is wrong.
(should-error (connection-local-set-profiles 'dummy))))
......@@ -235,7 +248,9 @@
;; declare same variables as in `remote-bash'.
(should
(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.
(should (local-variable-p 'remote-shell-file-name))
;; The proper variable value is set.
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment