From: Michael Albinus Date: Mon, 9 Jul 2018 14:03:49 +0000 (+0200) Subject: Fix Bug#32090 X-Git-Tag: emacs-26.1.90~281 X-Git-Url: http://git.eshelyaron.com/gitweb/?a=commitdiff_plain;h=917158f8c9;p=emacs.git 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. --- diff --git a/lisp/files-x.el b/lisp/files-x.el index 74ea77678ec..2a52792222d 100644 --- a/lisp/files-x.el +++ b/lisp/files-x.el @@ -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))) diff --git a/test/lisp/files-x-tests.el b/test/lisp/files-x-tests.el index 7bd69bda016..a77c6815fcd 100644 --- a/test/lisp/files-x-tests.el +++ b/test/lisp/files-x-tests.el @@ -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.