From 00b767089e711bdbd5d2e470d66fa17390da73f0 Mon Sep 17 00:00:00 2001 From: Michael Albinus Date: Fri, 17 Apr 2026 16:48:16 +0200 Subject: [PATCH] Extend integration of external operations in Tramp * doc/misc/tramp.texi (Extension packages): Use another format char in example. (New operations): Document different argument types. Extend example. * lisp/net/tramp.el: Use consequently `eq', `assq', `memq'. (tramp-file-name-for-operation-external): Extend docstring. (tramp-file-name-for-operation): Make more use of `tramp-file-name-for-operation-external'. (tramp-add-external-operation): New optional argument `arg-type'. * test/lisp/net/tramp-tests.el (tramp--handle-test-operation): Rename from `tramp--handler-for-test-operation'. (tramp--handle-process-id) (tramp--test-operation-file-name-for-operation): New defuns. (tramp-test49-external-backend-function): Extend test. --- doc/misc/tramp.texi | 78 ++++++++++++---- lisp/net/tramp.el | 168 +++++++++++++++++++++-------------- test/lisp/net/tramp-tests.el | 144 +++++++++++++++++++++++++----- 3 files changed, 285 insertions(+), 105 deletions(-) diff --git a/doc/misc/tramp.texi b/doc/misc/tramp.texi index 41455a47546..3aaa2e84982 100644 --- a/doc/misc/tramp.texi +++ b/doc/misc/tramp.texi @@ -5556,6 +5556,8 @@ operations. For example, the GNU ELPA package @file{tramp-hlo} implements specialized versions of @code{dir-locals--all-files}, @code{locate-dominating-file} and @code{dir-locals-find-file} for @value{tramp}'s @code{tramp-sh} backend (@pxref{New operations}). +@c The NonGNU ELPA package @file{tramp-rpc} implements an own +@c @value{tramp} backend (@pxref{New operations}). @end itemize @@ -6743,7 +6745,7 @@ The following parameters expand format specifiers for the The example above could use @lisp -(tramp-login-program "%1") +(tramp-login-program "%b") @end lisp And you could set @code{tramp-extra-expand-args} as connection-local value: @@ -6759,7 +6761,7 @@ And you could set @code{tramp-extra-expand-args} as connection-local value: (connection-local-set-profile-variables 'foo-tramp-connection-local-default-profile '((tramp-extra-expand-args - ?1 (foo-tramp-get-login-program (car tramp-current-connection))))) + ?b (foo-tramp-get-login-program (car tramp-current-connection))))) (connection-local-set-profiles '(:application tramp :protocol "foo") @@ -6867,15 +6869,12 @@ For example, it could implement this by using an own shell script which collects the information on the remote host for this very special purpose with one round-trip per-call. -@defun tramp-add-external-operation operation function backend +@defun tramp-add-external-operation operation function backend &optional arg-type This adds an implementation of @var{operation} to @value{tramp}'s backend @var{backend}. @var{function} is the new implementation. Both @var{operation} and @var{function} shall be function symbols. -They must have the same argument list. The first argument is used to -determine, whether @value{tramp} is invoked (check for remote file -name syntax). It must be a string or nil, in the latter case -@code{default-directory} is used for the check. +They must have the same argument list. @var{backend}, also a symbol, is the feature name of a @value{tramp} backend (except @code{tramp-ftp}). The new implementation will be @@ -6883,18 +6882,18 @@ applied only for this backend. Example: @lisp @group -(defun test-operation (file) +(defun my-test-operation (file) (message "Original implementation for %s" file)) @end group @group -(defun handle-test-operation (file) +(defun my-handle-test-operation (file) (message "Handler implementation for %s" file)) @end group @group (tramp-add-external-operation - #'test-operation #'handle-test-operation 'tramp-sh) + #'my-test-operation #'my-handle-test-operation 'tramp-sh) @end group @end lisp @@ -6903,19 +6902,19 @@ Then we have the different use cases: @lisp @group ;; Local file name. -(test-operation "/a/b") +(my-test-operation "/a/b") @result{} "Original implementation for /a/b" @end group @group ;; Remote file name, handled by `tramp-sh'. -(test-operation "/ssh::/a/b") +(my-test-operation "/ssh::/a/b") @result{} "Handler implementation for /ssh::/a/b" @end group @group ;; Remote file name, handled by `tramp-gvfs'. -(test-operation "/sftp::/a/b") +(my-test-operation "/sftp::/a/b") @result{} "Original implementation for /sftp::/a/b" @end group @end lisp @@ -6935,14 +6934,14 @@ could look like: @lisp @group -(defun handle-test-operation (file) +(defun my-handle-test-operation (file) (message "Entry handler implementation for %s" file) - (tramp-run-real-handler #'test-operation (list file)) + (tramp-run-real-handler #'my-test-operation (list file)) (message "Exit handler implementation for %s" file)) @end group @group -(test-operation "/ssh::/a/b") +(my-test-operation "/ssh::/a/b") @result{} "Entry handler implementation for /ssh::/a/b Original implementation for /ssh::/a/b Exit handler implementation for /ssh::/a/b" @@ -6952,6 +6951,47 @@ could look like: If the same @var{function} shall be used for different @value{tramp} backends, @code{tramp-add-external-operation} must be called for every backend, respectively. + +The optional argument @var{arg-type} specisfies, which argument of +@var{operation} shall be used in order to determine, whether the +handler @var{function} should be called. It can be + +@itemize @minus +@item @code{file}@* +The first argument of @var{operation} is the remote file name to be +checked. This is the default, if @var{arg-type} is @code{nil}. + +@item @code{default-directory}@* +@code{default-directory} is the remote file name to be checked. + +@item @code{process}@* +@code{default-directory} of the process buffer of the first argument +of @var{operation}, a process, is the remote file name to be checked. +@end itemize + +If the first argument of @var{operation} is nil, +@code{default-directory} is the remote file name to be checked in case +of @var{arg-type} being @code{file} or @code{process}. + +@findex tramp-file-name-for-operation +If @var{arg-type} is a function symbol, it will be called with the +same arguments as @code{tramp-file-name-for-operation}. It must +return a string, which is the remote file name to be checked. + +The example above could be changed like this: + +@lisp +@group +(defun my-file-name-for-test-operation (operation &rest args) + (if (stringp (car args)) (car args) default-directory)) +@end group + +@group +(tramp-add-external-operation + #'my-test-operation #'my-handle-test-operation 'tramp-sh + #'my-file-name-for-test-operation) +@end group +@end lisp @end defun @defun tramp-remove-external-operation operation backend @@ -6963,7 +7003,7 @@ they are kept. Example: @lisp @group (tramp-remove-external-operation - #'test-operation 'tramp-sh) + #'my-test-operation 'tramp-sh) @end group @end lisp @end defun @@ -6979,6 +7019,10 @@ An example implementing this mechanism is the GNU ELPA package @code{dir-locals-find-file} for @value{tramp}'s @code{tramp-sh} backend. +@c Another example is the NonGNU ELPA package @file{tramp-rpc}. It +@c provides an own @value{tramp} backend, using a server process on the +@c remote host. + @node Traces and Profiles @chapter How to Customize Traces diff --git a/lisp/net/tramp.el b/lisp/net/tramp.el index 1e1fa2fe9a7..0685de12494 100644 --- a/lisp/net/tramp.el +++ b/lisp/net/tramp.el @@ -2424,7 +2424,22 @@ arguments to pass to the OPERATION." (apply operation args))) (defvar tramp-file-name-for-operation-external nil - "List of operations added by external packages.") + "Alist of operations added by external packages. +An entry has the form `(OPERATION . ARG-TYPE)'. ARG-TYPE can be the +symbol + +- `file': the first argument of OERATION is the remote file name to be + checked. +- `default-directory': `default-directory' is the remote file name to be + checked. +- `process': `default-directory' of the process buffer of the first + argument of OPERATION is the remote file name to be checked. + +If the first argument of OPERATION is nil, `default-directory' is the +remote file name to be checked in case of `file' and `process'. + +If ARG-TYPE is a function symbol, it will be called with the same +arguments as `tramp-file-name-for-operation'. It must return a string.") ;; We handle here all file primitives. Most of them have the file ;; name as first parameter; nevertheless we check for them explicitly @@ -2434,9 +2449,7 @@ arguments to pass to the OPERATION." ;; ease the life if `file-name-handler-alist' would support a decision ;; function as well but regexp only. ;; Operations added by external packages are kept in -;; `tramp-file-name-for-operation-external'. They expect the file -;; name to be checked as first argument or, if there isn't any -;; argument, `default-directory'. +;; `tramp-file-name-for-operation-external'. (defun tramp-file-name-for-operation (operation &rest args) "Return file name related to OPERATION file primitive. ARGS are the arguments OPERATION has been called with. @@ -2446,30 +2459,32 @@ first argument of `expand-file-name' is absolute and not remote. Must be handled by the callers." (cond ;; FILE resp DIRECTORY. - ((memq operation - '(access-file byte-compiler-base-file-name delete-directory - delete-file diff-latest-backup-file directory-file-name - directory-files directory-files-and-attributes dired-compress-file - dired-uncache file-acl file-accessible-directory-p file-attributes - file-directory-p file-executable-p file-exists-p file-local-copy - file-locked-p file-modes file-name-as-directory - file-name-case-insensitive-p file-name-directory - file-name-nondirectory file-name-sans-versions - file-notify-add-watch file-ownership-preserved-p file-readable-p - file-regular-p file-remote-p file-selinux-context file-symlink-p - file-system-info file-truename file-writable-p - find-backup-file-name get-file-buffer - insert-directory insert-file-contents load lock-file make-directory - make-lock-file-name set-file-acl set-file-modes - set-file-selinux-context set-file-times substitute-in-file-name - unhandled-file-name-directory unlock-file vc-registered - ;; Emacs 28- only. - make-directory-internal - ;; Emacs 29+ only. - abbreviate-file-name - ;; Tramp internal magic file name function. - tramp-set-file-uid-gid)) - (if (file-name-absolute-p (nth 0 args)) + ((or + (memq operation + '(access-file byte-compiler-base-file-name delete-directory + delete-file diff-latest-backup-file directory-file-name + directory-files directory-files-and-attributes dired-compress-file + dired-uncache file-acl file-accessible-directory-p file-attributes + file-directory-p file-executable-p file-exists-p file-local-copy + file-locked-p file-modes file-name-as-directory + file-name-case-insensitive-p file-name-directory + file-name-nondirectory file-name-sans-versions + file-notify-add-watch file-ownership-preserved-p file-readable-p + file-regular-p file-remote-p file-selinux-context file-symlink-p + file-system-info file-truename file-writable-p + find-backup-file-name get-file-buffer + insert-directory insert-file-contents load lock-file make-directory + make-lock-file-name set-file-acl set-file-modes + set-file-selinux-context set-file-times substitute-in-file-name + unhandled-file-name-directory unlock-file vc-registered + ;; Emacs 28- only. + make-directory-internal + ;; Emacs 29+ only. + abbreviate-file-name + ;; Tramp internal magic file name function. + tramp-set-file-uid-gid)) + (eq (alist-get operation tramp-file-name-for-operation-external) 'file)) + (if (and (stringp (nth 0 args)) (file-name-absolute-p (nth 0 args))) (nth 0 args) default-directory)) ;; STRING FILE. @@ -2502,31 +2517,45 @@ Must be handled by the callers." (buffer-file-name (if (bufferp (nth 0 args)) (nth 0 args) (current-buffer)))) ;; COMMAND. - ((memq operation - '(exec-path make-nearby-temp-file make-process process-file - shell-command start-file-process temporary-file-directory - ;; Emacs 29+ only. - list-system-processes memory-info process-attributes - ;; Emacs 30+ only. - file-group-gid file-user-uid)) + ((or + (memq operation + '(exec-path make-nearby-temp-file make-process process-file + shell-command start-file-process temporary-file-directory + ;; Emacs 29+ only. + list-system-processes memory-info process-attributes + ;; Emacs 30+ only. + file-group-gid file-user-uid)) + (eq (alist-get operation tramp-file-name-for-operation-external) + 'default-directory)) default-directory) - ;; PROC. - ((memq operation '(file-notify-rm-watch file-notify-valid-p)) - (when (processp (nth 0 args)) - (tramp-get-default-directory (process-buffer (nth 0 args))))) + ;; PROC or BUFFER. + ((or + (memq operation '(file-notify-rm-watch file-notify-valid-p)) + (eq (alist-get operation tramp-file-name-for-operation-external) 'process)) + (or (when-let* (((processp (nth 0 args))) + (vec (process-get (nth 0 args) 'tramp-vector))) + (tramp-make-tramp-file-name vec)) + (when-let* + ((buf (cond + ((processp (nth 0 args)) (process-buffer (nth 0 args))) + ((bufferp (nth 0 args)) (get-buffer (nth 0 args))) + ((stringp (nth 0 args)) + ;; Process or buffer name. + (or (get-process (nth 0 args)) (get-buffer (nth 0 args))))))) + (tramp-get-default-directory buf)) + "")) ;; VEC. ((memq operation '(tramp-get-home-directory tramp-get-remote-gid tramp-get-remote-groups tramp-get-remote-uid)) (tramp-make-tramp-file-name (nth 0 args))) - ;; FILE resp DIRECTORY. - ((and (memq operation tramp-file-name-for-operation-external) - (or (stringp (nth 0 args)) (null (nth 0 args)))) - (if (and (stringp (nth 0 args)) (file-name-absolute-p (nth 0 args))) - (nth 0 args) - default-directory)) + ;; A function. + ((functionp (alist-get operation tramp-file-name-for-operation-external)) + (apply + (alist-get operation tramp-file-name-for-operation-external) + operation args)) ;; Unknown file primitive. - (t (unless (member 'remote-file-error debug-ignored-errors) + (t (unless (memq 'remote-file-error debug-ignored-errors) (tramp-error nil 'remote-file-error "Unknown file I/O primitive: %s" operation))))) @@ -2544,7 +2573,7 @@ Must be handled by the callers." (funcall (setq func (car elt)) vec) (error (setcar elt #'ignore) - (unless (member 'remote-file-error debug-ignored-errors) + (unless (memq 'remote-file-error debug-ignored-errors) (tramp-error vec 'remote-file-error "Not a valid Tramp file name function `%s'" func)))) @@ -2552,22 +2581,32 @@ Must be handled by the callers." res (cdr elt)))) res))) -(defun tramp-add-external-operation (operation function backend) +(defun tramp-add-external-operation + (operation function backend &optional arg-type) "Add FUNCTION to Tramp BACKEND as handler for OPERATION. OPERATION must not be one of the magic operations listed in Info node `(elisp) Magic File Names'. FUNCTION must have the same argument list as OPERATION. BACKEND, a symbol, must be one of the Tramp backend -packages like `tramp-sh' (except `tramp-ftp')." +packages like `tramp-sh' (except `tramp-ftp'). ARG-TYPE is either +`file' (the default), `default-directory', `process' or a function +symbol. It describes the type of the OPERATION argument to be checked. +See the docstring of `tramp-file-name-for-operation-external' for its +meaning." (require backend) (when-let* ((fnha (intern-soft (concat (symbol-name backend) "-file-name-handler-alist"))) - ((boundp fnha))) + ((boundp fnha)) + (arg-type (or arg-type 'file))) + (unless (or (memq arg-type '(file default-directory process)) + (functionp arg-type)) + (tramp-error nil 'remote-file-error "Unknown arg type: %s" arg-type)) ;; Make BACKEND aware of the new operation. (add-to-list fnha (cons operation function)) - (unless (memq operation tramp-file-name-for-operation-external) + (unless (assq operation tramp-file-name-for-operation-external) ;; Make Tramp aware of the new operation. - (add-to-list 'tramp-file-name-for-operation-external operation) + (add-to-list + 'tramp-file-name-for-operation-external (cons operation arg-type)) (put #'tramp-file-name-handler 'operations (cons operation (get 'tramp-file-name-handler 'operations))) @@ -2577,8 +2616,7 @@ packages like `tramp-sh' (except `tramp-ftp')." `(lambda (orig-fun &rest args) (if-let* ((handler (find-file-name-handler - (if (and (car args) (file-name-absolute-p (car args))) - (car args) default-directory) + (apply #'tramp-file-name-for-operation #',operation args) #',operation))) (apply handler #',operation args) (apply orig-fun args))) @@ -2605,7 +2643,7 @@ Tramp backend packages like `tramp-sh'." tramp-foreign-file-name-handler-alist) ;; Make Tramp unaware of OPERATION. (setq tramp-file-name-for-operation-external - (delq operation tramp-file-name-for-operation-external)) + (assq-delete-all operation tramp-file-name-for-operation-external)) (put #'tramp-file-name-handler 'operations (delq operation (get 'tramp-file-name-handler 'operations))) ;; Remove the advice for OPERATION. @@ -6335,7 +6373,7 @@ Mostly useful to protect BODY from being interrupted by timers." (declare (indent 1) (debug t)) `(if (tramp-get-connection-property ,proc "locked") ;; Be kind for old versions of Emacs. - (if (member 'remote-file-error debug-ignored-errors) + (if (memq 'remote-file-error debug-ignored-errors) (throw 'non-essential 'non-essential) ;(tramp-backtrace ,proc 'force) (tramp-error @@ -6701,7 +6739,7 @@ If FILENAME is remote, a file name handler is called." ID-FORMAT valid values are `string' and `integer'." ;; We use key nil for local connection properties. (with-tramp-connection-property nil (format "uid-%s" id-format) - (if (equal id-format 'integer) (user-uid) (user-login-name)))) + (if (eq id-format 'integer) (user-uid) (user-login-name)))) (defun tramp-get-local-gid (id-format) "The gid of the local user, in ID-FORMAT. @@ -6709,8 +6747,8 @@ ID-FORMAT valid values are `string' and `integer'." ;; We use key nil for local connection properties. (with-tramp-connection-property nil (format "gid-%s" id-format) (cond - ((equal id-format 'integer) (group-gid)) - ((equal id-format 'string) (group-name (group-gid))) + ((eq id-format 'integer) (group-gid)) + ((eq id-format 'string) (group-name (group-gid))) ((file-attribute-group-id (file-attributes "~/" id-format)))))) (defun tramp-get-local-locale (&optional vec) @@ -6906,8 +6944,8 @@ ID-FORMAT valid values are `string' and `integer'." (with-tramp-connection-property vec (format "uid-%s" id-format) (tramp-file-name-handler #'tramp-get-remote-uid vec id-format))) ;; Ensure there is a valid result. - (and (equal id-format 'integer) tramp-unknown-id-integer) - (and (equal id-format 'string) tramp-unknown-id-string))) + (and (eq id-format 'integer) tramp-unknown-id-integer) + (and (eq id-format 'string) tramp-unknown-id-string))) (defun tramp-get-remote-gid (vec id-format) "The gid of the remote connection VEC, in ID-FORMAT. @@ -6916,8 +6954,8 @@ ID-FORMAT valid values are `string' and `integer'." (with-tramp-connection-property vec (format "gid-%s" id-format) (tramp-file-name-handler #'tramp-get-remote-gid vec id-format))) ;; Ensure there is a valid result. - (and (equal id-format 'integer) tramp-unknown-id-integer) - (and (equal id-format 'string) tramp-unknown-id-string))) + (and (eq id-format 'integer) tramp-unknown-id-integer) + (and (eq id-format 'string) tramp-unknown-id-string))) (defun tramp-get-remote-groups (vec id-format) "The list of groups of the remote connection VEC, in ID-FORMAT. @@ -7231,9 +7269,9 @@ verbosity of 6." (let ((default-directory temporary-file-directory)) (dolist (pid (list-system-processes)) (and-let* ((attributes (process-attributes pid)) - (comm (cdr (assoc 'comm attributes))) + (comm (cdr (assq 'comm attributes))) ((string-equal - (cdr (assoc 'user attributes)) (user-login-name))) + (cdr (assq 'user attributes)) (user-login-name))) ;; The returned command name could be truncated ;; to 15 characters. Therefore, we cannot check ;; for `string-equal'. diff --git a/test/lisp/net/tramp-tests.el b/test/lisp/net/tramp-tests.el index 90dc17a0753..25e7870b5ce 100644 --- a/test/lisp/net/tramp-tests.el +++ b/test/lisp/net/tramp-tests.el @@ -8859,10 +8859,19 @@ process sentinels. They shall not disturb each other." "Test operation." "Test operation") -(defun tramp--handler-for-test-operation (&optional _file) +(defun tramp--handle-test-operation (&optional _file) "Test operation handler." "Test operation handler") +(defun tramp--handle-process-id (process) + "Handler for `process-id'." + ;; Return something else. + (1+ (tramp-run-real-handler #'process-id (list process)))) + +(defun tramp--test-operation-file-name-for-operation (_operation &optional _file) + "Helper function for `tramp--test-operation' handler." + default-directory) + (ert-deftest tramp-test49-external-backend-function () "Check that Tramp handles external functions for a given backend." :tags '(:expensive-test) @@ -8879,78 +8888,167 @@ process sentinels. They shall not disturb each other." ;; There is no backend specific code. (should-not (string-equal (tramp--test-operation ert-remote-temporary-file-directory) - (tramp--handler-for-test-operation + (tramp--handle-test-operation ert-remote-temporary-file-directory))) (should-not (string-equal (tramp--test-operation temporary-file-directory) - (tramp--handler-for-test-operation + (tramp--handle-test-operation temporary-file-directory))) (let ((default-directory ert-remote-temporary-file-directory)) (should-not (string-equal (tramp--test-operation) - (tramp--handler-for-test-operation)))) + (tramp--handle-test-operation)))) (let ((default-directory temporary-file-directory)) (should-not (string-equal (tramp--test-operation) - (tramp--handler-for-test-operation)))) + (tramp--handle-test-operation)))) (should-error (tramp-add-external-operation - #'tramp--test-operation - #'tramp--handler-for-test-operation 'foo) + #'tramp--test-operation #'tramp--handle-test-operation 'foo) :type 'file-missing) + (should-error + (tramp-add-external-operation + #'tramp--test-operation #'tramp--handle-test-operation backend 'foo) + :type 'remote-file-error) + ;; This doesn't hurt. (tramp-add-external-operation - #'tramp--test-operation - #'tramp--handler-for-test-operation backend) + #'tramp--test-operation #'tramp--handle-test-operation backend 'file) + ;; The backend specific function is called. (should (string-equal (tramp--test-operation ert-remote-temporary-file-directory) - (tramp--handler-for-test-operation + (tramp--handle-test-operation ert-remote-temporary-file-directory))) (should-not (string-equal (tramp--test-operation temporary-file-directory) - (tramp--handler-for-test-operation + (tramp--handle-test-operation temporary-file-directory))) (let ((default-directory ert-remote-temporary-file-directory)) (should (string-equal (tramp--test-operation) - (tramp--handler-for-test-operation))) + (tramp--handle-test-operation))) (should (string-equal (tramp--test-operation "foo") - (tramp--handler-for-test-operation "foo")))) + (tramp--handle-test-operation "foo")))) (let ((default-directory temporary-file-directory)) (should-not (string-equal (tramp--test-operation) - (tramp--handler-for-test-operation))) + (tramp--handle-test-operation))) (should-not (string-equal (tramp--test-operation "foo") - (tramp--handler-for-test-operation "foo")))) + (tramp--handle-test-operation "foo")))) - (tramp-remove-external-operation - #'tramp--test-operation backend) + (tramp-remove-external-operation #'tramp--test-operation backend) ;; There is no backend specific code. (should-not (string-equal (tramp--test-operation ert-remote-temporary-file-directory) - (tramp--handler-for-test-operation + (tramp--handle-test-operation ert-remote-temporary-file-directory))) (should-not (string-equal (tramp--test-operation temporary-file-directory) - (tramp--handler-for-test-operation + (tramp--handle-test-operation temporary-file-directory))) (let ((default-directory ert-remote-temporary-file-directory)) (should-not (string-equal (tramp--test-operation) - (tramp--handler-for-test-operation))) + (tramp--handle-test-operation))) (should-not (string-equal (tramp--test-operation "foo") - (tramp--handler-for-test-operation "foo")))) + (tramp--handle-test-operation "foo")))) (let ((default-directory temporary-file-directory)) (should-not (string-equal (tramp--test-operation) - (tramp--handler-for-test-operation))) + (tramp--handle-test-operation))) (should-not (string-equal (tramp--test-operation "foo") - (tramp--handler-for-test-operation "foo")))))) + (tramp--handle-test-operation "foo")))) + + ;; Test `default-directory' arg type. + (tramp-add-external-operation + #'tramp--test-operation #'tramp--handle-test-operation + backend 'default-directory) + + ;; The backend specific function is called. + (let ((default-directory ert-remote-temporary-file-directory)) + (should + (string-equal (tramp--test-operation "foo") + (tramp--handle-test-operation "foo")))) + (let ((default-directory temporary-file-directory)) + (should-not + (string-equal (tramp--test-operation "foo") + (tramp--handle-test-operation "foo")))) + + (tramp-remove-external-operation #'tramp--test-operation backend) + ;; There is no backend specific code. + (let ((default-directory ert-remote-temporary-file-directory)) + (should-not + (string-equal (tramp--test-operation) + (tramp--handle-test-operation))) + (should-not + (string-equal (tramp--test-operation "foo") + (tramp--handle-test-operation "foo")))) + (let ((default-directory temporary-file-directory)) + (should-not + (string-equal (tramp--test-operation) + (tramp--handle-test-operation))) + (should-not + (string-equal (tramp--test-operation "foo") + (tramp--handle-test-operation "foo")))) + + ;; Test `process' arg type. + (when (and (tramp--test-supports-processes-p) (not (tramp--test-smb-p))) + (let ((default-directory ert-remote-temporary-file-directory) + proc command id) + (unwind-protect + (with-temp-buffer + (setq command '("cat") + proc + (make-process + :name "test" :buffer (current-buffer) :command command + :file-handler t)) + (should (processp proc)) + (should (eq (process-status proc) 'run)) + (should (natnump (setq id (process-id proc)))) + (tramp-add-external-operation + #'process-id #'tramp--handle-process-id backend 'process) + (should (= (process-id proc) (1+ id)))) + + ;; Cleanup. + (tramp-remove-external-operation #'process-id backend) + (ignore-errors (delete-process proc))))) + + ;; Test function arg type. + (tramp-add-external-operation + #'tramp--test-operation #'tramp--handle-test-operation + backend #'tramp--test-operation-file-name-for-operation) + + ;; The backend specific function is called. + (let ((default-directory ert-remote-temporary-file-directory)) + (should + (string-equal (tramp--test-operation "foo") + (tramp--handle-test-operation "foo")))) + (let ((default-directory temporary-file-directory)) + (should-not + (string-equal (tramp--test-operation "foo") + (tramp--handle-test-operation "foo")))) + + (tramp-remove-external-operation #'tramp--test-operation backend) + ;; There is no backend specific code. + (let ((default-directory ert-remote-temporary-file-directory)) + (should-not + (string-equal (tramp--test-operation) + (tramp--handle-test-operation))) + (should-not + (string-equal (tramp--test-operation "foo") + (tramp--handle-test-operation "foo")))) + (let ((default-directory temporary-file-directory)) + (should-not + (string-equal (tramp--test-operation) + (tramp--handle-test-operation))) + (should-not + (string-equal (tramp--test-operation "foo") + (tramp--handle-test-operation "foo")))))) ;; This test is inspired by Bug#29163. (ert-deftest tramp-test50-auto-load ()