Merge remote-tracking branch 'savannah/master' into native-comp

This commit is contained in:
Andrea Corallo 2021-03-12 16:42:51 +01:00
commit 82bd6d57d5
247 changed files with 3751 additions and 3019 deletions

View file

@ -62,7 +62,8 @@ See also `benchmark-run-compiled'."
;; Take account of the loop overhead.
`(- (benchmark-elapse (dotimes (,i ,repetitions)
,@forms))
(benchmark-elapse (dotimes (,i ,repetitions))))
(benchmark-elapse (dotimes (,i ,repetitions)
nil)))
`(benchmark-elapse ,@forms))
(- gcs-done ,gcs)
(- gc-elapsed ,gc)))))

View file

@ -1327,6 +1327,8 @@ Same format as `byte-optimize--lexvars', with shared structure and contents.")
radians-to-degrees rassq rassoc read-from-string regexp-opt
regexp-quote region-beginning region-end reverse round
sin sqrt string string< string= string-equal string-lessp
string> string-greaterp string-empty-p
string-prefix-p string-suffix-p string-blank-p
string-search string-to-char
string-to-number string-to-syntax substring
sxhash sxhash-equal sxhash-eq sxhash-eql

View file

@ -2575,12 +2575,14 @@ list that represents a doc string reference.
(put 'defvar 'byte-hunk-handler 'byte-compile-file-form-defvar)
(put 'defconst 'byte-hunk-handler 'byte-compile-file-form-defvar)
(defun byte-compile--declare-var (sym)
(defun byte-compile--check-prefixed-var (sym)
(when (and (symbolp sym)
(not (string-match "[-*/:$]" (symbol-name sym)))
(byte-compile-warning-enabled-p 'lexical sym))
(byte-compile-warn "global/dynamic var `%s' lacks a prefix"
sym))
(byte-compile-warn "global/dynamic var `%s' lacks a prefix" sym)))
(defun byte-compile--declare-var (sym)
(byte-compile--check-prefixed-var sym)
(when (memq sym byte-compile-lexical-variables)
(setq byte-compile-lexical-variables
(delq sym byte-compile-lexical-variables))
@ -4278,9 +4280,15 @@ that suppresses all warnings during execution of BODY."
byte-compile-unresolved-functions))
(bound-list (byte-compile-find-bound-condition
,condition '(boundp default-boundp local-variable-p)))
(new-bound-list
;; (seq-difference byte-compile-bound-variables))
(delq nil (mapcar (lambda (s)
(if (memq s byte-compile-bound-variables) nil s))
bound-list)))
;; Maybe add to the bound list.
(byte-compile-bound-variables
(append bound-list byte-compile-bound-variables)))
(append new-bound-list byte-compile-bound-variables)))
(mapc #'byte-compile--check-prefixed-var new-bound-list)
(unwind-protect
;; If things not being bound at all is ok, so must them being
;; obsolete. Note that we add to the existing lists since Tramp

View file

@ -295,8 +295,9 @@ of converted forms."
(if wrappers
(let ((special-forms '()))
;; Keep special forms at the beginning of the body.
(while (or (stringp (car funcbody)) ;docstring.
(memq (car-safe (car funcbody)) '(interactive declare)))
(while (or (and (cdr funcbody) (stringp (car funcbody))) ;docstring.
(memq (car-safe (car funcbody))
'(interactive declare :documentation)))
(push (pop funcbody) special-forms))
(let ((body (macroexp-progn funcbody)))
(dolist (wrapper wrappers) (setq body (funcall wrapper body)))
@ -584,9 +585,6 @@ places where they originally did not directly appear."
(_ (or (cdr (assq form env)) form))))
(unless (fboundp 'byte-compile-not-lexical-var-p)
;; Only used to test the code in non-lexbind Emacs.
(defalias 'byte-compile-not-lexical-var-p 'boundp))
(defvar byte-compile-lexical-variables)
(defun cconv--analyze-use (vardata form varkind)
@ -602,7 +600,14 @@ FORM is the parent form that binds this var."
;; FIXME: Convert this warning to use `macroexp--warn-wrap'
;; so as to give better position information.
(byte-compile-warn
"%s `%S' not left unused" varkind var)))
"%s `%S' not left unused" varkind var))
((and (let (or 'let* 'let) (car form))
`((,var) ;; (or `(,var nil) : Too many false positives: bug#47080
t nil ,_ ,_))
;; FIXME: Convert this warning to use `macroexp--warn-wrap'
;; so as to give better position information.
(unless (not (intern-soft var))
(byte-compile-warn "Variable `%S' left uninitialized" var))))
(pcase vardata
(`(,binder nil ,_ ,_ nil)
(push (cons (cons binder form) :unused) cconv-var-classification))
@ -783,7 +788,7 @@ This function does not return anything but instead fills the
(let ((dv (assq form env))) ; dv = declared and visible
(when dv
(setf (nth 1 dv) t))))))
(define-obsolete-function-alias 'cconv-analyse-form 'cconv-analyze-form "25.1")
(define-obsolete-function-alias 'cconv-analyse-form #'cconv-analyze-form "25.1")
(provide 'cconv)
;;; cconv.el ends here

View file

@ -931,35 +931,20 @@ don't move point."
;; Don't bug out if the file is empty (or a
;; definition ends prematurely.
(end-of-file)))
(`(,(or 'defun 'defvar 'defcustom 'defmacro 'defconst 'defsubst 'defadvice
'cl-defun 'cl-defgeneric 'cl-defmacro)
(`(,(and (pred symbolp) def
(let (and doc (guard doc)) (function-get def 'doc-string-elt)))
,(pred symbolp)
;; Require an initializer, i.e. ignore single-argument `defvar'
;; forms, which never have a doc string.
,_ . ,_)
(down-list)
;; Skip over function or macro name, symbol to be defined, and
;; initializer or argument list.
(forward-sexp 3)
(skip-chars-forward " \n\t")
t)
(`(,'cl-defmethod
,(pred symbolp)
. ,rest)
(down-list)
(forward-sexp (pcase (car rest)
;; No qualifier, so skip like we would have skipped in
;; the first clause of the outer `pcase'.
((pred listp) 3)
(':extra
;; Skip the :extra qualifier together with its string too.
;; Skip any additional qualifier.
(if (memq (nth 2 rest) '(:around :before :after))
6
5))
;; Skip :before, :after or :around qualifier too.
((or ':around ':before ':after)
4)))
;; Skip over function or macro name.
(forward-sexp 1)
;; And now skip until the docstring.
(forward-sexp (1- ; We already skipped the function or macro name.
(cond
((numberp doc) doc)
((functionp doc) (funcall doc)))))
(skip-chars-forward " \n\t")
t)))
@ -2149,8 +2134,8 @@ buffer, otherwise stop after the first error."
(user-error "No spellchecker installed: check the variable `ispell-program-name'"))
(save-excursion
(skip-chars-forward "^a-zA-Z")
(let (word sym case-fold-search err word-beginning word-end)
(while (and (not err) (< (point) end))
(let (word sym case-fold-search word-beginning word-end) ;; err
(while (and (< (point) end)) ;; (not err)
(if (save-excursion (forward-char -1) (looking-at "[('`]"))
;; Skip lists describing meta-syntax, or bound variables
(forward-sexp 1)
@ -2182,7 +2167,7 @@ buffer, otherwise stop after the first error."
(sit-for 0)
(message "Continuing..."))))))))
(skip-chars-forward "^a-zA-Z"))
err))))
nil)))) ;; err
;;; Rogue space checking engine
;;

View file

@ -321,7 +321,7 @@ the debugger will not be entered."
(make-obsolete 'debugger-insert-backtrace
"use a `backtrace-mode' buffer or `backtrace-to-string'."
"Emacs 27.1")
"27.1")
(defun debugger-insert-backtrace (frames do-xrefs)
"Format and insert the backtrace FRAMES at point.

View file

@ -332,12 +332,20 @@ or call the function `%s'."))))
t)))
;; Keep minor modes list up to date.
,@(if globalp
`((setq global-minor-modes (delq ',modefun global-minor-modes))
;; When running this byte-compiled code in earlier
;; Emacs versions, these variables may not be defined
;; there. So check defensively, even if they're
;; always defined in Emacs 28 and up.
`((when (boundp 'global-minor-modes)
(setq global-minor-modes
(delq ',modefun global-minor-modes))
(when ,getter
(push ',modefun global-minor-modes))))
;; Ditto check.
`((when (boundp 'local-minor-modes)
(setq local-minor-modes (delq ',modefun local-minor-modes))
(when ,getter
(push ',modefun global-minor-modes)))
`((setq local-minor-modes (delq ',modefun local-minor-modes))
(when ,getter
(push ',modefun local-minor-modes))))
(push ',modefun local-minor-modes)))))
,@body
;; The on/off hooks are here for backward compatibility only.
(run-hooks ',hook (if ,getter ',hook-on ',hook-off))

View file

@ -3508,7 +3508,7 @@ canceled the first time the function is entered."
(defun edebug-cancel-on-entry (function)
"Cause Edebug to not stop when FUNCTION is called.
The removes the effect of `edebug-on-entry'. If FUNCTION is is
The removes the effect of `edebug-on-entry'. If FUNCTION is
nil, remove `edebug-on-entry' on all functions."
(interactive
(list (let ((name (completing-read

View file

@ -261,7 +261,7 @@ DATA is displayed to the user and should state the reason for skipping."
It should only be stopped when ran from inside ert--run-test-internal."
(when (and (not (symbolp debugger)) ; only run on anonymous debugger
(memq error-symbol '(ert-test-failed ert-test-skipped)))
(funcall debugger 'error (list error-symbol data))))
(funcall debugger 'error (cons error-symbol data))))
(defun ert--special-operator-p (thing)
"Return non-nil if THING is a symbol naming a special operator."
@ -1633,7 +1633,7 @@ default (if any)."
(defun ert-find-test-other-window (test-name)
"Find, in another window, the definition of TEST-NAME."
(interactive (list (ert-read-test-name-at-point "Find test definition: ")))
(interactive (list (ert-read-test-name-at-point "Find test definition")))
(find-function-do-it test-name 'ert--test 'switch-to-buffer-other-window))
(defun ert-delete-test (test-name)
@ -2083,6 +2083,7 @@ and how to display message."
(define-derived-mode ert-results-mode special-mode "ERT-Results"
"Major mode for viewing results of ERT test runs."
:interactive nil
(setq-local revert-buffer-function
(lambda (&rest _) (ert-results-rerun-all-tests))))
@ -2178,7 +2179,7 @@ To be used in the ERT results buffer."
"Move point to the next test.
To be used in the ERT results buffer."
(interactive)
(interactive nil ert-results-mode)
(ert--results-move (ewoc-locate ert--results-ewoc) 'ewoc-next
"No tests below"))
@ -2186,7 +2187,7 @@ To be used in the ERT results buffer."
"Move point to the previous test.
To be used in the ERT results buffer."
(interactive)
(interactive nil ert-results-mode)
(ert--results-move (ewoc-locate ert--results-ewoc) 'ewoc-prev
"No tests above"))
@ -2219,7 +2220,7 @@ user-error is signaled with the message ERROR-MESSAGE."
"Find the definition of the test at point in another window.
To be used in the ERT results buffer."
(interactive)
(interactive nil ert-results-mode)
(let ((name (ert-test-at-point)))
(unless name
(user-error "No test at point"))
@ -2253,7 +2254,7 @@ To be used in the ERT results buffer."
;; the summary apparently needs to be easily accessible from the
;; error log, and perhaps it would be better to have it in a
;; separate buffer to keep it visible.
(interactive)
(interactive nil ert-results-mode)
(let ((ewoc ert--results-ewoc)
(progress-bar-begin ert--results-progress-bar-button-begin))
(cond ((ert--results-test-node-or-null-at-point)
@ -2370,7 +2371,7 @@ definition."
"Re-run all tests, using the same selector.
To be used in the ERT results buffer."
(interactive)
(interactive nil ert-results-mode)
(cl-assert (eql major-mode 'ert-results-mode))
(let ((selector (ert--stats-selector ert--results-stats)))
(ert-run-tests-interactively selector (buffer-name))))
@ -2379,7 +2380,7 @@ To be used in the ERT results buffer."
"Re-run the test at point.
To be used in the ERT results buffer."
(interactive)
(interactive nil ert-results-mode)
(cl-destructuring-bind (test redefinition-state)
(ert--results-test-at-point-allow-redefinition)
(when (null test)
@ -2414,7 +2415,7 @@ To be used in the ERT results buffer."
"Re-run the test at point with `ert-debug-on-error' bound to t.
To be used in the ERT results buffer."
(interactive)
(interactive nil ert-results-mode)
(let ((ert-debug-on-error t))
(ert-results-rerun-test-at-point)))
@ -2422,7 +2423,7 @@ To be used in the ERT results buffer."
"Display the backtrace for the test at point.
To be used in the ERT results buffer."
(interactive)
(interactive nil ert-results-mode)
(let* ((test (ert--results-test-at-point-no-redefinition t))
(stats ert--results-stats)
(pos (ert--stats-test-pos stats test))
@ -2449,7 +2450,7 @@ To be used in the ERT results buffer."
"Display the part of the *Messages* buffer generated during the test at point.
To be used in the ERT results buffer."
(interactive)
(interactive nil ert-results-mode)
(let* ((test (ert--results-test-at-point-no-redefinition t))
(stats ert--results-stats)
(pos (ert--stats-test-pos stats test))
@ -2470,7 +2471,7 @@ To be used in the ERT results buffer."
"Display the list of `should' forms executed during the test at point.
To be used in the ERT results buffer."
(interactive)
(interactive nil ert-results-mode)
(let* ((test (ert--results-test-at-point-no-redefinition t))
(stats ert--results-stats)
(pos (ert--stats-test-pos stats test))
@ -2506,7 +2507,7 @@ To be used in the ERT results buffer."
"Toggle how much of the condition to print for the test at point.
To be used in the ERT results buffer."
(interactive)
(interactive nil ert-results-mode)
(let* ((ewoc ert--results-ewoc)
(node (ert--results-test-node-at-point))
(entry (ewoc-data node)))
@ -2518,7 +2519,7 @@ To be used in the ERT results buffer."
"Display test timings for the last run.
To be used in the ERT results buffer."
(interactive)
(interactive nil ert-results-mode)
(let* ((stats ert--results-stats)
(buffer (get-buffer-create "*ERT timings*"))
(data (cl-loop for test across (ert--stats-tests stats)
@ -2597,7 +2598,7 @@ To be used in the ERT results buffer."
"Display the documentation of the test at point.
To be used in the ERT results buffer."
(interactive)
(interactive nil ert-results-mode)
(ert-describe-test (ert--results-test-at-point-no-redefinition t)))

View file

@ -290,12 +290,13 @@ all RULES in total."
',(string-to-syntax (nth 1 action)))
,@(nthcdr 2 action))
`((let ((mb (match-beginning ,gn))
(me (match-end ,gn))
(syntax ,(nth 1 action)))
(if syntax
(put-text-property
mb me 'syntax-table syntax))
,@(nthcdr 2 action)))))
(me (match-end ,gn)))
,(macroexp-let2 nil syntax (nth 1 action)
`(progn
(if ,syntax
(put-text-property
mb me 'syntax-table ,syntax))
,@(nthcdr 2 action)))))))
(t
`((let ((mb (match-beginning ,gn))
(me (match-end ,gn))

View file

@ -32,8 +32,8 @@
;;;Here are some macros that exercise SES. Set `pause' to t if you want the
;;;macros to pause after each step.
(let* ((pause nil)
(x (if pause "\^Xq" ""))
(let* (;; (pause nil)
(x (if nil "\^Xq" "")) ;; pause
(y "\^X\^Fses-test.ses\r\^[<"))
;;Fiddle with the existing spreadsheet
(fset 'ses-exercise-example