[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
master 3237d1d6b6: Improve drag-and-drop tests
From: |
Po Lu |
Subject: |
master 3237d1d6b6: Improve drag-and-drop tests |
Date: |
Tue, 7 Jun 2022 22:40:34 -0400 (EDT) |
branch: master
commit 3237d1d6b63c2a299f81dcb8b4f2833e00a7fedf
Author: Po Lu <luangruo@yahoo.com>
Commit: Po Lu <luangruo@yahoo.com>
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.
---
lisp/dnd.el | 4 +--
lisp/select.el | 4 +--
test/lisp/dnd-tests.el | 94 ++++++++++++++++++++++++++++++++++++++++++++++++--
3 files changed, 96 insertions(+), 6 deletions(-)
diff --git a/lisp/dnd.el b/lisp/dnd.el
index 0f65b5228d..7eb43f5baa 100644
--- 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 706197e027..417968b25c 100644
--- 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 a714c4a4e5..7a12cb8347 100644
--- 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
[Prev in Thread] |
Current Thread |
[Next in Thread] |
- master 3237d1d6b6: Improve drag-and-drop tests,
Po Lu <=