Improve drag-and-drop tests

* lisp/dnd.el (dnd-begin-file-drag, dnd-begin-drag-files): Fix
type of `x-xdnd-username'.
* lisp/select.el (selection-converter-alist): Fix declaration of
_DT_NETFILE converter.

* test/lisp/dnd-tests.el (dnd-tests-verify-selection-data):
Handle "compound" selection converters.
(dnd-tests-parse-tt-netfile): New function.
(dnd-tests-begin-file-drag, dnd-tests-begin-drag-files): Verify
validity of file selection data.

diff --git a/lisp/dnd.el b/lisp/dnd.el
index 0f65b5228d6afcef2f202de403afb30ca178f74c..7eb43f5baab19f8e7b9de0c0dba5e10370dd400a 100644 (file)
--- a/lisp/dnd.el
+++ b/lisp/dnd.el
@@ -423,7 +423,7 @@ currently being held down.  It should only be called upon a
            (x-begin-drag '(;; Xdnd types used by GTK, Qt, and most other
                            ;; modern programs that expect filenames to
                            ;; be supplied as URIs.
-                           "text/uri-list" "text/x-dnd-username"
+                           "text/uri-list" "text/x-xdnd-username"
                            ;; Traditional X selection targets used by
                            ;; programs supporting the Motif
                            ;; drag-and-drop protocols.  Also used by NS
@@ -493,7 +493,7 @@ FILES will be dragged."
            (x-begin-drag '(;; Xdnd types used by GTK, Qt, and most other
                            ;; modern programs that expect filenames to
                            ;; be supplied as URIs.
-                           "text/uri-list" "text/x-dnd-username"
+                           "text/uri-list" "text/x-xdnd-username"
                            ;; Traditional X selection targets used by
                            ;; programs supporting the Motif
                            ;; drag-and-drop protocols.  Also used by NS

diff --git a/lisp/select.el b/lisp/select.el
index 706197e027e2c82aebe29fd92fb9617d56b41f1b..417968b25cba3f423cbfcc89a640caa8ca311aed 100644 (file)
--- a/lisp/select.el
+++ b/lisp/select.el
@@ -819,8 +819,8 @@ VALUE should be SELECTION's local value."
        (_EMACS_INTERNAL . xselect-convert-to-identity)
         (XmTRANSFER_SUCCESS . xselect-convert-xm-special)
         (XmTRANSFER_FAILURE . xselect-convert-xm-special)
-        (_DT_NETFILE . (xselect-convert-to-dt-netfile
-                        . xselect-dt-netfile-available-p))))
+        (_DT_NETFILE . (xselect-dt-netfile-available-p
+                        . xselect-convert-to-dt-netfile))))
 
 (provide 'select)
 

diff --git a/test/lisp/dnd-tests.el b/test/lisp/dnd-tests.el
index a714c4a4e55a1655e536e8c21b044fd30cea196f..7a12cb8347c8b9fe60bcfe976ae602f25866276f 100644 (file)
--- a/test/lisp/dnd-tests.el
+++ b/test/lisp/dnd-tests.el
@@ -96,7 +96,7 @@
                           (or (get-text-property 0 type basic-value)
                               basic-value)
                         basic-value))
-         (converter-list (assq type selection-converter-alist))
+         (converter-list (cdr (assq type selection-converter-alist)))
          (converter (if (consp converter-list)
                         (cdr converter-list)
                       converter-list)))
@@ -118,6 +118,30 @@ The temporary file is not created."
   (expand-file-name (make-temp-name "dnd-test-remote")
                     dnd-tests-temporary-file-directory))
 
+(defun dnd-tests-parse-tt-netfile (netfile)
+  "Parse NETFILE and return its components.
+NETFILE should be a canonicalized ToolTalk file name.
+Return a list of its hostname, real path, and local path."
+  (save-match-data
+    (when (string-match (concat "HOST=0-\\([[:digit:]]+\\),RPATH=\\([[:digit:]]+\\)-"
+                                "\\([[:digit:]]+\\),LPATH=\\([[:digit:]]+\\)-"
+                                "\\([[:digit:]]+\\)\\(:\\)")
+                        netfile)
+      (let ((beg (match-end 6)))
+        (list (substring netfile beg
+                         (+ beg 1
+                            (string-to-number (match-string 1 netfile))))
+              (substring netfile
+                         (+ beg
+                            (string-to-number (match-string 2 netfile)))
+                         (+ beg 1
+                            (string-to-number (match-string 3 netfile))))
+              (substring netfile
+                         (+ beg
+                            (string-to-number (match-string 4 netfile)))
+                         (+ beg 1
+                            (string-to-number (match-string 5 netfile)))))))))
+
 (ert-deftest dnd-tests-begin-text-drag ()
   ;;                ASCII            Latin-1       UTF-8
   (let ((test-text "hello, everyone! sæl öllsömul! всем привет"))
@@ -159,6 +183,41 @@ The temporary file is not created."
         (progn
           ;; Now test dragging a normal file.
           (should (eq (dnd-begin-file-drag normal-temp-file) 'copy))
+          ;; Test that the selection data is correct.
+          (let ((uri-list-data (cdr (dnd-tests-verify-selection-data 'text/uri-list)))
+                (username-data (dnd-tests-verify-selection-data 'text/x-xdnd-username))
+                (file-name-data (cdr (dnd-tests-verify-selection-data 'FILE_NAME)))
+                (host-name-data (cdr (dnd-tests-verify-selection-data 'HOST_NAME)))
+                (netfile-data (cdr (dnd-tests-verify-selection-data '_DT_NETFILE))))
+            ;; Check if the URI list is formatted correctly.
+            (let* ((split-uri-list (split-string uri-list-data "[\0\r\n]" t))
+                   (decoded (dnd-get-local-file-name (car split-uri-list))))
+              (should (equal decoded normal-temp-file)))
+            ;; Test that the username reported is correct.
+            (should (equal username-data (user-real-login-name)))
+            ;; Test that the file name data is correct.
+            (let* ((split-file-names (split-string file-name-data "\0"))
+                   (file-name (car split-file-names)))
+              ;; Make sure there are no extra leading or trailing NULL bytes.
+              (should (and split-file-names (null (cdr split-file-names))))
+              ;; Make sure the file name is encoded correctly;
+              (should-not (multibyte-string-p file-name))
+              ;; Make sure decoding the file name results in the
+              ;; originals.
+              (should (equal (decode-coding-string file-name
+                                                   (or file-name-coding-system
+                                                       default-file-name-coding-system))
+                             normal-temp-file))
+              ;; Also make sure the hostname is correct.
+              (should (equal host-name-data (system-name))))
+            ;; Check that the netfile hostname, rpath and lpath are correct.
+            (let ((parsed (dnd-tests-parse-tt-netfile netfile-data))
+                  (filename (encode-coding-string normal-temp-file
+                                                  (or file-name-coding-system
+                                                      default-file-name-coding-system))))
+              (should (equal (nth 0 parsed) (system-name)))
+              (should (equal (nth 1 parsed) filename))
+              (should (equal (nth 2 parsed) filename))))
           ;; And the remote file.
           (should (eq (dnd-begin-file-drag remote-temp-file) 'copy))
           ;; Test that the remote file was added to the list of files
@@ -205,12 +264,43 @@ The temporary file is not created."
           ;; Test that the remote file produced was added to the list
           ;; of files to remove upon the next call.
           (should dnd-last-dragged-remote-file)
-          ;; Two remote files at the same time.
+          ;; Two local files at the same time.
           (should (eq (dnd-begin-drag-files (list normal-temp-file
                                                   normal-temp-file-1))
                       'copy))
           ;; Test that the remote files were removed.
           (should-not dnd-last-dragged-remote-file)
+          ;; Test the selection data is correct.
+          (let ((uri-list-data (cdr (dnd-tests-verify-selection-data 'text/uri-list)))
+                (username-data (dnd-tests-verify-selection-data 'text/x-xdnd-username))
+                (file-name-data (cdr (dnd-tests-verify-selection-data 'FILE_NAME)))
+                (host-name-data (cdr (dnd-tests-verify-selection-data 'HOST_NAME))))
+            ;; Check if the URI list is formatted correctly.
+            (let* ((split-uri-list (split-string uri-list-data "[\0\r\n]" t))
+                   (decoded (mapcar #'dnd-get-local-file-name split-uri-list)))
+              (should (equal (car decoded) normal-temp-file))
+              (should (equal (cadr decoded) normal-temp-file-1)))
+            ;; Test that the username reported is correct.
+            (should (equal username-data (user-real-login-name)))
+            ;; Test that the file name data is correct.
+            (let ((split-file-names (split-string file-name-data "\0")))
+              ;; Make sure there are no extra leading or trailing NULL bytes.
+              (should (equal (length split-file-names) 2))
+              ;; Make sure all file names are encoded correctly;
+              (dolist (name split-file-names)
+                (should-not (multibyte-string-p name)))
+              ;; Make sure decoding the file names result in the
+              ;; originals.
+              (should (equal (decode-coding-string (car split-file-names)
+                                                   (or file-name-coding-system
+                                                       default-file-name-coding-system))
+                             normal-temp-file))
+              (should (equal (decode-coding-string (cadr split-file-names)
+                                                   (or file-name-coding-system
+                                                       default-file-name-coding-system))
+                             normal-temp-file-1))
+              ;; Also make sure the hostname is correct.
+              (should (equal host-name-data (system-name)))))
           ;; Multiple local files with some remote files that will
           ;; fail, and some that won't.
           (should (and (eq (dnd-begin-drag-files (list normal-temp-file