procyberian/emacs
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

Merge from emacs-24; up to 2014-04-16T15:28:06Z!eggert@cs.ucla.edu

Browse source
This commit is contained in:
Juanma Barranquero 2014-04-19 01:36:51 +02:00
commit bba633792b
13 changed files with 401 additions and 118 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

6
admin/ChangeLog
View file

@ -1,3 +1,9 @@
2014-04-18 Paul Eggert <eggert@cs.ucla.edu>
* notes/bzr: Update instructions for merging from gnulib.
Remove obsolete note about tramp.el and tramp-sh.el.
Change "emacs-23" to "emacs-24".
2014-04-11 Glenn Morris <rgm@gnu.org>
* grammars/Makefile.in (EMACSDATA, EMACSDOC, EMACSPATH): Unexport.

36
admin/notes/bzr
View file

@ -3,9 +3,9 @@ NOTES ON COMMITTING TO EMACS'S BAZAAR REPO -*- outline -*-
* Install changes only on one branch, let them get merged elsewhere if needed.
In particular, install bug-fixes only on the release branch (if there
is one) and let them get synced to the trunk; do not install them by
hand on the trunk as well. E.g. if there is an active "emacs-23" branch
and you have a bug-fix appropriate for the next Emacs-23.x release,
install it only on the emacs-23 branch, not on the trunk as well.
hand on the trunk as well. E.g. if there is an active "emacs-24" branch
and you have a bug-fix appropriate for the next emacs-24.x release,
install it only on the emacs-24 branch, not on the trunk as well.
Installing things manually into more than one branch makes merges more
difficult.
@ -18,7 +18,7 @@ In that case, it's helpful if you can apply the change to both trunk
and branch yourself (when committing the branch change, indicate
in the commit log that it should not be merged to the trunk; see below).
* Backporting a bug-fix from the trunk to a branch (e.g. "emacs-23").
* Backporting a bug-fix from the trunk to a branch (e.g. "emacs-24").
Indicate in the commit log that there is no need to merge the commit
to the trunk. Anything that matches `bzrmerge-skip-regexp' will do;
eg start the commit message with "Backport:". This is helpful for the
@ -49,7 +49,7 @@ http://lists.gnu.org/archive/html/emacs-devel/2010-04/msg00086.html
* Installing changes from gnulib
Some of the files in Emacs are copied from gnulib. To synchronize
these files from the version of gnulib that you have checked out into
a sibling directory of your branch, type "make sync-from-gnulib"; this
a sibling directory of your branch, type "admin/merge-gnulib"; this
will check out the latest version of gnulib if there is no sibling
directory already. It is a good idea to run "bzr status" afterwards,
so that if a gnulib module added a file, you can record the new file
@ -57,17 +57,12 @@ using "bzr add". After synchronizing from gnulib, do a "make" in the
usual way.
To change the set of gnulib modules, change the GNULIB_MODULES
variable in the top-level Makefile.in, and then run:
variable in admin/merge-gnulib before running it.
./config.status
make sync-from-gnulib
bzr status
The last command will mention files that may need to be added using
"bzr add". If you remove a gnulib module, or if a gnulib module
If you remove a gnulib module, or if a gnulib module
removes a file, then remove the corresponding files by hand.
* How to merge changes from emacs-23 to trunk
* How to merge changes from emacs-24 to trunk
The following description uses bound branches, presumably it works in
a similar way with unbound ones.
@ -90,7 +85,7 @@ copy in ~/.bazaar if you upgrade bzr.
Maybe the default Emacs behavior without this plugin is better,
though, it's not clear yet.
1) Get clean, up-to-date copies of the emacs-23 and trunk branches.
1) Get clean, up-to-date copies of the emacs-24 and trunk branches.
Check for any uncommitted changes with bzr status.
2) M-x cd /path/to/trunk
@ -102,7 +97,7 @@ changelog_merge_files = ChangeLog
3) load admin/bzrmerge.el
4) M-x bzrmerge RET /path/to/emacs-23 RET
4) M-x bzrmerge RET /path/to/emacs-24 RET
It will prompt about revisions that should be skipped, based on the
regexp in bzrmerge-missing. If there are more revisions that you know
@ -119,7 +114,7 @@ Do not commit (or exit Emacs) until you have run bzrmerge to completion.
Before committing, check bzr status and bzr diff output.
If you have run bzrmerge enough times, the "pending merge tip" in bzr
status should be the last revision from the emacs-23 branch, and
status should be the last revision from the emacs-24 branch, and
bzr status -v should show all the revisions you expect to merge.
(Note that it will also show "skipped" revisions. This is expected,
@ -141,18 +136,13 @@ authors, don't break the logical ordering in doing this.
Notes:
1) A lot that was in tramp.el in emacs-23 has moved to tramp-sh.el in
the trunk. If you end up with a conflict in tramp.el, the changes may
need to go to tramp-sh.el instead. Remember to update the file name in
the ChangeLog.
2) If a file is modified in emacs-23, and deleted in the trunk, you
1) If a file is modified in emacs-24, and deleted in the trunk, you
get a "contents conflict". Assuming the changes don't need to be in
the trunk at all, use `bzr resolve path/to/file --take-this' to keep the
trunk version. Prior to bzr 2.2.3, this may fail. You can just
delete the .OTHER etc files by hand and use bzr resolve path/to/file.
3) Conflicts in autoload md5sums in comments. Strictly speaking, the
2) Conflicts in autoload md5sums in comments. Strictly speaking, the
right thing to do is merge everything else, resolve the conflict by
choosing either the trunk or branch version, then run `make -C lisp
autoloads' to update the md5sums to the correct trunk value before

17
lisp/ChangeLog
View file

@ -1,3 +1,20 @@
2014-04-18 Michael Albinus <michael.albinus@gmx.de>
* net/tramp.el (tramp-run-real-handler, tramp-file-name-handler):
Do not autoload.
(tramp-file-name-handler, tramp-completion-file-name-handler):
Revert patch from 2014-04-10, it isn't necessary anymore.
(tramp-autoload-file-name-handler)
(tramp-register-autoload-file-name-handlers): New defuns.
(top): Autoload call of `tramp-register-autoload-file-name-handlers'.
(tramp-register-file-name-handlers): Remove also
`tramp-autoload-file-name-handler' from `file-name-handler-list'.
Do not autoload its invocation, but eval it after loading of 'tramp.
* net/tramp-adb.el (tramp-unload-hook): Unload `tramp-adb'.
* net/tramp-compat.el (tramp-unload-hook): Unload `tramp-loaddefs'.
2014-04-17 Daniel Colascione <dancol@dancol.org>
Add support for bracketed paste mode; add infrastructure for

4
lisp/net/tramp-adb.el
View file

@ -1183,5 +1183,9 @@ connection if a previous connection has died for some reason."
(read (current-buffer)))
":" 'omit-nulls))))))))
(add-hook 'tramp-unload-hook
(lambda ()
(unload-feature 'tramp-adb 'force)))
(provide 'tramp-adb)
;;; tramp-adb.el ends here

1
lisp/net/tramp-compat.el
View file

@ -587,6 +587,7 @@ and replace a sub-expression, e.g.
(add-hook 'tramp-unload-hook
(lambda ()
(unload-feature 'tramp-loaddefs 'force)
(unload-feature 'tramp-compat 'force)))
(provide 'tramp-compat)

70
lisp/net/tramp.el
View file

@ -1943,8 +1943,7 @@ coding system might not be determined. This function repairs it."
(add-to-list
'result (cons (regexp-quote tmpname) (cdr elt)) 'append)))))
;;;###autoload
(progn (defun tramp-run-real-handler (operation args)
(defun tramp-run-real-handler (operation args)
"Invoke normal file name handler for OPERATION.
First arg specifies the OPERATION, second arg is a list of arguments to
pass to the OPERATION."
@ -1958,7 +1957,7 @@ pass to the OPERATION."
,(and (eq inhibit-file-name-operation operation)
inhibit-file-name-handlers)))
(inhibit-file-name-operation operation))
(apply operation args))))
(apply operation args)))
;;;###autoload
(progn (defun tramp-completion-run-real-handler (operation args)
@ -2100,22 +2099,12 @@ ARGS are the arguments OPERATION has been called with."
(tramp-compat-condition-case-unless-debug ,var ,bodyform ,@handlers)))
;; Main function.
;;;###autoload
(defun tramp-file-name-handler (operation &rest args)
"Invoke Tramp file name handler.
Falls back to normal file name handler if no Tramp file name handler exists."
(if tramp-mode
(save-match-data
(let* ((default-directory
;; Some packages set the default directory to a
;; remote path, before tramp.el has been loaded.
;; This results in recursive loading. Therefore, we
;; set `default-directory' to a local path. `args'
;; could also be remote when loading tramp.el, but
;; that would be such perverse we don't care about.
(if load-in-progress
temporary-file-directory default-directory))
(filename
(let* ((filename
(tramp-replace-environment-variables
(apply 'tramp-file-name-for-operation operation args)))
(completion (tramp-completion-mode-p))
@ -2227,11 +2216,8 @@ preventing reentrant calls of Tramp.")
"Invoke Tramp file name completion handler.
Falls back to normal file name handler if no Tramp file name handler exists."
;; We bind `directory-sep-char' here for XEmacs on Windows, which
;; would otherwise use backslash. For `default-directory', see
;; comment in `tramp-file-name-handler'.
;; would otherwise use backslash.
(let ((directory-sep-char ?/)
(default-directory
(if load-in-progress temporary-file-directory default-directory))
(fn (assoc operation tramp-completion-file-name-handler-alist)))
(if (and
;; When `tramp-mode' is not enabled, we don't do anything.
@ -2255,15 +2241,43 @@ Falls back to normal file name handler if no Tramp file name handler exists."
(tramp-completion-run-real-handler operation args)))))
;;;###autoload
(progn (defun tramp-register-file-name-handlers ()
(progn (defun tramp-autoload-file-name-handler (operation &rest args)
"Load Tramp file name handler, and perform OPERATION."
;; Avoid recursive loading of tramp.el.
(let ((default-directory temporary-file-directory))
(load "tramp" nil t))
(apply operation args)))
;; `tramp-autoload-file-name-handler' must be registered before
;; evaluation of site-start and init files, because there might exist
;; remote files already, f.e. files kept via recentf-mode. We cannot
;; autoload `tramp-file-name-handler', because it would result in
;; recursive loading of tramp.el when `default-directory' is set to
;; remote.
;;;###autoload
(progn (defun tramp-register-autoload-file-name-handlers ()
"Add Tramp file name handlers to `file-name-handler-alist' during autoload."
(add-to-list 'file-name-handler-alist
(cons tramp-file-name-regexp
'tramp-autoload-file-name-handler))
(put 'tramp-autoload-file-name-handler 'safe-magic t)
(add-to-list 'file-name-handler-alist
(cons tramp-completion-file-name-regexp
'tramp-completion-file-name-handler))
(put 'tramp-completion-file-name-handler 'safe-magic t)))
;;;###autoload
(tramp-register-autoload-file-name-handlers)
(defun tramp-register-file-name-handlers ()
"Add Tramp file name handlers to `file-name-handler-alist'."
;; Remove autoloaded handlers from file name handler alist. Useful,
;; if `tramp-syntax' has been changed.
(let ((a1 (rassq 'tramp-file-name-handler file-name-handler-alist)))
(setq file-name-handler-alist (delq a1 file-name-handler-alist)))
(let ((a1 (rassq
'tramp-completion-file-name-handler file-name-handler-alist)))
(setq file-name-handler-alist (delq a1 file-name-handler-alist)))
(dolist (fnh '(tramp-file-name-handler
tramp-completion-file-name-handler
tramp-autoload-file-name-handler))
(let ((a1 (rassq fnh file-name-handler-alist)))
(setq file-name-handler-alist (delq a1 file-name-handler-alist))))
;; Add the handlers.
(add-to-list 'file-name-handler-alist
(cons tramp-file-name-regexp 'tramp-file-name-handler))
@ -2278,13 +2292,9 @@ Falls back to normal file name handler if no Tramp file name handler exists."
(let ((entry (rassoc fnh file-name-handler-alist)))
(when entry
(setq file-name-handler-alist
(cons entry (delete entry file-name-handler-alist))))))))
(cons entry (delete entry file-name-handler-alist)))))))
;; `tramp-file-name-handler' must be registered before evaluation of
;; site-start and init files, because there might exist remote files
;; already, f.e. files kept via recentf-mode.
;;;###autoload
(tramp-register-file-name-handlers)
(eval-after-load 'tramp (tramp-register-file-name-handlers))
(defun tramp-exists-file-name-handler (operation &rest args)
"Check, whether OPERATION runs a file name handler."

20
src/ChangeLog
View file

@ -1,3 +1,22 @@
2014-04-18 Paul Eggert <eggert@cs.ucla.edu>
* emacs.c (close_output_streams): Don't clear and restore errno.
2014-04-18 Jan Djärv <jan.h.d@swipnet.se>
* xterm.c (x_make_frame_visible): Prevent endless loop when frame
never becomes visible, i.e. using XMonad (Bug#17237).
2014-04-18 Eli Zaretskii <eliz@gnu.org>
* xdisp.c (insert_left_trunc_glyphs): Ensure the left truncation
glyph is written to TEXT_AREA of the temporary glyph_row. (Bug#17288)
(Fline_pixel_height): Don't assume that the current buffer and the
selected window's buffer are one and the same. (Bug#17281)
* insdel.c (invalidate_buffer_caches): Invalidate the bidi
paragraph-start cache before the newline cache. (Bug#17269)
2014-04-17 Paul Eggert <eggert@cs.ucla.edu>
* term.c (tty_send_additional_strings): No need to fflush here,
@ -23,6 +42,7 @@
2014-04-16 Eli Zaretskii <eliz@gnu.org>
Fix the MSDOS build.
* unexcoff.c [MSDOS]: Include libc/atexit.h.
(copy_text_and_data): Zero out the atexit chain pointer before
dumping Emacs.

7
src/emacs.c
View file

@ -690,11 +690,6 @@ void (*__malloc_initialize_hook) (void) EXTERNALLY_VISIBLE = malloc_initialize_h
static void
close_output_streams (void)
{
int err = errno;
/* close_stream checks errno, so make sure it doesn't inherit some
random value. */
errno = 0;
if (close_stream (stdout) != 0)
{
emacs_perror ("Write error to standard output");
@ -703,8 +698,6 @@ close_output_streams (void)
if (close_stream (stderr) != 0)
_exit (EXIT_FAILURE);
errno = err;
}
/* ARGSUSED */

22
src/insdel.c
View file

@ -1849,14 +1849,9 @@ invalidate_buffer_caches (struct buffer *buf, ptrdiff_t start, ptrdiff_t end)
need to consider the caches of their base buffer. */
if (buf->base_buffer)
buf = buf->base_buffer;
if (buf->newline_cache)
invalidate_region_cache (buf,
buf->newline_cache,
start - BUF_BEG (buf), BUF_Z (buf) - end);
if (buf->width_run_cache)
invalidate_region_cache (buf,
buf->width_run_cache,
start - BUF_BEG (buf), BUF_Z (buf) - end);
/* The bidi_paragraph_cache must be invalidated first, because doing
so might need to use the newline_cache (via find_newline_no_quit,
see below). */
if (buf->bidi_paragraph_cache)
{
if (start != end
@ -1880,13 +1875,20 @@ invalidate_buffer_caches (struct buffer *buf, ptrdiff_t start, ptrdiff_t end)
&start_byte);
set_buffer_internal (old);
}
if (line_beg > BUF_BEG (buf))
start = line_beg - 1;
start = line_beg - (line_beg > BUF_BEG (buf));
}
invalidate_region_cache (buf,
buf->bidi_paragraph_cache,
start - BUF_BEG (buf), BUF_Z (buf) - end);
}
if (buf->newline_cache)
invalidate_region_cache (buf,
buf->newline_cache,
start - BUF_BEG (buf), BUF_Z (buf) - end);
if (buf->width_run_cache)
invalidate_region_cache (buf,
buf->width_run_cache,
start - BUF_BEG (buf), BUF_Z (buf) - end);
}
/* These macros work with an argument named `preserve_ptr'

14
src/xdisp.c
View file

@ -1262,12 +1262,23 @@ Value is the height in pixels of the line at point. */)
struct it it;
struct text_pos pt;
struct window *w = XWINDOW (selected_window);
struct buffer *old_buffer = NULL;
Lisp_Object result;
if (XBUFFER (w->contents) != current_buffer)
{
old_buffer = current_buffer;
set_buffer_internal_1 (XBUFFER (w->contents));
}
SET_TEXT_POS (pt, PT, PT_BYTE);
start_display (&it, w, pt);
it.vpos = it.current_y = 0;
last_height = 0;
return make_number (line_bottom_y (&it));
result = make_number (line_bottom_y (&it));
if (old_buffer)
set_buffer_internal_1 (old_buffer);
return result;
}
/* Return the default pixel height of text lines in window W. The
@ -18677,6 +18688,7 @@ insert_left_trunc_glyphs (struct it *it)
truncate_it.current_x = 0;
truncate_it.face_id = DEFAULT_FACE_ID;
truncate_it.glyph_row = &scratch_glyph_row;
truncate_it.area = TEXT_AREA;
truncate_it.glyph_row->used[TEXT_AREA] = 0;
CHARPOS (truncate_it.position) = BYTEPOS (truncate_it.position) = -1;
truncate_it.object = make_number (0);

9
src/xterm.c
View file

@ -8900,6 +8900,7 @@ void
x_make_frame_visible (struct frame *f)
{
int original_top, original_left;
int tries = 0;
block_input ();
@ -9007,7 +9008,13 @@ x_make_frame_visible (struct frame *f)
/* Force processing of queued events. */
x_sync (f);
/* This hack is still in use at least for Cygwin. See
/* If on another desktop, the deiconify/map may be ignored and the
frame never becomes visible. XMonad does this.
Prevent an endless loop. */
if (FRAME_ICONIFIED_P (f) && ++tries > 100)
break;
/* This hack is still in use at least for Cygwin. See
http://lists.gnu.org/archive/html/emacs-devel/2013-12/msg00351.html.
Machines that do polling rather than SIGIO have been

15
test/ChangeLog
View file

@ -1,3 +1,18 @@
2014-04-18 Michael Albinus <michael.albinus@gmx.de>
* automated/tramp-tests.el (tramp-copy-size-limit): Set to nil.
(tramp--test-make-temp-name): Optional argument LOCAL.
(tramp--instrument-test-case): Show messages. Catch also `quit'.
(tramp-test10-write-region): No special test for out-of-band copy
needed anymore.
(tramp-test11-copy-file, tramp-test12-rename-file)
(tramp-test21-file-links): Extend tests.
(tramp-test20-file-modes): More robust check for user "root".
(tramp--test-check-files): New defun.
(tramp-test30-special-characters, tramp-test33-recursive-load)
(tramp-test34-unload): New tests.
(tramp-test31-utf8, tramp-test32-asynchronous-requests): Rename.
2014-04-11 Glenn Morris <rgm@gnu.org>
* automated/Makefile.in (EMACSDATA, EMACSDOC, EMACSPATH): Unexport.

298
test/automated/tramp-tests.el
View file

@ -56,6 +56,7 @@
(setq password-cache-expiry nil
tramp-verbose 0
tramp-copy-size-limit nil
tramp-message-show-message nil)
;; Disable interactive passwords in batch mode.
@ -92,10 +93,11 @@ being the result.")
;; Return result.
(cdr tramp--test-enabled-checked))
(defun tramp--test-make-temp-name ()
(defun tramp--test-make-temp-name (&optional local)
"Create a temporary file name for test."
(expand-file-name
(make-temp-name "tramp-test") tramp-test-temporary-file-directory))
(make-temp-name "tramp-test")
(if local temporary-file-directory tramp-test-temporary-file-directory)))
(defmacro tramp--instrument-test-case (verbose &rest body)
"Run BODY with `tramp-verbose' equal VERBOSE.
@ -103,12 +105,17 @@ Print the the content of the Tramp debug buffer, if BODY does not
eval properly in `should', `should-not' or `should-error'."
(declare (indent 1) (debug (natnump body)))
`(let ((tramp-verbose ,verbose)
(tramp-message-show-message t)
(tramp-debug-on-error t))
(condition-case err
(progn ,@body)
;; In general, we cannot use a timeout here: this would
;; prevent traces when the test runs into an error.
; (with-timeout (10 (ert-fail "`tramp--instrument-test-case' timed out"))
(progn
,@body)
(ert-test-skipped
(signal (car err) (cdr err)))
(error
((error quit)
(with-parsed-tramp-file-name tramp-test-temporary-file-directory nil
(with-current-buffer (tramp-get-connection-buffer v)
(message "%s" (buffer-string)))
@ -662,15 +669,7 @@ and `file-name-nondirectory'."
(write-region 3 5 tmp-name))
(with-temp-buffer
(insert-file-contents tmp-name)
(should (string-equal (buffer-string) "34")))
;; Trigger out-of-band copy.
(let ((string ""))
(while (<= (length string) tramp-copy-size-limit)
(setq string (concat string (md5 string))))
(write-region string nil tmp-name)
(with-temp-buffer
(insert-file-contents tmp-name)
(should (string-equal (buffer-string) string)))))
(should (string-equal (buffer-string) "34"))))
(ignore-errors (delete-file tmp-name)))))
(ert-deftest tramp-test11-copy-file ()
@ -678,7 +677,12 @@ and `file-name-nondirectory'."
(skip-unless (tramp--test-enabled))
(let ((tmp-name1 (tramp--test-make-temp-name))
(tmp-name2 (tramp--test-make-temp-name)))
(tmp-name2 (tramp--test-make-temp-name))
(tmp-name3 (tramp--test-make-temp-name))
(tmp-name4 (tramp--test-make-temp-name 'local))
(tmp-name5 (tramp--test-make-temp-name 'local)))
;; Copy on remote side.
(unwind-protect
(progn
(write-region "foo" nil tmp-name1)
@ -686,17 +690,69 @@ and `file-name-nondirectory'."
(should (file-exists-p tmp-name2))
(with-temp-buffer
(insert-file-contents tmp-name2)
(should (string-equal (buffer-string) "foo"))))
(ignore-errors
(delete-file tmp-name1)
(delete-file tmp-name2)))))
(should (string-equal (buffer-string) "foo")))
(should-error (copy-file tmp-name1 tmp-name2))
(copy-file tmp-name1 tmp-name2 'ok)
(make-directory tmp-name3)
(copy-file tmp-name1 tmp-name3)
(should
(file-exists-p
(expand-file-name (file-name-nondirectory tmp-name1) tmp-name3))))
(ignore-errors (delete-file tmp-name1))
(ignore-errors (delete-file tmp-name2))
(ignore-errors (delete-directory tmp-name3 'recursive)))
;; Copy from remote side to local side.
(unwind-protect
(progn
(write-region "foo" nil tmp-name1)
(copy-file tmp-name1 tmp-name4)
(should (file-exists-p tmp-name4))
(with-temp-buffer
(insert-file-contents tmp-name4)
(should (string-equal (buffer-string) "foo")))
(should-error (copy-file tmp-name1 tmp-name4))
(copy-file tmp-name1 tmp-name4 'ok)
(make-directory tmp-name5)
(copy-file tmp-name1 tmp-name5)
(should
(file-exists-p
(expand-file-name (file-name-nondirectory tmp-name1) tmp-name5))))
(ignore-errors (delete-file tmp-name1))
(ignore-errors (delete-file tmp-name4))
(ignore-errors (delete-directory tmp-name5 'recursive)))
;; Copy from local side to remote side.
(unwind-protect
(progn
(write-region "foo" nil tmp-name4 nil 'nomessage)
(copy-file tmp-name4 tmp-name1)
(should (file-exists-p tmp-name1))
(with-temp-buffer
(insert-file-contents tmp-name1)
(should (string-equal (buffer-string) "foo")))
(should-error (copy-file tmp-name4 tmp-name1))
(copy-file tmp-name4 tmp-name1 'ok)
(make-directory tmp-name3)
(copy-file tmp-name4 tmp-name3)
(should
(file-exists-p
(expand-file-name (file-name-nondirectory tmp-name4) tmp-name3))))
(ignore-errors (delete-file tmp-name1))
(ignore-errors (delete-file tmp-name4))
(ignore-errors (delete-directory tmp-name3 'recursive)))))
(ert-deftest tramp-test12-rename-file ()
"Check `rename-file'."
(skip-unless (tramp--test-enabled))
(let ((tmp-name1 (tramp--test-make-temp-name))
(tmp-name2 (tramp--test-make-temp-name)))
(tmp-name2 (tramp--test-make-temp-name))
(tmp-name3 (tramp--test-make-temp-name))
(tmp-name4 (tramp--test-make-temp-name 'local))
(tmp-name5 (tramp--test-make-temp-name 'local)))
;; Rename on remote side.
(unwind-protect
(progn
(write-region "foo" nil tmp-name1)
@ -705,8 +761,71 @@ and `file-name-nondirectory'."
(should (file-exists-p tmp-name2))
(with-temp-buffer
(insert-file-contents tmp-name2)
(should (string-equal (buffer-string) "foo"))))
(ignore-errors (delete-file tmp-name2)))))
(should (string-equal (buffer-string) "foo")))
(write-region "foo" nil tmp-name1)
(should-error (rename-file tmp-name1 tmp-name2))
(rename-file tmp-name1 tmp-name2 'ok)
(should-not (file-exists-p tmp-name1))
(write-region "foo" nil tmp-name1)
(make-directory tmp-name3)
(rename-file tmp-name1 tmp-name3)
(should-not (file-exists-p tmp-name1))
(should
(file-exists-p
(expand-file-name (file-name-nondirectory tmp-name1) tmp-name3))))
(ignore-errors (delete-file tmp-name1))
(ignore-errors (delete-file tmp-name2))
(ignore-errors (delete-directory tmp-name3 'recursive)))
;; Rename from remote side to local side.
(unwind-protect
(progn
(write-region "foo" nil tmp-name1)
(rename-file tmp-name1 tmp-name4)
(should-not (file-exists-p tmp-name1))
(should (file-exists-p tmp-name4))
(with-temp-buffer
(insert-file-contents tmp-name4)
(should (string-equal (buffer-string) "foo")))
(write-region "foo" nil tmp-name1)
(should-error (rename-file tmp-name1 tmp-name4))
(rename-file tmp-name1 tmp-name4 'ok)
(should-not (file-exists-p tmp-name1))
(write-region "foo" nil tmp-name1)
(make-directory tmp-name5)
(rename-file tmp-name1 tmp-name5)
(should-not (file-exists-p tmp-name1))
(should
(file-exists-p
(expand-file-name (file-name-nondirectory tmp-name1) tmp-name5))))
(ignore-errors (delete-file tmp-name1))
(ignore-errors (delete-file tmp-name4))
(ignore-errors (delete-directory tmp-name5 'recursive)))
;; Rename from local side to remote side.
(unwind-protect
(progn
(write-region "foo" nil tmp-name4 nil 'nomessage)
(rename-file tmp-name4 tmp-name1)
(should-not (file-exists-p tmp-name4))
(should (file-exists-p tmp-name1))
(with-temp-buffer
(insert-file-contents tmp-name1)
(should (string-equal (buffer-string) "foo")))
(write-region "foo" nil tmp-name4 nil 'nomessage)
(should-error (rename-file tmp-name4 tmp-name1))
(rename-file tmp-name4 tmp-name1 'ok)
(should-not (file-exists-p tmp-name4))
(write-region "foo" nil tmp-name4 nil 'nomessage)
(make-directory tmp-name3)
(rename-file tmp-name4 tmp-name3)
(should-not (file-exists-p tmp-name4))
(should
(file-exists-p
(expand-file-name (file-name-nondirectory tmp-name4) tmp-name3))))
(ignore-errors (delete-file tmp-name1))
(ignore-errors (delete-file tmp-name4))
(ignore-errors (delete-directory tmp-name3 'recursive)))))
(ert-deftest tramp-test13-make-directory ()
"Check `make-directory'.
@ -930,7 +1049,7 @@ This tests also `file-executable-p', `file-writable-p' and `set-file-modes'."
(should (= (file-modes tmp-name) #o444))
(should-not (file-executable-p tmp-name))
;; A file is always writable for user "root".
(when (not (string-equal (file-remote-p tmp-name 'user) "root"))
(unless (zerop (nth 2 (file-attributes tmp-name)))
(should-not (file-writable-p tmp-name))))
(ignore-errors (delete-file tmp-name)))))
@ -941,7 +1060,7 @@ This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'."
(let ((tmp-name1 (tramp--test-make-temp-name))
(tmp-name2 (tramp--test-make-temp-name))
(tmp-name3 (make-temp-name "tramp-")))
(tmp-name3 (tramp--test-make-temp-name 'local)))
(unwind-protect
(progn
(write-region "foo" nil tmp-name1)
@ -988,16 +1107,18 @@ This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'."
(should (file-symlink-p tmp-name2))
(should-not (string-equal tmp-name2 (file-truename tmp-name2)))
(should
(string-equal (file-truename tmp-name1) (file-truename tmp-name2))))
(string-equal (file-truename tmp-name1) (file-truename tmp-name2)))
(should (file-equal-p tmp-name1 tmp-name2)))
(ignore-errors
(delete-file tmp-name1)
(delete-file tmp-name2)))
;; `file-truename' shall preserve trailing link of directories.
(let* ((dir1 (directory-file-name tramp-test-temporary-file-directory))
(dir2 (file-name-as-directory dir1)))
(should (string-equal (file-truename dir1) (expand-file-name dir1)))
(should (string-equal (file-truename dir2) (expand-file-name dir2))))))
(unless (file-symlink-p tramp-test-temporary-file-directory)
(let* ((dir1 (directory-file-name tramp-test-temporary-file-directory))
(dir2 (file-name-as-directory dir1)))
(should (string-equal (file-truename dir1) (expand-file-name dir1)))
(should (string-equal (file-truename dir2) (expand-file-name dir2)))))))
(ert-deftest tramp-test22-file-times ()
"Check `set-file-times' and `file-newer-than-file-p'."
@ -1295,35 +1416,61 @@ This tests also `make-symbolic-link', `file-truename' and `add-name-to-file'."
(ignore-errors (delete-directory tmp-name1 'recursive)))))
(ert-deftest tramp-test30-utf8 ()
"Check UTF8 encoding in file names and file contents."
(skip-unless (tramp--test-enabled))
(let ((tmp-name (tramp--test-make-temp-name))
(coding-system-for-read 'utf-8)
(coding-system-for-write 'utf-8)
(arabic "أصبح بوسعك الآن تنزيل نسخة كاملة من موسوعة ويكيبيديا العربية لتصفحها بلا اتصال بالإنترنت")
(chinese "银河系漫游指南系列")
(russian "Автостопом по гала́ктике"))
(defun tramp--test-check-files (&rest files)
"Runs a simple but comprehensive test over every file in FILES."
(let ((tmp-name (tramp--test-make-temp-name)))
(unwind-protect
(progn
(make-directory tmp-name)
(dolist (lang `(,arabic ,chinese ,russian))
(let ((file (expand-file-name lang tmp-name)))
(write-region lang nil file)
(dolist (elt files)
(let ((file (expand-file-name elt tmp-name)))
(write-region elt nil file)
(should (file-exists-p file))
;; Check file contents.
(with-temp-buffer
(insert-file-contents file)
(should (string-equal (buffer-string) lang)))))
(should (string-equal (buffer-string) elt)))))
;; Check file names.
(should (equal (directory-files
tmp-name nil directory-files-no-dot-files-regexp)
(sort `(,arabic ,chinese ,russian) 'string-lessp))))
(sort files 'string-lessp))))
(ignore-errors (delete-directory tmp-name 'recursive)))))
;; This test is inspired by Bug#17238.
(ert-deftest tramp-test30-special-characters ()
"Check special characters in file names."
(skip-unless (tramp--test-enabled))
;; Newlines and slashes in file names are not supported. So we don't test.
(tramp--test-check-files
" foo bar\tbaz "
"$foo$bar$$baz$"
"-foo-bar-baz-"
"%foo%bar%baz%"
"&foo&bar&baz&"
"?foo?bar?baz?"
"*foo*bar*baz*"
"'foo\"bar'baz\""
"\\foo\\bar\\baz\\"
"#foo#bar#baz#"
"!foo|bar!baz|"
":foo;bar:baz;"
"<foo>bar<baz>"
"(foo)bar(baz)"))
(ert-deftest tramp-test31-utf8 ()
"Check UTF8 encoding in file names and file contents."
(skip-unless (tramp--test-enabled))
(let ((coding-system-for-read 'utf-8)
(coding-system-for-write 'utf-8))
(tramp--test-check-files
"أصبح بوسعك الآن تنزيل نسخة كاملة من موسوعة ويكيبيديا العربية لتصفحها بلا اتصال بالإنترنت"
"银河系漫游指南系列"
"Автостопом по гала́ктике")))
;; This test is inspired by Bug#16928.
(ert-deftest tramp-test31-asynchronous-requests ()
(ert-deftest tramp-test32-asynchronous-requests ()
"Check parallel asynchronous requests.
Such requests could arrive from timers, process filters and
process sentinels. They shall not disturb each other."
@ -1412,6 +1559,62 @@ process sentinels. They shall not disturb each other."
(dolist (buf buffers)
(ignore-errors (kill-buffer buf)))))))
(ert-deftest tramp-test33-recursive-load ()
"Check that Tramp does not fail due to recursive load."
(skip-unless (tramp--test-enabled))
(dolist (code
(list
(format
"(expand-file-name %S))"
tramp-test-temporary-file-directory)
(format
"(let ((default-directory %S)) (expand-file-name %S))"
tramp-test-temporary-file-directory
temporary-file-directory)))
(should-not
(string-match
"Recursive load"
(shell-command-to-string
(format
"%s -batch -Q -L %s --eval %s"
(expand-file-name invocation-name invocation-directory)
(mapconcat 'shell-quote-argument load-path " -L ")
(shell-quote-argument code)))))))
(ert-deftest tramp-test34-unload ()
"Check that Tramp and its subpackages unload completely.
Since it unloads Tramp, it shall be the last test to run."
;; Mark as failed until all symbols are unbound.
:expected-result (if (featurep 'tramp) :failed :passed)
(when (featurep 'tramp)
(unload-feature 'tramp 'force)
;; No Tramp feature must be left.
(should-not (featurep 'tramp))
(should-not (all-completions "tramp" (delq 'tramp-tests features)))
;; `file-name-handler-alist' must be clean.
(should-not (all-completions "tramp" (mapcar 'cdr file-name-handler-alist)))
;; There shouldn't be left a bound symbol. We do not regard our
;; test symbols, and the Tramp unload hooks.
(mapatoms
(lambda (x)
(and (or (boundp x) (functionp x))
(string-match "^tramp" (symbol-name x))
(not (string-match "^tramp--?test" (symbol-name x)))
(not (string-match "unload-hook$" (symbol-name x)))
(ert-fail (format "`%s' still bound" x)))))
; (progn (message "`%s' still bound" x)))))
;; There shouldn't be left a hook function containing a Tramp
;; function. We do not regard the Tramp unload hooks.
(mapatoms
(lambda (x)
(and (boundp x)
(string-match "-hooks?$" (symbol-name x))
(not (string-match "unload-hook$" (symbol-name x)))
(consp (symbol-value x))
(ignore-errors (all-completions "tramp" (symbol-value x)))
(ert-fail (format "Hook `%s' still contains Tramp function" x)))))))
;; TODO:
;; * dired-compress-file
@ -1426,8 +1629,11 @@ process sentinels. They shall not disturb each other."
;; * Fix `tramp-test27-start-file-process' on MS Windows (`process-send-eof'?).
;; * Fix `tramp-test28-shell-command' on MS Windows (nasty plink message).
;; * Fix `tramp-test30-utf8' on MS Windows. Seems to be in `directory-files'.
;; * Fix Bug#16928. Set expected error of `tramp-test31-asynchronous-requests'.
;; * Fix `tramp-test31-utf8' for MS Windows and `nc'/`telnet' (when
;; target is a dumb busybox). Seems to be in `directory-files'.
;; * Fix Bug#16928. Set expected error of `tramp-test32-asynchronous-requests'.
;; * Fix `tramp-test34-unload' (Not all symbols are unbound). Set
;; expected error.
(defun tramp-test-all (&optional interactive)
"Run all tests for \\[tramp]."