[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[Emacs-diffs] feature/tramp-thread-safe 1ed8d00: Merge branch 'master' i
|
From: |
Michael Albinus |
|
Subject: |
[Emacs-diffs] feature/tramp-thread-safe 1ed8d00: Merge branch 'master' into feature/tramp-thread-safe |
|
Date: |
Fri, 31 Aug 2018 07:10:44 -0400 (EDT) |
branch: feature/tramp-thread-safe
commit 1ed8d0030bf0fb2d64be3d52debda84b590fd55f
Merge: 279618b ee2509b
Author: Michael Albinus <address@hidden>
Commit: Michael Albinus <address@hidden>
Merge branch 'master' into feature/tramp-thread-safe
---
admin/admin.el | 17 +-
build-aux/git-hooks/pre-commit | 16 +-
configure.ac | 24 ++-
doc/lispref/debugging.texi | 3 +
doc/lispref/threads.texi | 12 +-
doc/misc/rcirc.texi | 60 ++-----
etc/NEWS | 9 ++
etc/NEWS.26 | 5 +
etc/PROBLEMS | 20 +++
lisp/calc/calc-cplx.el | 4 +-
lisp/emacs-lisp/checkdoc.el | 2 +-
lisp/emacs-lisp/thread.el | 44 +++++
lisp/gnus/mm-view.el | 12 +-
lisp/vc/vc.el | 8 +-
src/alloc.c | 22 +--
src/bignum.c | 37 ++++-
src/editfns.c | 359 ++++++++++++++++++++++-------------------
src/emacs-module.c | 8 +-
src/eval.c | 2 +-
src/font.c | 2 +-
src/image.c | 3 +-
src/keyboard.c | 27 +++-
src/keymap.c | 93 ++++-------
src/lisp.h | 5 +-
src/print.c | 9 +-
src/termhooks.h | 4 +
src/thread.c | 52 ++++--
src/xdisp.c | 20 ++-
test/lisp/calc/calc-tests.el | 7 +
test/src/editfns-tests.el | 17 +-
test/src/thread-tests.el | 39 +++--
31 files changed, 557 insertions(+), 385 deletions(-)
diff --git a/admin/admin.el b/admin/admin.el
index 3cb5dbc..1cad7ae 100644
--- a/admin/admin.el
+++ b/admin/admin.el
@@ -352,13 +352,22 @@ Optional argument TYPE is type of output (nil means all)."
(manual-html-mono texi (expand-file-name (concat name ".html")
html-mono-dir))))
+(defvar manual-makeinfo (or (getenv "MAKEINFO") "makeinfo")
+ "The `makeinfo' program to use.")
+
+(defvar manual-texi2pdf (or (getenv "TEXI2PDF") "texi2pdf")
+ "The `texi2pdf' program to use.")
+
+(defvar manual-texi2dvi (or (getenv "TEXI2DVI") "texi2dvi")
+ "The `texi2dvi' program to use.")
+
(defun manual-html-mono (texi-file dest)
"Run Makeinfo on TEXI-FILE, emitting mono HTML output to DEST.
This function also edits the HTML files so that they validate as
HTML 4.01 Transitional, and pulls in the gnu.org stylesheet using
the @import directive."
(make-directory (or (file-name-directory dest) ".") t)
- (call-process "makeinfo" nil nil nil
+ (call-process manual-makeinfo nil nil nil
"-D" "WWW_GNU_ORG"
"-I" (expand-file-name "../emacs"
(file-name-directory texi-file))
@@ -386,7 +395,7 @@ the @import directive."
(unless (file-exists-p texi-file)
(user-error "Manual file %s not found" texi-file))
(make-directory dir t)
- (call-process "makeinfo" nil nil nil
+ (call-process manual-makeinfo nil nil nil
"-D" "WWW_GNU_ORG"
"-I" (expand-file-name "../emacs"
(file-name-directory texi-file))
@@ -425,7 +434,7 @@ the @import directive."
"Run texi2pdf on TEXI-FILE, emitting PDF output to DEST."
(make-directory (or (file-name-directory dest) ".") t)
(let ((default-directory (file-name-directory texi-file)))
- (call-process "texi2pdf" nil nil nil
+ (call-process manual-texi2pdf nil nil nil
"-I" "../emacs" "-I" "../misc"
texi-file "-o" dest)))
@@ -435,7 +444,7 @@ the @import directive."
(let ((dvi-dest (concat (file-name-sans-extension dest) ".dvi"))
(default-directory (file-name-directory texi-file)))
;; FIXME: Use `texi2dvi --ps'? --xfq
- (call-process "texi2dvi" nil nil nil
+ (call-process manual-texi2dvi nil nil nil
"-I" "../emacs" "-I" "../misc"
texi-file "-o" dvi-dest)
(call-process "dvips" nil nil nil dvi-dest "-o" dest)
diff --git a/build-aux/git-hooks/pre-commit b/build-aux/git-hooks/pre-commit
index 5e42dab..c0455fb 100755
--- a/build-aux/git-hooks/pre-commit
+++ b/build-aux/git-hooks/pre-commit
@@ -28,7 +28,7 @@ exec >&2
# When doing a two-way merge, ignore problems that came from the other
# side of the merge.
head=HEAD
-if test -r "$GIT_DIR"/MERGE_HEAD; then
+if test -r "$GIT_DIR"/MERGE_HEAD && test "$GIT_MERGE_CHECK_OTHER" != true; then
merge_heads=`cat "$GIT_DIR"/MERGE_HEAD` || exit
for merge_head in $merge_heads; do
case $head in
@@ -42,15 +42,10 @@ if test -r "$GIT_DIR"/MERGE_HEAD; then
fi
git_diff='git diff --cached --name-only --diff-filter=A'
-ok_chars='\0+[=-=]./0-9A-Z_a-z'
-nbadchars=`$git_diff -z $head | tr -d "$ok_chars" | wc -c`
-if test "$nbadchars" -ne 0; then
- echo "File name does not consist of -+./_ or ASCII letters or digits."
- exit 1
-fi
-
-for new_name in `$git_diff $head`; do
+# 'git diff' will backslash escape tabs and newlines, so we don't have
+# to worry about word splitting here.
+$git_diff $head | sane_egrep 'ChangeLog|^-|/-|[^-+./_0-9A-Z_a-z]' | while IFS=
read -r new_name; do
case $new_name in
-* | */-*)
echo "$new_name: File name component begins with '-'."
@@ -58,6 +53,9 @@ for new_name in `$git_diff $head`; do
ChangeLog | */ChangeLog)
echo "$new_name: Please use git commit messages, not ChangeLog files."
exit 1;;
+ *)
+ echo "$new_name: File name does not consist of -+./_ or ASCII letters or
digits."
+ exit 1;;
esac
done
diff --git a/configure.ac b/configure.ac
index 31750ef..6f3d733 100644
--- a/configure.ac
+++ b/configure.ac
@@ -363,7 +363,7 @@ OPTION_DEFAULT_ON([m17n-flt],[don't use m17n-flt for text
shaping])
OPTION_DEFAULT_ON([toolkit-scroll-bars],[don't use Motif or Xaw3d scroll bars])
OPTION_DEFAULT_ON([xaw3d],[don't use Xaw3d])
-OPTION_DEFAULT_ON([xim],[don't use X11 XIM])
+OPTION_DEFAULT_ON([xim],[at runtime, default X11 XIM to off])
AC_ARG_WITH([ns],[AS_HELP_STRING([--with-ns],
[use Nextstep (macOS Cocoa or GNUstep) windowing system.
On by default on macOS.])],[],[with_ns=maybe])
@@ -1557,7 +1557,6 @@ case $opsys in
LIB_MATH=
SYSTEM_TYPE=windows-nt
;;
- dnl NB this may be adjusted below.
netbsd | openbsd )
SYSTEM_TYPE=berkeley-unix
;;
@@ -2516,10 +2515,9 @@ if test "${HAVE_X11}" = "yes" || test "${HAVE_NS}" =
"yes" || test "${HAVE_W32}"
export PKG_CONFIG_PATH="$PKG_CONFIG_PATH$PATH_SEPARATOR`$BREW --prefix
address@hidden 2>/dev/null`/lib/pkgconfig"
fi
- EMACS_CHECK_MODULES([IMAGEMAGICK7], [MagickWand >= 7])
- if test $HAVE_IMAGEMAGICK7 = yes; then
+ EMACS_CHECK_MODULES([IMAGEMAGICK], [MagickWand >= 7])
+ if test $HAVE_IMAGEMAGICK = yes; then
AC_DEFINE([HAVE_IMAGEMAGICK7], 1, [Define to 1 if using ImageMagick7.])
- HAVE_IMAGEMAGICK = yes
else
## 6.3.5 is the earliest version known to work; see Bug#17339.
## 6.8.2 makes Emacs crash; see Bug#13867.
@@ -2544,8 +2542,6 @@ if test "${HAVE_X11}" = "yes" || test "${HAVE_NS}" =
"yes" || test "${HAVE_W32}"
fi
if test $HAVE_IMAGEMAGICK = yes; then
AC_DEFINE([HAVE_IMAGEMAGICK], 1, [Define to 1 if using ImageMagick.])
- AC_DEFINE_UNQUOTED([IMAGEMAGICK_MAJOR], [$IMAGEMAGICK_MAJOR],
- [ImageMagick major version number (from configure).])
else
IMAGEMAGICK_CFLAGS=
IMAGEMAGICK_LIBS=
@@ -3170,11 +3166,12 @@ AC_COMPILE_IFELSE([AC_LANG_PROGRAM([[
AC_DEFINE(HAVE_XIM, 1, [Define to 1 if XIM is available])],
HAVE_XIM=no)
-dnl '--with-xim' now controls only the initial value of use_xim at run time.
-
+dnl Note this is non-standard. --with-xim does not control whether
+dnl XIM support is compiled in, it only affects the runtime default of
+dnl use_xim in xterm.c.
if test "${with_xim}" != "no"; then
AC_DEFINE(USE_XIM, 1,
- [Define to 1 if we should use XIM, if it is available.])
+ [Define to 1 to default runtime use of XIM to on.])
fi
@@ -5429,12 +5426,13 @@ Configured for '${canonical}'.
optsep=
emacs_config_features=
for opt in XAW3D XPM JPEG TIFF GIF PNG RSVG CAIRO IMAGEMAGICK SOUND GPM DBUS \
- GCONF GSETTINGS NOTIFY ACL LIBSELINUX GNUTLS LIBXML2 FREETYPE M17N_FLT \
- LIBOTF XFT ZLIB TOOLKIT_SCROLL_BARS X_TOOLKIT OLDXMENU X11 NS MODULES \
- THREADS XWIDGETS LIBSYSTEMD JSON CANNOT_DUMP LCMS2 GMP; do
+ GCONF GSETTINGS GLIB NOTIFY ACL LIBSELINUX GNUTLS LIBXML2 FREETYPE M17N_FLT \
+ LIBOTF XFT ZLIB TOOLKIT_SCROLL_BARS X_TOOLKIT OLDXMENU X11 XDBE XIM \
+ NS MODULES THREADS XWIDGETS LIBSYSTEMD JSON CANNOT_DUMP LCMS2 GMP; do
case $opt in
CANNOT_DUMP) eval val=\${$opt} ;;
+ GLIB) val=${emacs_cv_links_glib} ;;
NOTIFY|ACL) eval val=\${${opt}_SUMMARY} ;;
TOOLKIT_SCROLL_BARS|X_TOOLKIT) eval val=\${USE_$opt} ;;
THREADS) val=${threads_enabled} ;;
diff --git a/doc/lispref/debugging.texi b/doc/lispref/debugging.texi
index 9b3ba6c..89927db 100644
--- a/doc/lispref/debugging.texi
+++ b/doc/lispref/debugging.texi
@@ -983,6 +983,9 @@ the execution time. If you find that one particular
function is
responsible for a significant portion of the execution time, you can
start looking for ways to optimize that piece.
address@hidden profiler-start
address@hidden profiler-report
address@hidden profiler-stop
Emacs has built-in support for this. To begin profiling, type
@kbd{M-x profiler-start}. You can choose to profile by processor
usage, memory usage, or both. Then run the code you'd like to speed
diff --git a/doc/lispref/threads.texi b/doc/lispref/threads.texi
index 58a3a91..9cdeb79 100644
--- a/doc/lispref/threads.texi
+++ b/doc/lispref/threads.texi
@@ -88,14 +88,8 @@ If @var{thread} was blocked by a call to @code{mutex-lock},
@code{condition-wait}, or @code{thread-join}; @code{thread-signal}
will unblock it.
-Since signal handlers in Emacs are located in the main thread, a
-signal must be propagated there in order to become visible. The
-second @code{signal} call let the thread die:
-
address@hidden
-(thread-signal main-thread 'error data)
-(signal 'error data)
address@hidden example
+If @var{thread} is the main thread, the signal is not propagated
+there. Instead, it is shown as message in the main thread.
@end defun
@defun thread-yield
@@ -106,7 +100,7 @@ Yield execution to the next runnable thread.
Return the name of @var{thread}, as specified to @code{make-thread}.
@end defun
address@hidden thread-alive-p thread
address@hidden thread-live-p thread
Return @code{t} if @var{thread} is alive, or @code{nil} if it is not.
A thread is alive as long as its function is still executing.
@end defun
diff --git a/doc/misc/rcirc.texi b/doc/misc/rcirc.texi
index 2437e02..0287054 100644
--- a/doc/misc/rcirc.texi
+++ b/doc/misc/rcirc.texi
@@ -88,7 +88,6 @@ Hacking and Tweaking
* Scrolling conservatively::
* Changing the time stamp format::
* Defining a new command::
-* Reconnecting after you have lost the connection::
@end detailmenu
@end menu
@@ -401,6 +400,23 @@ This disconnects from the server and parts all channels.
You can
optionally provide a reason for quitting. When you kill the server
buffer, you automatically quit the server and part all channels. (Also
@code{/quit ZZZzzz...}.)
+
address@hidden /reconnect
address@hidden /reconnect
address@hidden reconnect
address@hidden lost connection
address@hidden disconnecting servers, reconnecting
+This reconnects after you have lost the connection.
+
+If you're chatting from a laptop, then you might be familiar with this
+problem: When your laptop falls asleep and wakes up later, your IRC
+client doesn't realize that it has been disconnected. It takes several
+minutes until the client decides that the connection has in fact been
+lost. The simple solution is to use @kbd{M-x rcirc}. The problem is
+that this opens an @emph{additional} connection, so you'll have two
+copies of every channel buffer, one dead and one live.
+
+The real answer, therefore, is the @code{/reconnect} command.
@end table
@node Useful IRC commands
@@ -787,7 +803,6 @@ Here are some examples of stuff you can do to configure
@code{rcirc}.
* Scrolling conservatively::
* Changing the time stamp format::
* Defining a new command::
-* Reconnecting after you have lost the connection::
@end menu
@node Skipping /away messages using handlers
@@ -888,47 +903,6 @@ because @code{defun-rcirc-command} is not yet available,
and without
(concat "I use " rcirc-id-string))))
@end smallexample
address@hidden Reconnecting after you have lost the connection
address@hidden Reconnecting after you have lost the connection
address@hidden reconnecting
address@hidden disconnecting servers, reconnecting
-
-If you're chatting from a laptop, then you might be familiar with this
-problem: When your laptop falls asleep and wakes up later, your IRC
-client doesn't realize that it has been disconnected. It takes several
-minutes until the client decides that the connection has in fact been
-lost. The simple solution is to use @kbd{M-x rcirc}. The problem is
-that this opens an @emph{additional} connection, so you'll have two
-copies of every channel buffer, one dead and one live.
-
-The real answer, therefore, is a @code{/reconnect} command:
-
address@hidden
-(with-eval-after-load 'rcirc
- (defun-rcirc-command reconnect (arg)
- "Reconnect the server process."
- (interactive "i")
- (unless process
- (error "There's no process for this target"))
- (let* ((server (car (process-contact process)))
- (port (process-contact process :service))
- (nick (rcirc-nick process))
- channels query-buffers)
- (dolist (buf (buffer-list))
- (with-current-buffer buf
- (when (eq process (rcirc-buffer-process))
- (remove-hook 'change-major-mode-hook
- 'rcirc-change-major-mode-hook)
- (if (rcirc-channel-p rcirc-target)
- (setq channels (cons rcirc-target channels))
- (setq query-buffers (cons buf query-buffers))))))
- (delete-process process)
- (rcirc-connect server port nick
- rcirc-default-user-name
- rcirc-default-full-name
- channels))))
address@hidden smallexample
-
@node GNU Free Documentation License
@appendix GNU Free Documentation License
@include doclicense.texi
diff --git a/etc/NEWS b/etc/NEWS
index 733bd1d..970a422 100644
--- a/etc/NEWS
+++ b/etc/NEWS
@@ -739,6 +739,13 @@ to signal the main thread, e.g., when they encounter an
error.
+++
*** 'thread-join' returns the result of the finished thread now.
++++
+*** 'thread-signal' does not propagate errors to the main thread.
+Instead, error messages are just printed in the main thread.
+
+---
+*** 'thread-alive-p' is now obsolete, use 'thread-live-p' instead.
+
---
** thingatpt.el supports a new "thing" called 'uuid'.
A symbol 'uuid' can be passed to thing-at-point and it returns the
@@ -878,6 +885,8 @@ removed.
* Lisp Changes in Emacs 27.1
+** lookup-key can take a list of keymaps as argument.
+
+++
** New function 'proper-list-p'.
Given a proper list as argument, this predicate returns its length;
diff --git a/etc/NEWS.26 b/etc/NEWS.26
index e94bda5..9722270 100644
--- a/etc/NEWS.26
+++ b/etc/NEWS.26
@@ -99,6 +99,11 @@ option 'vc-hg-symbolic-revision-styles' to the value
'("{rev}")'.
Existing files "~/.emacs.d/shadows" and "~/.emacs.d/shadow_todo" must
be removed prior using the changed 'shadow-*' commands.
++++
+** 'thread-alive-p' has been renamed to 'thread-live-p'.
+The old name is an alias of the new name. Future Emacs version will
+obsolete it.
+
* Lisp Changes in Emacs 26.2
diff --git a/etc/PROBLEMS b/etc/PROBLEMS
index a1fae22..b863572 100644
--- a/etc/PROBLEMS
+++ b/etc/PROBLEMS
@@ -205,6 +205,26 @@ result in an endless loop.
If you need Emacs to be able to recover from closing displays, compile
it with the Lucid toolkit instead of GTK.
+** Emacs compiled with GTK+ 3 crashes when run under some X servers.
+This happens when the X server does not provide certain display
+features that the underlying GTK+ 3 toolkit assumes. For example, this
+issue has been seen with remote X servers like X2Go. The symptoms
+are an Emacs crash, possibly triggered by the mouse entering the Emacs
+window, or an attempt to resize the Emacs window. The crash backtrace
+contains a call to XQueryPointer.
+
+This issue was fixed in the GTK+ 3 toolkit in commit 4b1c0256 in February 2018.
+
+If your GTK+ 3 is still affected, you can avoid the issue by recompiling
+Emacs with a different X toolkit, eg --with-toolkit=gtk2.
+
+References:
+https://gitlab.gnome.org/GNOME/gtk/commit/4b1c02560f0d8097bf5a11932e52fb72f3e9e94b
+https://debbugs.gnu.org/24280
+https://bugs.debian.org/901038
+https://bugzilla.redhat.com/1483942
+https://access.redhat.com/solutions/3410101
+
** Emacs compiled with GTK crashes at startup due to X protocol error.
This is known to happen on elementary OS GNU/Linux systems.
diff --git a/lisp/calc/calc-cplx.el b/lisp/calc/calc-cplx.el
index 4a453a7..35cd31d 100644
--- a/lisp/calc/calc-cplx.el
+++ b/lisp/calc/calc-cplx.el
@@ -273,8 +273,8 @@
(or (eq (car-safe val) 'special-const)
(equal val '(cplx 0 1))
(and (eq (car-safe val) 'polar)
- (eq (nth 1 val) 0)
- (Math-equal (nth 1 val) (math-quarter-circle nil))))))
+ (eq (nth 1 val) 1)
+ (Math-equal (nth 2 val) (math-quarter-circle nil))))))
;;; Extract the real or complex part of a complex number. [R N] [Public]
;;; Also extracts the real part of a modulo form.
diff --git a/lisp/emacs-lisp/checkdoc.el b/lisp/emacs-lisp/checkdoc.el
index 1b3b23d..83929be 100644
--- a/lisp/emacs-lisp/checkdoc.el
+++ b/lisp/emacs-lisp/checkdoc.el
@@ -1837,7 +1837,7 @@ Replace with \"%s\"? " original replace)
(if (checkdoc-autofix-ask-replace
(match-beginning 1) (+ (match-beginning 1)
(length ms))
- msg (format-message "`%s'" ms) t)
+ msg (format "`%s'" ms) t)
(setq msg nil)
(setq msg
(format-message
diff --git a/lisp/emacs-lisp/thread.el b/lisp/emacs-lisp/thread.el
new file mode 100644
index 0000000..5d7b90c
--- /dev/null
+++ b/lisp/emacs-lisp/thread.el
@@ -0,0 +1,44 @@
+;;; thread.el --- List active threads in a buffer -*- lexical-binding: t -*-
+
+;; Copyright (C) 2018 Free Software Foundation, Inc.
+
+;; Author: Gemini Lasswell <address@hidden>
+;; Maintainer: address@hidden
+;; Keywords: lisp, tools, maint
+
+;; This file is part of GNU Emacs.
+
+;; GNU Emacs is free software: you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
+
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
+
+;;; Commentary:
+
+;;; Code:
+
+;;;###autoload
+(defun thread-handle-event (event)
+ "Handle thread events, propagated by `thread-signal'.
+An EVENT has the format
+ (thread-event THREAD ERROR-SYMBOL DATA)"
+ (interactive "e")
+ (if (and (consp event)
+ (eq (car event) 'thread-event)
+ (= (length event) 4))
+ (let ((thread (cadr event))
+ (err (cddr event)))
+ (message "Error %s: %S" thread err))))
+
+(make-obsolete 'thread-alive-p 'thread-live-p "27.1")
+
+(provide 'thread)
+;;; thread.el ends here
diff --git a/lisp/gnus/mm-view.el b/lisp/gnus/mm-view.el
index 50a927b..15eac11 100644
--- a/lisp/gnus/mm-view.el
+++ b/lisp/gnus/mm-view.el
@@ -452,7 +452,7 @@
"Insert HANDLE inline fontifying with MODE.
If MODE is not set, try to find mode automatically."
(let ((charset (mail-content-type-get (mm-handle-type handle) 'charset))
- text coding-system)
+ text coding-system ovs)
(unless (eq charset 'gnus-decoded)
(mm-with-unibyte-buffer
(mm-insert-part handle)
@@ -498,10 +498,18 @@ If MODE is not set, try to find mode automatically."
(eq major-mode 'fundamental-mode))
(font-lock-ensure))))
(setq text (buffer-string))
+ (when (eq mode 'diff-mode)
+ (setq ovs (mapcar (lambda (ov) (list ov (overlay-start ov)
+ (overlay-end ov)))
+ (overlays-in (point-min) (point-max)))))
;; Set buffer unmodified to avoid confirmation when killing the
;; buffer.
(set-buffer-modified-p nil))
- (mm-insert-inline handle text)))
+ (let ((b (1- (point))))
+ (mm-insert-inline handle text)
+ (dolist (ov ovs)
+ (move-overlay (nth 0 ov) (+ (nth 1 ov) b)
+ (+ (nth 2 ov) b) (current-buffer))))))
;; Shouldn't these functions check whether the user even wants to use
;; font-lock? Also, it would be nice to change for the size of the
diff --git a/lisp/vc/vc.el b/lisp/vc/vc.el
index b2bedfa..487594b 100644
--- a/lisp/vc/vc.el
+++ b/lisp/vc/vc.el
@@ -2268,11 +2268,11 @@ earlier revisions. Show up to LIMIT entries (non-nil
means unlimited)."
setup-buttons-func
goto-location-func
rev-buff-func)
- (let (retval)
- (with-current-buffer (get-buffer-create buffer-name)
+ (let (retval (buffer (get-buffer-create buffer-name)))
+ (with-current-buffer buffer
(set (make-local-variable 'vc-log-view-type) type))
(setq retval (funcall backend-func backend buffer-name type files))
- (with-current-buffer (get-buffer buffer-name)
+ (with-current-buffer buffer
(let ((inhibit-read-only t))
;; log-view-mode used to be called with inhibit-read-only bound
;; to t, so let's keep doing it, just in case.
@@ -2283,7 +2283,7 @@ earlier revisions. Show up to LIMIT entries (non-nil
means unlimited)."
rev-buff-func)))
;; Display after setting up major-mode, so display-buffer-alist can know
;; the major-mode.
- (pop-to-buffer buffer-name)
+ (pop-to-buffer buffer)
(vc-run-delayed
(let ((inhibit-read-only t))
(funcall setup-buttons-func backend files retval)
diff --git a/src/alloc.c b/src/alloc.c
index 350b668..1eab82d 100644
--- a/src/alloc.c
+++ b/src/alloc.c
@@ -3254,8 +3254,7 @@ sweep_vectors (void)
for (block = vector_blocks; block; block = *bprev)
{
- bool free_this_block = 0;
- ptrdiff_t nbytes;
+ bool free_this_block = false;
for (vector = (struct Lisp_Vector *) block->data;
VECTOR_IN_BLOCK (vector, block); vector = next)
@@ -3264,31 +3263,26 @@ sweep_vectors (void)
{
VECTOR_UNMARK (vector);
total_vectors++;
- nbytes = vector_nbytes (vector);
+ ptrdiff_t nbytes = vector_nbytes (vector);
total_vector_slots += nbytes / word_size;
next = ADVANCE (vector, nbytes);
}
else
{
- ptrdiff_t total_bytes;
-
- cleanup_vector (vector);
- nbytes = vector_nbytes (vector);
- total_bytes = nbytes;
- next = ADVANCE (vector, nbytes);
+ ptrdiff_t total_bytes = 0;
/* While NEXT is not marked, try to coalesce with VECTOR,
thus making VECTOR of the largest possible size. */
- while (VECTOR_IN_BLOCK (next, block))
+ next = vector;
+ do
{
- if (VECTOR_MARKED_P (next))
- break;
cleanup_vector (next);
- nbytes = vector_nbytes (next);
+ ptrdiff_t nbytes = vector_nbytes (next);
total_bytes += nbytes;
next = ADVANCE (next, nbytes);
}
+ while (VECTOR_IN_BLOCK (next, block) && !VECTOR_MARKED_P (next));
eassert (total_bytes % roundup_size == 0);
@@ -3296,7 +3290,7 @@ sweep_vectors (void)
&& !VECTOR_IN_BLOCK (next, block))
/* This block should be freed because all of its
space was coalesced into the only free vector. */
- free_this_block = 1;
+ free_this_block = true;
else
setup_on_free_list (vector, total_bytes);
}
diff --git a/src/bignum.c b/src/bignum.c
index 5dbfdb9..b18cecc 100644
--- a/src/bignum.c
+++ b/src/bignum.c
@@ -23,6 +23,8 @@ along with GNU Emacs. If not, see
<https://www.gnu.org/licenses/>. */
#include "lisp.h"
+#include <stdlib.h>
+
/* Return the value of the Lisp bignum N, as a double. */
double
bignum_to_double (Lisp_Object n)
@@ -223,18 +225,39 @@ bignum_to_uintmax (Lisp_Object x)
return v;
}
-/* Convert NUM to a base-BASE Lisp string. */
+/* Yield an upper bound on the buffer size needed to contain a C
+ string representing the bignum NUM in base BASE. This includes any
+ preceding '-' and the terminating null. */
+ptrdiff_t
+bignum_bufsize (Lisp_Object num, int base)
+{
+ return mpz_sizeinbase (XBIGNUM (num)->value, base) + 2;
+}
+
+/* Store into BUF (of size SIZE) the value of NUM as a base-BASE string.
+ If BASE is negative, use upper-case digits in base -BASE.
+ Return the string's length.
+ SIZE must equal bignum_bufsize (NUM, abs (BASE)). */
+ptrdiff_t
+bignum_to_c_string (char *buf, ptrdiff_t size, Lisp_Object num, int base)
+{
+ eassert (bignum_bufsize (num, abs (base)) == size);
+ mpz_get_str (buf, base, XBIGNUM (num)->value);
+ ptrdiff_t n = size - 2;
+ return !buf[n - 1] ? n - 1 : n + !!buf[n];
+}
+
+/* Convert NUM to a base-BASE Lisp string.
+ If BASE is negative, use upper-case digits in base -BASE. */
Lisp_Object
bignum_to_string (Lisp_Object num, int base)
{
- ptrdiff_t n = mpz_sizeinbase (XBIGNUM (num)->value, base) - 1;
+ ptrdiff_t size = bignum_bufsize (num, abs (base));
USE_SAFE_ALLOCA;
- char *str = SAFE_ALLOCA (n + 3);
- mpz_get_str (str, base, XBIGNUM (num)->value);
- while (str[n])
- n++;
- Lisp_Object result = make_unibyte_string (str, n);
+ char *str = SAFE_ALLOCA (size);
+ ptrdiff_t len = bignum_to_c_string (str, size, num, base);
+ Lisp_Object result = make_unibyte_string (str, len);
SAFE_FREE ();
return result;
}
diff --git a/src/editfns.c b/src/editfns.c
index b4c597f..3b1c21a 100644
--- a/src/editfns.c
+++ b/src/editfns.c
@@ -4232,8 +4232,26 @@ usage: (format-message STRING &rest OBJECTS) */)
static Lisp_Object
styled_format (ptrdiff_t nargs, Lisp_Object *args, bool message)
{
+ enum
+ {
+ /* Maximum precision for a %f conversion such that the trailing
+ output digit might be nonzero. Any precision larger than this
+ will not yield useful information. */
+ USEFUL_PRECISION_MAX = ((1 - LDBL_MIN_EXP)
+ * (FLT_RADIX == 2 || FLT_RADIX == 10 ? 1
+ : FLT_RADIX == 16 ? 4
+ : -1)),
+
+ /* Maximum number of bytes (including terminating null) generated
+ by any format, if precision is no more than USEFUL_PRECISION_MAX.
+ On all practical hosts, %Lf is the worst case. */
+ SPRINTF_BUFSIZE = (sizeof "-." + (LDBL_MAX_10_EXP + 1)
+ + USEFUL_PRECISION_MAX)
+ };
+ verify (USEFUL_PRECISION_MAX > 0);
+
ptrdiff_t n; /* The number of the next arg to substitute. */
- char initial_buffer[4000];
+ char initial_buffer[1000 + SPRINTF_BUFSIZE];
char *buf = initial_buffer;
ptrdiff_t bufsize = sizeof initial_buffer;
ptrdiff_t max_bufsize = STRING_BYTES_BOUND + 1;
@@ -4338,8 +4356,14 @@ styled_format (ptrdiff_t nargs, Lisp_Object *args, bool
message)
char const *convsrc = format;
unsigned char format_char = *format++;
- /* Bytes needed to represent the output of this conversion. */
+ /* Number of bytes to be preallocated for the next directive's
+ output. At the end of each iteration this is at least
+ CONVBYTES_ROOM, and is greater if the current directive
+ output was so large that it will be retried after buffer
+ reallocation. */
ptrdiff_t convbytes = 1;
+ enum { CONVBYTES_ROOM = SPRINTF_BUFSIZE - 1 };
+ eassert (p <= buf + bufsize - SPRINTF_BUFSIZE);
if (format_char == '%')
{
@@ -4473,23 +4497,6 @@ styled_format (ptrdiff_t nargs, Lisp_Object *args, bool
message)
conversion = 's';
zero_flag = false;
}
- else if ((conversion == 'd' || conversion == 'i'
- || conversion == 'o' || conversion == 'x'
- || conversion == 'X')
- && BIGNUMP (arg))
- {
- int base = 10;
-
- if (conversion == 'o')
- base = 8;
- else if (conversion == 'x')
- base = 16;
- else if (conversion == 'X')
- base = -16;
-
- arg = bignum_to_string (arg, base);
- conversion = 's';
- }
if (SYMBOLP (arg))
{
@@ -4592,7 +4599,7 @@ styled_format (ptrdiff_t nargs, Lisp_Object *args, bool
message)
spec->intervals = arg_intervals = true;
new_result = true;
- continue;
+ convbytes = CONVBYTES_ROOM;
}
}
else if (! (conversion == 'c' || conversion == 'd'
@@ -4606,28 +4613,8 @@ styled_format (ptrdiff_t nargs, Lisp_Object *args, bool
message)
error ("Format specifier doesn't match argument type");
else
{
- enum
- {
- /* Maximum precision for a %f conversion such that the
- trailing output digit might be nonzero. Any precision
- larger than this will not yield useful information. */
- USEFUL_PRECISION_MAX =
- ((1 - LDBL_MIN_EXP)
- * (FLT_RADIX == 2 || FLT_RADIX == 10 ? 1
- : FLT_RADIX == 16 ? 4
- : -1)),
-
- /* Maximum number of bytes generated by any format, if
- precision is no more than USEFUL_PRECISION_MAX.
- On all practical hosts, %f is the worst case. */
- SPRINTF_BUFSIZE =
- sizeof "-." + (LDBL_MAX_10_EXP + 1) + USEFUL_PRECISION_MAX,
-
- /* Length of pM (that is, of pMd without the
- trailing "d"). */
- pMlen = sizeof pMd - 2
- };
- verify (USEFUL_PRECISION_MAX > 0);
+ /* Length of pM (that is, of pMd without the trailing "d"). */
+ enum { pMlen = sizeof pMd - 2 };
/* Avoid undefined behavior in underlying sprintf. */
if (conversion == 'd' || conversion == 'i')
@@ -4660,18 +4647,24 @@ styled_format (ptrdiff_t nargs, Lisp_Object *args, bool
message)
if (precision_given)
prec = min (precision, USEFUL_PRECISION_MAX);
- /* Use sprintf to format this number into sprintf_buf. Omit
+ /* Characters to be inserted after spaces and before
+ leading zeros. This can occur with bignums, since
+ string_to_bignum does only leading '-'. */
+ char prefix[sizeof "-0x" - 1];
+ int prefixlen = 0;
+
+ /* Use sprintf or bignum_to_string to format this number. Omit
padding and excess precision, though, because sprintf limits
- output length to INT_MAX.
+ output length to INT_MAX and bignum_to_string doesn't
+ do padding or precision.
- There are four types of conversion: double, unsigned
+ Use five sprintf conversions: double, long double, unsigned
char (passed as int), wide signed int, and wide
unsigned int. Treat them separately because the
sprintf ABI is sensitive to which type is passed. Be
careful about integer overflow, NaNs, infinities, and
conversions; for example, the min and max macros are
not suitable here. */
- char sprintf_buf[SPRINTF_BUFSIZE];
ptrdiff_t sprintf_bytes;
if (float_conversion)
{
@@ -4729,26 +4722,43 @@ styled_format (ptrdiff_t nargs, Lisp_Object *args, bool
message)
f[-1] = 'L';
*f++ = conversion;
*f = '\0';
- sprintf_bytes = sprintf (sprintf_buf, convspec, prec,
- ldarg);
+ sprintf_bytes = sprintf (p, convspec, prec, ldarg);
}
else
- sprintf_bytes = sprintf (sprintf_buf, convspec, prec,
- darg);
+ sprintf_bytes = sprintf (p, convspec, prec, darg);
}
else if (conversion == 'c')
{
/* Don't use sprintf here, as it might mishandle prec. */
- sprintf_buf[0] = XFIXNUM (arg);
+ p[0] = XFIXNUM (arg);
+ p[1] = '\0';
sprintf_bytes = prec != 0;
- sprintf_buf[sprintf_bytes] = '\0';
+ }
+ else if (BIGNUMP (arg))
+ {
+ int base = ((conversion == 'd' || conversion == 'i') ? 10
+ : conversion == 'o' ? 8 : 16);
+ sprintf_bytes = bignum_bufsize (arg, base);
+ if (sprintf_bytes <= buf + bufsize - p)
+ {
+ int signedbase = conversion == 'X' ? -base : base;
+ sprintf_bytes = bignum_to_c_string (p, sprintf_bytes,
+ arg, signedbase);
+ bool negative = p[0] == '-';
+ prec = min (precision, sprintf_bytes - prefixlen);
+ prefix[prefixlen] = plus_flag ? '+' : ' ';
+ prefixlen += (plus_flag | space_flag) & !negative;
+ prefix[prefixlen] = '0';
+ prefix[prefixlen + 1] = conversion;
+ prefixlen += sharp_flag && base == 16 ? 2 : 0;
+ }
}
else if (conversion == 'd' || conversion == 'i')
{
if (FIXNUMP (arg))
{
printmax_t x = XFIXNUM (arg);
- sprintf_bytes = sprintf (sprintf_buf, convspec, prec, x);
+ sprintf_bytes = sprintf (p, convspec, prec, x);
}
else
{
@@ -4760,9 +4770,8 @@ styled_format (ptrdiff_t nargs, Lisp_Object *args, bool
message)
x = trunc (x);
x = x ? x : 0;
- sprintf_bytes = sprintf (sprintf_buf, convspec, 0, x);
- char c0 = sprintf_buf[0];
- bool signedp = ! ('0' <= c0 && c0 <= '9');
+ sprintf_bytes = sprintf (p, convspec, 0, x);
+ bool signedp = ! c_isdigit (p[0]);
prec = min (precision, sprintf_bytes - signedp);
}
}
@@ -4793,10 +4802,9 @@ styled_format (ptrdiff_t nargs, Lisp_Object *args, bool
message)
x = d;
negative = false;
}
- sprintf_buf[0] = negative ? '-' : plus_flag ? '+' : ' ';
+ p[0] = negative ? '-' : plus_flag ? '+' : ' ';
bool signedp = negative | plus_flag | space_flag;
- sprintf_bytes = sprintf (sprintf_buf + signedp,
- convspec, prec, x);
+ sprintf_bytes = sprintf (p + signedp, convspec, prec, x);
sprintf_bytes += signedp;
}
@@ -4804,112 +4812,126 @@ styled_format (ptrdiff_t nargs, Lisp_Object *args,
bool message)
padding and excess precision. Deal with excess precision
first. This happens when the format specifies ridiculously
large precision, or when %d or %i formats a float that would
- ordinarily need fewer digits than a specified precision. */
+ ordinarily need fewer digits than a specified precision,
+ or when a bignum is formatted using an integer format
+ with enough precision. */
ptrdiff_t excess_precision
= precision_given ? precision - prec : 0;
- ptrdiff_t leading_zeros = 0, trailing_zeros = 0;
- if (excess_precision)
+ ptrdiff_t trailing_zeros = 0;
+ if (excess_precision != 0 && float_conversion)
{
- if (float_conversion)
- {
- if ((conversion == 'g' && ! sharp_flag)
- || ! ('0' <= sprintf_buf[sprintf_bytes - 1]
- && sprintf_buf[sprintf_bytes - 1] <= '9'))
- excess_precision = 0;
- else
- {
- if (conversion == 'g')
- {
- char *dot = strchr (sprintf_buf, '.');
- if (!dot)
- excess_precision = 0;
- }
- }
- trailing_zeros = excess_precision;
- }
- else
- leading_zeros = excess_precision;
+ if (! c_isdigit (p[sprintf_bytes - 1])
+ || (conversion == 'g'
+ && ! (sharp_flag && strchr (p, '.'))))
+ excess_precision = 0;
+ trailing_zeros = excess_precision;
}
+ ptrdiff_t leading_zeros = excess_precision - trailing_zeros;
/* Compute the total bytes needed for this item, including
excess precision and padding. */
ptrdiff_t numwidth;
- if (INT_ADD_WRAPV (sprintf_bytes, excess_precision, &numwidth))
+ if (INT_ADD_WRAPV (prefixlen + sprintf_bytes, excess_precision,
+ &numwidth))
numwidth = PTRDIFF_MAX;
ptrdiff_t padding
= numwidth < field_width ? field_width - numwidth : 0;
- if (max_bufsize - sprintf_bytes <= excess_precision
+ if (max_bufsize - (prefixlen + sprintf_bytes) <= excess_precision
|| max_bufsize - padding <= numwidth)
string_overflow ();
convbytes = numwidth + padding;
if (convbytes <= buf + bufsize - p)
{
- /* Copy the formatted item from sprintf_buf into buf,
- inserting padding and excess-precision zeros. */
-
- char *src = sprintf_buf;
- char src0 = src[0];
- int exponent_bytes = 0;
- bool signedp = src0 == '-' || src0 == '+' || src0 == ' ';
- int prefix_bytes = (signedp
- + ((src[signedp] == '0'
- && (src[signedp + 1] == 'x'
- || src[signedp + 1] == 'X'))
- ? 2 : 0));
- if (zero_flag)
+ bool signedp = p[0] == '-' || p[0] == '+' || p[0] == ' ';
+ int beglen = (signedp
+ + ((p[signedp] == '0'
+ && (p[signedp + 1] == 'x'
+ || p[signedp + 1] == 'X'))
+ ? 2 : 0));
+ eassert (prefixlen == 0 || beglen == 0
+ || (beglen == 1 && p[0] == '-'
+ && ! (prefix[0] == '-' || prefix[0] == '+'
+ || prefix[0] == ' ')));
+ if (zero_flag && 0 <= char_hexdigit (p[beglen]))
{
- unsigned char after_prefix = src[prefix_bytes];
- if (0 <= char_hexdigit (after_prefix))
- {
- leading_zeros += padding;
- padding = 0;
- }
+ leading_zeros += padding;
+ padding = 0;
+ }
+ if (leading_zeros == 0 && sharp_flag && conversion == 'o'
+ && p[beglen] != '0')
+ {
+ leading_zeros++;
+ padding -= padding != 0;
}
- if (excess_precision
+ int endlen = 0;
+ if (trailing_zeros
&& (conversion == 'e' || conversion == 'g'))
{
- char *e = strchr (src, 'e');
+ char *e = strchr (p, 'e');
if (e)
- exponent_bytes = src + sprintf_bytes - e;
+ endlen = p + sprintf_bytes - e;
}
- spec->start = nchars;
- if (! minus_flag)
- {
- memset (p, ' ', padding);
- p += padding;
- nchars += padding;
- }
+ ptrdiff_t midlen = sprintf_bytes - beglen - endlen;
+ ptrdiff_t leading_padding = minus_flag ? 0 : padding;
+ ptrdiff_t trailing_padding = padding - leading_padding;
- memcpy (p, src, prefix_bytes);
- p += prefix_bytes;
- src += prefix_bytes;
- memset (p, '0', leading_zeros);
- p += leading_zeros;
- int significand_bytes
- = sprintf_bytes - prefix_bytes - exponent_bytes;
- memcpy (p, src, significand_bytes);
- p += significand_bytes;
- src += significand_bytes;
- memset (p, '0', trailing_zeros);
- p += trailing_zeros;
- memcpy (p, src, exponent_bytes);
- p += exponent_bytes;
-
- nchars += leading_zeros + sprintf_bytes + trailing_zeros;
+ /* Insert padding and excess-precision zeros. The output
+ contains the following components, in left-to-right order:
- if (minus_flag)
+ LEADING_PADDING spaces.
+ BEGLEN bytes taken from the start of sprintf output.
+ PREFIXLEN bytes taken from the start of the prefix array.
+ LEADING_ZEROS zeros.
+ MIDLEN bytes taken from the middle of sprintf output.
+ TRAILING_ZEROS zeros.
+ ENDLEN bytes taken from the end of sprintf output.
+ TRAILING_PADDING spaces.
+
+ The sprintf output is taken from the buffer starting at
+ P and continuing for SPRINTF_BYTES bytes. */
+
+ ptrdiff_t incr
+ = (padding + leading_zeros + prefixlen
+ + sprintf_bytes + trailing_zeros);
+
+ /* Optimize for the typical case with padding or zeros. */
+ if (incr != sprintf_bytes)
{
- memset (p, ' ', padding);
- p += padding;
- nchars += padding;
+ /* Move data to make room to insert spaces and '0's.
+ As this may entail overlapping moves, process
+ the output right-to-left and use memmove.
+ With any luck this code is rarely executed. */
+ char *src = p + sprintf_bytes;
+ char *dst = p + incr;
+ dst -= trailing_padding;
+ memset (dst, ' ', trailing_padding);
+ src -= endlen;
+ dst -= endlen;
+ memmove (dst, src, endlen);
+ dst -= trailing_zeros;
+ memset (dst, '0', trailing_zeros);
+ src -= midlen;
+ dst -= midlen;
+ memmove (dst, src, midlen);
+ dst -= leading_zeros;
+ memset (dst, '0', leading_zeros);
+ dst -= prefixlen;
+ memcpy (dst, prefix, prefixlen);
+ src -= beglen;
+ dst -= beglen;
+ memmove (dst, src, beglen);
+ dst -= leading_padding;
+ memset (dst, ' ', leading_padding);
}
- spec->end = nchars;
+ p += incr;
+ spec->start = nchars;
+ spec->end = nchars += incr;
new_result = true;
- continue;
+ convbytes = CONVBYTES_ROOM;
}
}
}
@@ -4962,42 +4984,51 @@ styled_format (ptrdiff_t nargs, Lisp_Object *args, bool
message)
}
copy_char:
- if (convbytes <= buf + bufsize - p)
- {
- memcpy (p, convsrc, convbytes);
- p += convbytes;
- nchars++;
- continue;
- }
+ memcpy (p, convsrc, convbytes);
+ p += convbytes;
+ nchars++;
+ convbytes = CONVBYTES_ROOM;
}
- /* There wasn't enough room to store this conversion or single
- character. CONVBYTES says how much room is needed. Allocate
- enough room (and then some) and do it again. */
-
ptrdiff_t used = p - buf;
- if (max_bufsize - used < convbytes)
+ ptrdiff_t buflen_needed;
+ if (INT_ADD_WRAPV (used, convbytes, &buflen_needed))
string_overflow ();
- bufsize = used + convbytes;
- bufsize = bufsize < max_bufsize / 2 ? bufsize * 2 : max_bufsize;
-
- if (buf == initial_buffer)
+ if (bufsize <= buflen_needed)
{
- buf = xmalloc (bufsize);
- buf_save_value_index = SPECPDL_INDEX ();
- record_unwind_protect_ptr (xfree, buf);
- memcpy (buf, initial_buffer, used);
- }
- else
- {
- buf = xrealloc (buf, bufsize);
- set_unwind_protect_ptr (buf_save_value_index, xfree, buf);
- }
+ if (max_bufsize <= buflen_needed)
+ string_overflow ();
- p = buf + used;
- format = format0;
- n = n0;
- ispec = ispec0;
+ /* Either there wasn't enough room to store this conversion,
+ or there won't be enough room to do a sprintf the next
+ time through the loop. Allocate enough room (and then some). */
+
+ bufsize = (buflen_needed <= max_bufsize / 2
+ ? buflen_needed * 2 : max_bufsize);
+
+ if (buf == initial_buffer)
+ {
+ buf = xmalloc (bufsize);
+ buf_save_value_index = SPECPDL_INDEX ();
+ record_unwind_protect_ptr (xfree, buf);
+ memcpy (buf, initial_buffer, used);
+ }
+ else
+ {
+ buf = xrealloc (buf, bufsize);
+ set_unwind_protect_ptr (buf_save_value_index, xfree, buf);
+ }
+
+ p = buf + used;
+ if (convbytes != CONVBYTES_ROOM)
+ {
+ /* There wasn't enough room for this conversion; do it over. */
+ eassert (CONVBYTES_ROOM < convbytes);
+ format = format0;
+ n = n0;
+ ispec = ispec0;
+ }
+ }
}
if (bufsize < p - buf)
diff --git a/src/emacs-module.c b/src/emacs-module.c
index cf92b0f..2ba5540 100644
--- a/src/emacs-module.c
+++ b/src/emacs-module.c
@@ -27,7 +27,6 @@ along with GNU Emacs. If not, see
<https://www.gnu.org/licenses/>. */
#include <stdio.h>
#include "lisp.h"
-#include "bignum.h"
#include "dynlib.h"
#include "coding.h"
#include "keyboard.h"
@@ -522,11 +521,10 @@ module_extract_integer (emacs_env *env, emacs_value n)
CHECK_INTEGER (l);
if (BIGNUMP (l))
{
- /* FIXME: This can incorrectly signal overflow on platforms
- where long is narrower than intmax_t. */
- if (!mpz_fits_slong_p (XBIGNUM (l)->value))
+ intmax_t i = bignum_to_intmax (l);
+ if (i == 0)
xsignal1 (Qoverflow_error, l);
- return mpz_get_si (XBIGNUM (l)->value);
+ return i;
}
return XFIXNUM (l);
}
diff --git a/src/eval.c b/src/eval.c
index 8745ba9..50de60c 100644
--- a/src/eval.c
+++ b/src/eval.c
@@ -787,7 +787,7 @@ usage: (defvar SYMBOL &optional INITVALUE DOCSTRING) */)
LOADHIST_ATTACH (sym);
}
else if (!NILP (Vinternal_interpreter_environment)
- && !XSYMBOL (sym)->u.s.declared_special)
+ && (SYMBOLP (sym) && !XSYMBOL (sym)->u.s.declared_special))
/* A simple (defvar foo) with lexical scoping does "nothing" except
declare that var to be dynamically scoped *locally* (i.e. within
the current file or let-block). */
diff --git a/src/font.c b/src/font.c
index 4a63700..e241458 100644
--- a/src/font.c
+++ b/src/font.c
@@ -1290,7 +1290,7 @@ font_unparse_xlfd (Lisp_Object font, int pixel_size, char
*name, int nbytes)
if (INTEGERP (val))
{
intmax_t v = FIXNUMP (val) ? XFIXNUM (val) : bignum_to_intmax (val);
- if (! (0 <= v && v <= TYPE_MAXIMUM (uprintmax_t)))
+ if (! (0 < v && v <= TYPE_MAXIMUM (uprintmax_t)))
v = pixel_size;
if (v > 0)
{
diff --git a/src/image.c b/src/image.c
index 69aeab5..24decbc 100644
--- a/src/image.c
+++ b/src/image.c
@@ -8824,7 +8824,8 @@ imagemagick_load_image (struct frame *f, struct image
*img,
#endif /* HAVE_MAGICKEXPORTIMAGEPIXELS */
{
size_t image_height;
- MagickRealType color_scale = 65535.0 / (MagickRealType) QuantumRange;
+ double quantum_range = QuantumRange;
+ MagickRealType color_scale = 65535.0 / quantum_range;
#ifdef USE_CAIRO
data = xmalloc (width * height * 4);
color_scale /= 256;
diff --git a/src/keyboard.c b/src/keyboard.c
index 7fafb41..008d3b9 100644
--- a/src/keyboard.c
+++ b/src/keyboard.c
@@ -2828,6 +2828,9 @@ read_char (int commandflag, Lisp_Object map,
#ifdef USE_FILE_NOTIFY
|| EQ (XCAR (c), Qfile_notify)
#endif
+#ifdef THREADS_ENABLED
+ || EQ (XCAR (c), Qthread_event)
+#endif
|| EQ (XCAR (c), Qconfig_changed_event))
&& !end_time)
/* We stopped being idle for this event; undo that. This
@@ -3739,7 +3742,7 @@ kbd_buffer_get_event (KBOARD **kbp,
}
#endif /* subprocesses */
-#if !defined HAVE_DBUS && !defined USE_FILE_NOTIFY
+#if !defined HAVE_DBUS && !defined USE_FILE_NOTIFY && !defined THREADS_ENABLED
if (noninteractive
/* In case we are running as a daemon, only do this before
detaching from the terminal. */
@@ -3750,7 +3753,7 @@ kbd_buffer_get_event (KBOARD **kbp,
*kbp = current_kboard;
return obj;
}
-#endif /* !defined HAVE_DBUS && !defined USE_FILE_NOTIFY */
+#endif /* !defined HAVE_DBUS && !defined USE_FILE_NOTIFY && !defined
THREADS_ENABLED */
/* Wait until there is input available. */
for (;;)
@@ -3900,6 +3903,9 @@ kbd_buffer_get_event (KBOARD **kbp,
#ifdef HAVE_DBUS
case DBUS_EVENT:
#endif
+#ifdef THREADS_ENABLED
+ case THREAD_EVENT:
+#endif
#ifdef HAVE_XWIDGETS
case XWIDGET_EVENT:
#endif
@@ -5983,6 +5989,13 @@ make_lispy_event (struct input_event *event)
}
#endif /* HAVE_DBUS */
+#ifdef THREADS_ENABLED
+ case THREAD_EVENT:
+ {
+ return Fcons (Qthread_event, event->arg);
+ }
+#endif /* THREADS_ENABLED */
+
#ifdef HAVE_XWIDGETS
case XWIDGET_EVENT:
{
@@ -11078,6 +11091,10 @@ syms_of_keyboard (void)
DEFSYM (Qdbus_event, "dbus-event");
#endif
+#ifdef THREADS_ENABLED
+ DEFSYM (Qthread_event, "thread-event");
+#endif
+
#ifdef HAVE_XWIDGETS
DEFSYM (Qxwidget_event, "xwidget-event");
#endif
@@ -11929,6 +11946,12 @@ keys_of_keyboard (void)
"dbus-handle-event");
#endif
+#ifdef THREADS_ENABLED
+ /* Define a special event which is raised for thread signals. */
+ initial_define_lispy_key (Vspecial_event_map, "thread-event",
+ "thread-handle-event");
+#endif
+
#ifdef USE_FILE_NOTIFY
/* Define a special event which is raised for notification callback
functions. */
diff --git a/src/keymap.c b/src/keymap.c
index bdd3af2..52db7b4 100644
--- a/src/keymap.c
+++ b/src/keymap.c
@@ -1186,7 +1186,7 @@ number or marker, in which case the keymap properties at
the specified
buffer position instead of point are used. The KEYMAPS argument is
ignored if POSITION is non-nil.
-If the optional argument KEYMAPS is non-nil, it should be a list of
+If the optional argument KEYMAPS is non-nil, it should be a keymap or list of
keymaps to search for command remapping. Otherwise, search for the
remapping in all currently active keymaps. */)
(Lisp_Object command, Lisp_Object position, Lisp_Object keymaps)
@@ -1199,8 +1199,7 @@ remapping in all currently active keymaps. */)
if (NILP (keymaps))
command = Fkey_binding (command_remapping_vector, Qnil, Qt, position);
else
- command = Flookup_key (Fcons (Qkeymap, keymaps),
- command_remapping_vector, Qnil);
+ command = Flookup_key (keymaps, command_remapping_vector, Qnil);
return FIXNUMP (command) ? Qnil : command;
}
@@ -1208,7 +1207,7 @@ remapping in all currently active keymaps. */)
/* GC is possible in this function. */
DEFUN ("lookup-key", Flookup_key, Slookup_key, 2, 3, 0,
- doc: /* In keymap KEYMAP, look up key sequence KEY. Return the
definition.
+ doc: /* Look up key sequence KEY in KEYMAP. Return the definition.
A value of nil means undefined. See doc of `define-key'
for kinds of definitions.
@@ -1217,6 +1216,7 @@ that is, characters or symbols in it except for the last
one
fail to be a valid sequence of prefix characters in KEYMAP.
The number is how many characters at the front of KEY
it takes to reach a non-prefix key.
+KEYMAP can also be a list of keymaps.
Normally, `lookup-key' ignores bindings for t, which act as default
bindings, used when nothing else in the keymap applies; this makes it
@@ -1231,7 +1231,8 @@ recognize the default bindings, just as
`read-key-sequence' does. */)
ptrdiff_t length;
bool t_ok = !NILP (accept_default);
- keymap = get_keymap (keymap, 1, 1);
+ if (!CONSP (keymap) && !NILP (keymap))
+ keymap = get_keymap (keymap, true, true);
length = CHECK_VECTOR_OR_STRING (key);
if (length == 0)
@@ -1664,7 +1665,7 @@ specified buffer position instead of point are used.
}
}
- value = Flookup_key (Fcons (Qkeymap, Fcurrent_active_maps (Qt, position)),
+ value = Flookup_key (Fcurrent_active_maps (Qt, position),
key, accept_default);
if (NILP (value) || FIXNUMP (value))
@@ -2359,39 +2360,24 @@ preferred_sequence_p (Lisp_Object seq)
static void where_is_internal_1 (Lisp_Object key, Lisp_Object binding,
Lisp_Object args, void *data);
-/* Like Flookup_key, but uses a list of keymaps SHADOW instead of a single map.
- Returns the first non-nil binding found in any of those maps.
- If REMAP is true, pass the result of the lookup through command
- remapping before returning it. */
+/* Like Flookup_key, but with command remapping; just returns nil
+ if the key sequence is too long. */
static Lisp_Object
-shadow_lookup (Lisp_Object shadow, Lisp_Object key, Lisp_Object flag,
+shadow_lookup (Lisp_Object keymap, Lisp_Object key, Lisp_Object accept_default,
bool remap)
{
- Lisp_Object tail, value;
+ Lisp_Object value = Flookup_key (keymap, key, accept_default);
- for (tail = shadow; CONSP (tail); tail = XCDR (tail))
+ if (FIXNATP (value)) /* `key' is too long! */
+ return Qnil;
+ else if (!NILP (value) && remap && SYMBOLP (value))
{
- value = Flookup_key (XCAR (tail), key, flag);
- if (FIXNATP (value))
- {
- value = Flookup_key (XCAR (tail),
- Fsubstring (key, make_fixnum (0), value), flag);
- if (!NILP (value))
- return Qnil;
- }
- else if (!NILP (value))
- {
- Lisp_Object remapping;
- if (remap && SYMBOLP (value)
- && (remapping = Fcommand_remapping (value, Qnil, shadow),
- !NILP (remapping)))
- return remapping;
- else
- return value;
- }
+ Lisp_Object remapping = Fcommand_remapping (value, Qnil, keymap);
+ return (!NILP (remapping) ? remapping : value);
}
- return Qnil;
+ else
+ return value;
}
static Lisp_Object Vmouse_events;
@@ -2565,7 +2551,7 @@ The optional 5th arg NO-REMAP alters how command
remapping is handled:
keymaps = Fcurrent_active_maps (Qnil, Qnil);
tem = Fcommand_remapping (definition, Qnil, keymaps);
- /* If `definition' is remapped to tem', then OT1H no key will run
+ /* If `definition' is remapped to `tem', then OT1H no key will run
that command (since they will run `tem' instead), so we should
return nil; but OTOH all keys bound to `definition' (or to `tem')
will run the same command.
@@ -2587,6 +2573,8 @@ The optional 5th arg NO-REMAP alters how command
remapping is handled:
&& !NILP (tem = Fget (definition, QCadvertised_binding)))
{
/* We have a list of advertised bindings. */
+ /* FIXME: Not sure why we use false for shadow_lookup's remapping,
+ nor why we use `EQ' here but `Fequal' in the call further down. */
while (CONSP (tem))
if (EQ (shadow_lookup (keymaps, XCAR (tem), Qnil, 0), definition))
return XCAR (tem);
@@ -2992,38 +2980,17 @@ key binding\n\
elt = XCAR (maps);
elt_prefix = Fcar (elt);
- sub_shadows = Qnil;
-
- for (tail = shadow; CONSP (tail); tail = XCDR (tail))
- {
- Lisp_Object shmap;
-
- shmap = XCAR (tail);
-
- /* If the sequence by which we reach this keymap is zero-length,
- then the shadow map for this keymap is just SHADOW. */
- if ((STRINGP (elt_prefix) && SCHARS (elt_prefix) == 0)
- || (VECTORP (elt_prefix) && ASIZE (elt_prefix) == 0))
- ;
- /* If the sequence by which we reach this keymap actually has
- some elements, then the sequence's definition in SHADOW is
- what we should use. */
- else
- {
- shmap = Flookup_key (shmap, Fcar (elt), Qt);
- if (FIXNUMP (shmap))
- shmap = Qnil;
- }
-
- /* If shmap is not nil and not a keymap,
+ sub_shadows = Flookup_key (shadow, elt_prefix, Qt);
+ if (FIXNATP (sub_shadows))
+ sub_shadows = Qnil;
+ else if (!KEYMAPP (sub_shadows)
+ && !NILP (sub_shadows)
+ && !(CONSP (sub_shadows)
+ && KEYMAPP (XCAR (sub_shadows))))
+ /* If elt_prefix is bound to something that's not a keymap,
it completely shadows this map, so don't
describe this map at all. */
- if (!NILP (shmap) && !KEYMAPP (shmap))
- goto skip;
-
- if (!NILP (shmap))
- sub_shadows = Fcons (shmap, sub_shadows);
- }
+ goto skip;
/* Maps we have already listed in this loop shadow this map. */
for (tail = orig_maps; !EQ (tail, maps); tail = XCDR (tail))
diff --git a/src/lisp.h b/src/lisp.h
index c5b51ba..36ca32c 100644
--- a/src/lisp.h
+++ b/src/lisp.h
@@ -3278,9 +3278,12 @@ set_sub_char_table_contents (Lisp_Object table,
ptrdiff_t idx, Lisp_Object val)
XSUB_CHAR_TABLE (table)->contents[idx] = val;
}
-/* Defined in bignum.c. */
+/* Defined in bignum.c. This part of bignum.c's API does not require
+ the caller to access bignum internals; see bignum.h for that. */
extern intmax_t bignum_to_intmax (Lisp_Object);
extern uintmax_t bignum_to_uintmax (Lisp_Object);
+extern ptrdiff_t bignum_bufsize (Lisp_Object, int);
+extern ptrdiff_t bignum_to_c_string (char *, ptrdiff_t, Lisp_Object, int);
extern Lisp_Object bignum_to_string (Lisp_Object, int);
extern Lisp_Object make_bignum_str (char const *, int);
extern Lisp_Object double_to_bignum (double);
diff --git a/src/print.c b/src/print.c
index 49d9e38..c0c90bc 100644
--- a/src/print.c
+++ b/src/print.c
@@ -23,7 +23,6 @@ along with GNU Emacs. If not, see
<https://www.gnu.org/licenses/>. */
#include "sysstdio.h"
#include "lisp.h"
-#include "bignum.h"
#include "character.h"
#include "coding.h"
#include "buffer.h"
@@ -1370,11 +1369,11 @@ print_vectorlike (Lisp_Object obj, Lisp_Object
printcharfun, bool escapeflag,
{
case PVEC_BIGNUM:
{
+ ptrdiff_t size = bignum_bufsize (obj, 10);
USE_SAFE_ALLOCA;
- char *str = SAFE_ALLOCA (mpz_sizeinbase (XBIGNUM (obj)->value, 10)
- + 2);
- mpz_get_str (str, 10, XBIGNUM (obj)->value);
- print_c_string (str, printcharfun);
+ char *str = SAFE_ALLOCA (size);
+ ptrdiff_t len = bignum_to_c_string (str, size, obj, 10);
+ strout (str, len, len, printcharfun);
SAFE_FREE ();
}
break;
diff --git a/src/termhooks.h b/src/termhooks.h
index 160bd2f..8b5f648 100644
--- a/src/termhooks.h
+++ b/src/termhooks.h
@@ -222,6 +222,10 @@ enum event_kind
, DBUS_EVENT
#endif
+#ifdef THREADS_ENABLED
+ , THREAD_EVENT
+#endif
+
, CONFIG_CHANGED_EVENT
#ifdef HAVE_NTGUI
diff --git a/src/thread.c b/src/thread.c
index 1c73d93..fc93344 100644
--- a/src/thread.c
+++ b/src/thread.c
@@ -25,6 +25,7 @@ along with GNU Emacs. If not, see
<https://www.gnu.org/licenses/>. */
#include "process.h"
#include "coding.h"
#include "syssignal.h"
+#include "keyboard.h"
static struct thread_state main_thread;
@@ -34,14 +35,13 @@ static struct thread_state *all_threads = &main_thread;
static sys_mutex_t global_lock;
-extern int poll_suppress_count;
extern volatile int interrupt_input_blocked;
/* m_specpdl is set when the thread is created and cleared when the
thread dies. */
-#define thread_alive_p(STATE) ((STATE)->m_specpdl != NULL)
+#define thread_live_p(STATE) ((STATE)->m_specpdl != NULL)
@@ -863,7 +863,8 @@ DEFUN ("thread-signal", Fthread_signal, Sthread_signal, 3,
3, 0,
This acts like `signal', but arranges for the signal to be raised
in THREAD. If THREAD is the current thread, acts just like `signal'.
This will interrupt a blocked call to `mutex-lock', `condition-wait',
-or `thread-join' in the target thread. */)
+or `thread-join' in the target thread.
+If THREAD is the main thread, just the error message is shown. */)
(Lisp_Object thread, Lisp_Object error_symbol, Lisp_Object data)
{
struct thread_state *tstate;
@@ -874,18 +875,36 @@ or `thread-join' in the target thread. */)
if (tstate == current_thread)
Fsignal (error_symbol, data);
- /* What to do if thread is already signaled? */
- /* What if error_symbol is Qnil? */
- tstate->error_symbol = error_symbol;
- tstate->error_data = data;
+#ifdef THREADS_ENABLED
+ if (main_thread_p (tstate))
+ {
+ /* Construct an event. */
+ struct input_event event;
+ EVENT_INIT (event);
+ event.kind = THREAD_EVENT;
+ event.frame_or_window = Qnil;
+ event.arg = list3 (Fcurrent_thread (), error_symbol, data);
+
+ /* Store it into the input event queue. */
+ kbd_buffer_store_event (&event);
+ }
- if (tstate->wait_condvar)
- flush_stack_call_func (thread_signal_callback, tstate);
+ else
+#endif
+ {
+ /* What to do if thread is already signaled? */
+ /* What if error_symbol is Qnil? */
+ tstate->error_symbol = error_symbol;
+ tstate->error_data = data;
+
+ if (tstate->wait_condvar)
+ flush_stack_call_func (thread_signal_callback, tstate);
+ }
return Qnil;
}
-DEFUN ("thread-alive-p", Fthread_alive_p, Sthread_alive_p, 1, 1, 0,
+DEFUN ("thread-live-p", Fthread_live_p, Sthread_live_p, 1, 1, 0,
doc: /* Return t if THREAD is alive, or nil if it has exited. */)
(Lisp_Object thread)
{
@@ -894,7 +913,7 @@ DEFUN ("thread-alive-p", Fthread_alive_p, Sthread_alive_p,
1, 1, 0,
CHECK_THREAD (thread);
tstate = XTHREAD (thread);
- return thread_alive_p (tstate) ? Qt : Qnil;
+ return thread_live_p (tstate) ? Qt : Qnil;
}
DEFUN ("thread--blocker", Fthread_blocker, Sthread_blocker, 1, 1, 0,
@@ -924,7 +943,7 @@ thread_join_callback (void *arg)
XSETTHREAD (thread, tstate);
self->event_object = thread;
self->wait_condvar = &tstate->thread_condvar;
- while (thread_alive_p (tstate) && NILP (self->error_symbol))
+ while (thread_live_p (tstate) && NILP (self->error_symbol))
sys_cond_wait (self->wait_condvar, &global_lock);
self->wait_condvar = NULL;
@@ -951,7 +970,7 @@ is an error for a thread to try to join itself. */)
error_symbol = tstate->error_symbol;
error_data = tstate->error_data;
- if (thread_alive_p (tstate))
+ if (thread_live_p (tstate))
flush_stack_call_func (thread_join_callback, tstate);
if (!NILP (error_symbol))
@@ -969,7 +988,7 @@ DEFUN ("all-threads", Fall_threads, Sall_threads, 0, 0, 0,
for (iter = all_threads; iter; iter = iter->next_thread)
{
- if (thread_alive_p (iter))
+ if (thread_live_p (iter))
{
Lisp_Object thread;
@@ -1074,7 +1093,7 @@ syms_of_threads (void)
defsubr (&Scurrent_thread);
defsubr (&Sthread_name);
defsubr (&Sthread_signal);
- defsubr (&Sthread_alive_p);
+ defsubr (&Sthread_live_p);
defsubr (&Sthread_join);
defsubr (&Sthread_blocker);
defsubr (&Sall_threads);
@@ -1092,6 +1111,9 @@ syms_of_threads (void)
staticpro (&last_thread_error);
last_thread_error = Qnil;
+ Fdefalias (intern_c_string ("thread-alive-p"),
+ intern_c_string ("thread-live-p"), Qnil);
+
Fprovide (intern_c_string ("threads"), Qnil);
}
diff --git a/src/xdisp.c b/src/xdisp.c
index 11b14e2..0403366 100644
--- a/src/xdisp.c
+++ b/src/xdisp.c
@@ -21185,8 +21185,12 @@ maybe_produce_line_number (struct it *it)
an L2R paragraph. */
tem_it.bidi_it.resolved_level = 2;
+ /* We must leave space for 2 glyphs for continuation and truncation,
+ and at least one glyph for buffer text. */
+ int width_limit =
+ tem_it.last_visible_x - tem_it.first_visible_x
+ - 3 * FRAME_COLUMN_WIDTH (it->f);
/* Produce glyphs for the line number in a scratch glyph_row. */
- int n_glyphs_before;
for (const char *p = lnum_buf; *p; p++)
{
/* For continuation lines and lines after ZV, instead of a line
@@ -21210,18 +21214,18 @@ maybe_produce_line_number (struct it *it)
else
tem_it.c = tem_it.char_to_display = *p;
tem_it.len = 1;
- n_glyphs_before = scratch_glyph_row.used[TEXT_AREA];
/* Make sure these glyphs will have a "position" of -1. */
SET_TEXT_POS (tem_it.position, -1, -1);
PRODUCE_GLYPHS (&tem_it);
- /* Stop producing glyphs if we don't have enough space on
- this line. FIXME: should we refrain from producing the
- line number at all in that case? */
- if (tem_it.current_x > tem_it.last_visible_x)
+ /* Stop producing glyphs, and refrain from producing the line
+ number, if we don't have enough space on this line. */
+ if (tem_it.current_x >= width_limit)
{
- scratch_glyph_row.used[TEXT_AREA] = n_glyphs_before;
- break;
+ it->lnum_width = 0;
+ it->lnum_pixel_width = 0;
+ bidi_unshelve_cache (itdata, false);
+ return;
}
}
diff --git a/test/lisp/calc/calc-tests.el b/test/lisp/calc/calc-tests.el
index fbd5f0e..101786c 100644
--- a/test/lisp/calc/calc-tests.el
+++ b/test/lisp/calc/calc-tests.el
@@ -86,6 +86,13 @@ An existing calc stack is reused, otherwise a new one is
created."
(math-read-expr "1m") "cm")
'(* -100 (var cm var-cm)))))
+(ert-deftest calc-imaginary-i ()
+ "Test `math-imaginary-i' for non-special-const values."
+ (let ((var-i (calcFunc-polar (calcFunc-sqrt -1))))
+ (should (math-imaginary-i)))
+ (let ((var-i (calcFunc-sqrt -1)))
+ (should (math-imaginary-i))))
+
(ert-deftest test-calc-23889 ()
"Test for https://debbugs.gnu.org/23889 and 25652."
(skip-unless (>= math-bignum-digit-length 9))
diff --git a/test/src/editfns-tests.el b/test/src/editfns-tests.el
index 964ff08..487f3aa 100644
--- a/test/src/editfns-tests.el
+++ b/test/src/editfns-tests.el
@@ -381,10 +381,23 @@
(let* ((s1 "FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF")
(v1 (read (concat "#x" s1)))
(s2 "99999999999999999999999999999999")
- (v2 (read s2)))
+ (v2 (read s2))
+ (v3 #x-3ffffffffffffffe000000000000000))
(should (> v1 most-positive-fixnum))
(should (equal (format "%X" v1) s1))
(should (> v2 most-positive-fixnum))
- (should (equal (format "%d" v2) s2))))
+ (should (equal (format "%d" v2) s2))
+ (should (equal (format "%d" v3) "-5316911983139663489309385231907684352"))
+ (should (equal (format "%+d" v3) "-5316911983139663489309385231907684352"))
+ (should (equal (format "%+d" (- v3))
+ "+5316911983139663489309385231907684352"))
+ (should (equal (format "% d" (- v3))
+ " 5316911983139663489309385231907684352"))
+ (should (equal (format "%o" v3)
+ "-37777777777777777777600000000000000000000"))
+ (should (equal (format "%#50.40x" v3)
+ " -0x000000003ffffffffffffffe000000000000000"))
+ (should (equal (format "%-#50.40x" v3)
+ "-0x000000003ffffffffffffffe000000000000000 "))))
;;; editfns-tests.el ends here
diff --git a/test/src/thread-tests.el b/test/src/thread-tests.el
index 364f6d6..109e711 100644
--- a/test/src/thread-tests.el
+++ b/test/src/thread-tests.el
@@ -19,6 +19,8 @@
;;; Code:
+(require 'thread)
+
;; Declare the functions in case Emacs has been configured --without-threads.
(declare-function all-threads "thread.c" ())
(declare-function condition-mutex "thread.c" (cond))
@@ -32,7 +34,7 @@
(declare-function mutex-lock "thread.c" (mutex))
(declare-function mutex-unlock "thread.c" (mutex))
(declare-function thread--blocker "thread.c" (thread))
-(declare-function thread-alive-p "thread.c" (thread))
+(declare-function thread-live-p "thread.c" (thread))
(declare-function thread-join "thread.c" (thread))
(declare-function thread-last-error "thread.c" (&optional cleanup))
(declare-function thread-name "thread.c" (thread))
@@ -61,11 +63,11 @@
(should
(string= "hi bob" (thread-name (make-thread #'ignore "hi bob")))))
-(ert-deftest threads-alive ()
+(ert-deftest threads-live ()
"Test for thread liveness."
(skip-unless (featurep 'threads))
(should
- (thread-alive-p (make-thread #'ignore))))
+ (thread-live-p (make-thread #'ignore))))
(ert-deftest threads-all-threads ()
"Simple test for all-threads."
@@ -102,7 +104,7 @@
(let ((thread (make-thread #'threads-test-thread1)))
(and (= (thread-join thread) 23)
(= threads-test-global 23)
- (not (thread-alive-p thread)))))))
+ (not (thread-live-p thread)))))))
(ert-deftest threads-join-self ()
"Cannot `thread-join' the current thread."
@@ -114,7 +116,7 @@
:tags '(:unstable)
(skip-unless (featurep 'threads))
(let ((thread (make-thread #'threads-call-error)))
- (while (thread-alive-p thread)
+ (while (thread-live-p thread)
(thread-yield))
(should-error (thread-join thread))))
@@ -288,7 +290,7 @@
(let (th1 th2)
(setq th1 (make-thread #'threads-call-error "call-error"))
(should (threadp th1))
- (while (thread-alive-p th1)
+ (while (thread-live-p th1)
(thread-yield))
(should (equal (thread-last-error)
'(error "Error is called")))
@@ -317,9 +319,28 @@
(while t (thread-yield))))))
(thread-signal thread 'error nil)
(sit-for 1)
- (should-not (thread-alive-p thread))
+ (should-not (thread-live-p thread))
(should (equal (thread-last-error) '(error)))))
+(ert-deftest threads-signal-main-thread ()
+ "Test signaling the main thread."
+ (skip-unless (featurep 'threads))
+ ;; We cannot use `ert-with-message-capture', because threads do not
+ ;; know let-bound variables.
+ (with-current-buffer "*Messages*"
+ (let (buffer-read-only)
+ (erase-buffer))
+ (let ((thread
+ (make-thread #'(lambda () (thread-signal main-thread 'error nil)))))
+ (while (thread-live-p thread)
+ (thread-yield))
+ (read-event nil nil 0.1)
+ ;; No error has been raised, which is part of the test.
+ (should
+ (string-match
+ (format-message "Error %s: (error nil)" thread)
+ (buffer-string ))))))
+
(defvar threads-condvar nil)
(defun threads-test-condvar-wait ()
@@ -343,7 +364,7 @@
(setq new-thread (make-thread #'threads-test-condvar-wait))
;; Make sure new-thread is alive.
- (should (thread-alive-p new-thread))
+ (should (thread-live-p new-thread))
(should (= (length (all-threads)) 2))
;; Wait for new-thread to become blocked on the condvar.
(while (not (eq (thread--blocker new-thread) threads-condvar))
@@ -356,7 +377,7 @@
(sleep-for 0.1)
;; Make sure the thread is still there. This used to fail due to
;; a bug in thread.c:condition_wait_callback.
- (should (thread-alive-p new-thread))
+ (should (thread-live-p new-thread))
(should (= (length (all-threads)) 2))
(should (eq (thread--blocker new-thread) threads-condvar))