Throw errors in XDS handler directly

* lisp/x-dnd.el (x-dnd-xds-testing): New defvar.
(x-dnd-handle-direct-save): Signal errors directly if it is
true.
* test/lisp/x-dnd-tests.el (x-dnd-xds-testing): New defvar.
(x-dnd-tests-do-direct-save-internal): Bind it to t around
x-begin-drag.  (bug#56712)

diff --git a/lisp/x-dnd.el b/lisp/x-dnd.el
index a61905cfac0221ae972a8cd56f9b0bf3423bd423..10fd9e5dac377a918e005f6600f7b069c047681e 100644 (file)
--- a/lisp/x-dnd.el
+++ b/lisp/x-dnd.el
@@ -1442,6 +1442,11 @@ ACTION is the action given to `x-begin-drag'."
 (defvar x-dnd-disable-motif-protocol)
 (defvar x-dnd-use-unsupported-drop)
 
+(defvar x-dnd-xds-testing nil
+  "Whether or not XDS is being tested from ERT.
+When non-nil, throw errors from the `XdndDirectSave0' converters
+instead of returning \"E\".")
+
 (defun x-dnd-handle-direct-save (_selection _type _value)
   "Handle a selection request for `XdndDirectSave'."
   (setq x-dnd-xds-performed t)
@@ -1456,15 +1461,24 @@ ACTION is the action given to `x-begin-drag'."
                           (dnd-get-local-file-name local-file-uri))))
     (if (not local-name)
         '(STRING . "F")
-      (condition-case nil
-          (progn
+      ;; We want errors to be signalled immediately during ERT
+      ;; testing, instead of being silently handled.  (bug#56712)
+      (if x-dnd-xds-testing
+          (prog1 '(STRING . "S")
             (copy-file x-dnd-xds-current-file
                        local-name t)
             (when (equal x-dnd-xds-current-file
                          dnd-last-dragged-remote-file)
               (dnd-remove-last-dragged-remote-file)))
-        (:success '(STRING . "S"))
-        (error '(STRING . "E"))))))
+        (condition-case nil
+            (progn
+              (copy-file x-dnd-xds-current-file
+                         local-name t)
+              (when (equal x-dnd-xds-current-file
+                           dnd-last-dragged-remote-file)
+                (dnd-remove-last-dragged-remote-file)))
+          (:success '(STRING . "S"))
+          (error '(STRING . "E")))))))
 
 (defun x-dnd-handle-octet-stream (_selection _type _value)
   "Handle a selecton request for `application/octet-stream'.

diff --git a/test/lisp/x-dnd-tests.el b/test/lisp/x-dnd-tests.el
index 8856be79ebc25bcc9eb4019b926958ab6629f0bb..ef9c8aada28b6b955c55349078e904c5d6eb5c00 100644 (file)
--- a/test/lisp/x-dnd-tests.el
+++ b/test/lisp/x-dnd-tests.el
@@ -90,6 +90,8 @@ AgAABQMAAAYDAAATGwAAGhsAAA==")
 
 ;;; XDS tests.
 
+(defvar x-dnd-xds-testing)
+
 (defvar x-dnd-tests-xds-target-dir nil
   "The name of the target directory where the file will be saved.")
 
@@ -162,7 +164,8 @@ hostname in the target URI."
         (original-file (expand-file-name
                         (make-temp-name "x-dnd-test")
                         temporary-file-directory))
-        (x-dnd-tests-xds-name (make-temp-name "x-dnd-test-target")))
+        (x-dnd-tests-xds-name (make-temp-name "x-dnd-test-target"))
+        (x-dnd-xds-testing t))
     ;; The call to `gui-set-selection' is only used for providing the
     ;; conventional `text/uri-list' target and can be ignored.
     (cl-flet ((gui-set-selection #'ignore))