From: Po Lu Date: Wed, 8 Jun 2022 02:40:20 +0000 (+0800) Subject: Improve drag-and-drop tests X-Git-Tag: emacs-29.0.90~1910^2~161 X-Git-Url: http://git.eshelyaron.com/gitweb/?a=commitdiff_plain;h=3237d1d6b63c2a299f81dcb8b4f2833e00a7fedf;p=emacs.git 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 0f65b5228d6..7eb43f5baab 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 706197e027e..417968b25cb 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 a714c4a4e55..7a12cb8347c 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