(should-error (dired-rename-file from to-mv nil)))))
(ert-deftest dired-test-bug30624 ()
- "test for https://debbugs.gnu.org/30624 ."
- (cl-letf* ((target-dir (make-temp-file "target" 'dir))
- ((symbol-function 'dired-mark-read-file-name)
- (lambda (&rest _) target-dir))
- (inhibit-message t))
- ;; Delete target-dir: `dired-do-create-files' must recreate it.
- (delete-directory target-dir)
- (let ((file1 (make-temp-file "bug30624_file1"))
- (file2 (make-temp-file "bug30624_file2"))
- (dired-create-destination-dirs 'always)
- (buf (dired temporary-file-directory)))
- (unwind-protect
- (progn
- (dired-revert)
- (dired-mark-files-regexp "bug30624_file")
- (should (dired-do-create-files 'copy 'dired-copy-file "Copy" nil)))
- (delete-directory target-dir 'recursive)
- (mapc #'delete-file `(,file1 ,file2))
- (kill-buffer buf)))))
+ "Test for <https://debbugs.gnu.org/30624>."
+ (ert-with-temp-directory target-dir
+ (ert-with-temp-file file1
+ :suffix "bug30624_file1"
+ (ert-with-temp-file _file2
+ :suffix "bug30624_file2"
+ (cl-letf* (((symbol-function 'dired-mark-read-file-name)
+ (lambda (&rest _) target-dir))
+ (inhibit-message t))
+ ;; Delete target-dir: `dired-do-create-files' must recreate it.
+ (delete-directory target-dir)
+ (let ((dired-create-destination-dirs 'always)
+ (buf (dired (file-name-directory file1))))
+ (unwind-protect
+ (progn
+ (dired-revert)
+ (dired-mark-files-regexp "bug30624_file")
+ (should (dired-do-create-files 'copy 'dired-copy-file "Copy" nil)))
+ (kill-buffer buf))))))))
(defun dired-test--check-highlighting (command positions)
(let ((start 1))
(require 'track-changes)
(require 'cl-lib)
(require 'ert)
+(require 'ert-x)
(defun track-changes-tests--random-word ()
(let ((chars ()))
(random track-changes-tests--random-seed)
(dotimes (_ 100)
(insert (track-changes-tests--random-word) "\n"))
- (let* ((buf1 (generate-new-buffer " *tc1*"))
- (buf2 (generate-new-buffer " *tc2*"))
- (char-counts (make-vector 2 0))
- (sync-counts (make-vector 2 0))
- (print-escape-newlines t)
- (file (make-temp-file "tc"))
- (id1 (track-changes-register #'ignore))
- (id3 (track-changes-register #'ignore :nobefore t))
- (sync
- (lambda (id buf n)
- (track-changes-tests--message "!! SYNC %d !!" n)
- (track-changes-fetch
- id (lambda (beg end before)
- (when (eq n 1)
- (track-changes-fetch
- id3 (lambda (beg3 end3 before3)
- (should (eq beg3 beg))
- (should (eq end3 end))
- (should (eq before3
- (if (symbolp before)
- before (length before)))))))
- (incf (aref sync-counts (1- n)))
- (incf (aref char-counts (1- n)) (- end beg))
- (let ((after (buffer-substring beg end)))
- (track-changes-tests--message
- "Sync:\n %S\n=> %S\nat %d .. %d"
- before after beg end)
- (with-current-buffer buf
- (if (eq before 'error)
- (erase-buffer)
- (should (equal before
- (buffer-substring
- beg (+ beg (length before)))))
- (delete-region beg (+ beg (length before))))
- (goto-char beg)
- (insert after)))
- (should (equal (buffer-string)
- (with-current-buffer buf
- (buffer-string))))))))
- (id2 (track-changes-register
- (lambda (id2 &optional distance)
- (when distance
- (track-changes-tests--message "Disjoint distance: %d"
- distance)
- (funcall sync id2 buf2 2)))
- :disjoint t)))
- (write-region (point-min) (point-max) file)
- (insert-into-buffer buf1)
- (insert-into-buffer buf2)
- (should (equal (buffer-hash) (buffer-hash buf1)))
- (should (equal (buffer-hash) (buffer-hash buf2)))
- (message "seeding with: %S" track-changes-tests--random-seed)
- (dotimes (_ 1000)
- (pcase (random 15)
- (0
- (track-changes-tests--message "Manual sync1")
- (funcall sync id1 buf1 1))
- (1
- (track-changes-tests--message "Manual sync2")
- (funcall sync id2 buf2 2))
- ((pred (< _ 5))
- (let* ((beg (+ (point-min) (random (1+ (buffer-size)))))
- (end (min (+ beg (1+ (random 100))) (point-max))))
- (track-changes-tests--message "Fill %d .. %d" beg end)
- (fill-region-as-paragraph beg end)))
- ((pred (< _ 8))
- (let* ((beg (+ (point-min) (random (1+ (buffer-size)))))
- (end (min (+ beg (1+ (random 12))) (point-max))))
- (track-changes-tests--message "Delete %S at %d .. %d"
- (buffer-substring beg end) beg end)
- (delete-region beg end)))
- ((and 8 (guard (= (random 50) 0)))
- (track-changes-tests--message "Silent insertion")
- (let ((inhibit-modification-hooks t))
- (insert "a")))
- ((and 8 (guard (= (random 10) 0)))
- (track-changes-tests--message "Revert")
- (insert-file-contents file nil nil nil 'replace))
- ((and 8 (guard (= (random 3) 0)))
- (let* ((beg (+ (point-min) (random (1+ (buffer-size)))))
- (end (min (+ beg (1+ (random 12))) (point-max)))
- (after (eq (random 2) 0)))
- (track-changes-tests--message "Bogus %S %d .. %d"
- (if after 'after 'before) beg end)
- (if after
- (run-hook-with-args 'after-change-functions
- beg end (- end beg))
- (run-hook-with-args 'before-change-functions beg end))))
- (_
- (goto-char (+ (point-min) (random (1+ (buffer-size)))))
- (let ((word (track-changes-tests--random-word)))
- (track-changes-tests--message "insert %S at %d" word (point))
- (insert word "\n")))))
- (message "SCOREs: default: %d/%d=%d disjoint: %d/%d=%d"
- (aref char-counts 0) (aref sync-counts 0)
- (/ (aref char-counts 0) (aref sync-counts 0))
- (aref char-counts 1) (aref sync-counts 1)
- (/ (aref char-counts 1) (aref sync-counts 1))))))
+ (ert-with-temp-file file
+ (let* ((buf1 (generate-new-buffer " *tc1*"))
+ (buf2 (generate-new-buffer " *tc2*"))
+ (char-counts (make-vector 2 0))
+ (sync-counts (make-vector 2 0))
+ (print-escape-newlines t)
+ (id1 (track-changes-register #'ignore))
+ (id3 (track-changes-register #'ignore :nobefore t))
+ (sync
+ (lambda (id buf n)
+ (track-changes-tests--message "!! SYNC %d !!" n)
+ (track-changes-fetch
+ id (lambda (beg end before)
+ (when (eq n 1)
+ (track-changes-fetch
+ id3 (lambda (beg3 end3 before3)
+ (should (eq beg3 beg))
+ (should (eq end3 end))
+ (should (eq before3
+ (if (symbolp before)
+ before (length before)))))))
+ (incf (aref sync-counts (1- n)))
+ (incf (aref char-counts (1- n)) (- end beg))
+ (let ((after (buffer-substring beg end)))
+ (track-changes-tests--message
+ "Sync:\n %S\n=> %S\nat %d .. %d"
+ before after beg end)
+ (with-current-buffer buf
+ (if (eq before 'error)
+ (erase-buffer)
+ (should (equal before
+ (buffer-substring
+ beg (+ beg (length before)))))
+ (delete-region beg (+ beg (length before))))
+ (goto-char beg)
+ (insert after)))
+ (should (equal (buffer-string)
+ (with-current-buffer buf
+ (buffer-string))))))))
+ (id2 (track-changes-register
+ (lambda (id2 &optional distance)
+ (when distance
+ (track-changes-tests--message "Disjoint distance: %d"
+ distance)
+ (funcall sync id2 buf2 2)))
+ :disjoint t)))
+ (write-region (point-min) (point-max) file)
+ (insert-into-buffer buf1)
+ (insert-into-buffer buf2)
+ (should (equal (buffer-hash) (buffer-hash buf1)))
+ (should (equal (buffer-hash) (buffer-hash buf2)))
+ (message "seeding with: %S" track-changes-tests--random-seed)
+ (dotimes (_ 1000)
+ (pcase (random 15)
+ (0
+ (track-changes-tests--message "Manual sync1")
+ (funcall sync id1 buf1 1))
+ (1
+ (track-changes-tests--message "Manual sync2")
+ (funcall sync id2 buf2 2))
+ ((pred (< _ 5))
+ (let* ((beg (+ (point-min) (random (1+ (buffer-size)))))
+ (end (min (+ beg (1+ (random 100))) (point-max))))
+ (track-changes-tests--message "Fill %d .. %d" beg end)
+ (fill-region-as-paragraph beg end)))
+ ((pred (< _ 8))
+ (let* ((beg (+ (point-min) (random (1+ (buffer-size)))))
+ (end (min (+ beg (1+ (random 12))) (point-max))))
+ (track-changes-tests--message "Delete %S at %d .. %d"
+ (buffer-substring beg end) beg end)
+ (delete-region beg end)))
+ ((and 8 (guard (= (random 50) 0)))
+ (track-changes-tests--message "Silent insertion")
+ (let ((inhibit-modification-hooks t))
+ (insert "a")))
+ ((and 8 (guard (= (random 10) 0)))
+ (track-changes-tests--message "Revert")
+ (insert-file-contents file nil nil nil 'replace))
+ ((and 8 (guard (= (random 3) 0)))
+ (let* ((beg (+ (point-min) (random (1+ (buffer-size)))))
+ (end (min (+ beg (1+ (random 12))) (point-max)))
+ (after (eq (random 2) 0)))
+ (track-changes-tests--message "Bogus %S %d .. %d"
+ (if after 'after 'before) beg end)
+ (if after
+ (run-hook-with-args 'after-change-functions
+ beg end (- end beg))
+ (run-hook-with-args 'before-change-functions beg end))))
+ (_
+ (goto-char (+ (point-min) (random (1+ (buffer-size)))))
+ (let ((word (track-changes-tests--random-word)))
+ (track-changes-tests--message "insert %S at %d" word (point))
+ (insert word "\n")))))
+ (message "SCOREs: default: %d/%d=%d disjoint: %d/%d=%d"
+ (aref char-counts 0) (aref sync-counts 0)
+ (/ (aref char-counts 0) (aref sync-counts 0))
+ (aref char-counts 1) (aref sync-counts 1)
+ (/ (aref char-counts 1) (aref sync-counts 1)))))))
;;; Code:
(require 'ert)
+(require 'ert-x)
(defun try-link (target link)
(make-symbolic-link target link)
failure))
(defun fileio-tests--symlink-failure ()
- (let* ((dir (make-temp-file "fileio" t))
- (link (expand-file-name "link" dir)))
- (unwind-protect
- (let (failure
- (char 0))
- (while (and (not failure) (< char 127))
- (setq char (1+ char))
- (when (and (eq system-type 'cygwin) (eq char 92))
- (setq char (1+ char)))
- (setq failure (try-link (string char) link)))
- (or failure
- (try-link "/:" link)))
- (delete-directory dir t))))
+ (ert-with-temp-directory dir
+ (let* ((link (expand-file-name "link" dir)))
+ (let (failure
+ (char 0))
+ (while (and (not failure) (< char 127))
+ (setq char (1+ char))
+ (when (and (eq system-type 'cygwin) (eq char 92))
+ (setq char (1+ char)))
+ (setq failure (try-link (string char) link)))
+ (or failure
+ (try-link "/:" link))))))
(ert-deftest fileio-tests--odd-symlink-chars ()
"Check that any non-NULL ASCII character can appear in a symlink.
(should (equal (expand-file-name "~/bar") "x:/foo/bar")))))
(ert-deftest fileio-tests--insert-file-interrupt ()
- (let ((text "-*- coding: binary -*-\n\xc3\xc3help")
- f)
- (unwind-protect
- (progn
- (setq f (make-temp-file "ftifi"))
- (write-region text nil f nil 'silent)
- (with-temp-buffer
- (catch 'toto
- (let ((set-auto-coding-function (lambda (&rest _) (throw 'toto nil))))
- (insert-file-contents f)))
- (goto-char (point-min))
- (unless (eobp)
- (forward-line 1)
- (let ((c1 (char-after)))
- (forward-char 1)
- (should (equal c1 (char-before)))
- (should (equal c1 (char-after)))))))
- (if f (delete-file f)))))
+ (ert-with-temp-file f
+ (let ((text "-*- coding: binary -*-\n\xc3\xc3help"))
+ (write-region text nil f nil 'silent)
+ (with-temp-buffer
+ (catch 'toto
+ (let ((set-auto-coding-function (lambda (&rest _) (throw 'toto nil))))
+ (insert-file-contents f)))
+ (goto-char (point-min))
+ (unless (eobp)
+ (forward-line 1)
+ (let ((c1 (char-after)))
+ (forward-char 1)
+ (should (equal c1 (char-before)))
+ (should (equal c1 (char-after)))))))))
(ert-deftest fileio-tests--relative-default-directory ()
"Test `expand-file-name' when `default-directory' is relative."
(ert-deftest fileio-tests--circular-after-insert-file-functions ()
"Test `after-insert-file-functions' as a circular list."
- (let ((f (make-temp-file "fileio"))
- (after-insert-file-functions (list 'identity)))
- (setcdr after-insert-file-functions after-insert-file-functions)
- (write-region "hello\n" nil f nil 'silent)
- (should-error (insert-file-contents f) :type 'circular-list)
- (delete-file f)))
+ (ert-with-temp-file f
+ :suffix "fileio"
+ (let ((after-insert-file-functions (list 'identity)))
+ (setcdr after-insert-file-functions after-insert-file-functions)
+ (write-region "hello\n" nil f nil 'silent)
+ (should-error (insert-file-contents f) :type 'circular-list))))
(ert-deftest fileio-tests/null-character ()
(should-error (file-exists-p "/foo\0bar")