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 74ea77678ec5a224c29ba412e30dacd716afe39b..2a52792222d044983882df1665233406d9e5639e 100644 (file)
--- 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 7bd69bda01697662d5a38bf607c109259da682cb..a77c6815fcd2ef9f66e99ec716d1fc751efc52d9 100644 (file)
--- 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.