From b6a57fb80c49bcd9163966d612671a5256f3a1a8 Mon Sep 17 00:00:00 2001 From: Glenn Morris Date: Tue, 18 Apr 2017 20:52:22 -0400 Subject: Tweak bytecomp's loading of cl-extra * lisp/emacs-lisp/bytecomp.el: Don't force load of cl-extra in a post-bootstrap emacs where cl-loaddefs does exist. --- lisp/emacs-lisp/bytecomp.el | 6 ++++-- 1 file changed, 4 insertions(+), 2 deletions(-) (limited to 'lisp/emacs-lisp/bytecomp.el') diff --git a/lisp/emacs-lisp/bytecomp.el b/lisp/emacs-lisp/bytecomp.el index 2c2996ebab4..f0f938da43f 100644 --- a/lisp/emacs-lisp/bytecomp.el +++ b/lisp/emacs-lisp/bytecomp.el @@ -124,11 +124,13 @@ (require 'backquote) (require 'macroexp) (require 'cconv) +(require 'cl-lib) ;; During bootstrap, cl-loaddefs.el is not created yet, so loading cl-lib ;; doesn't setup autoloads for things like cl-every, which is why we have to -;; require cl-extra instead (bug#18804). -(require 'cl-extra) +;; require cl-extra as well (bug#18804). +(or (fboundp 'cl-every) + (require 'cl-extra)) (or (fboundp 'defsubst) ;; This really ought to be loaded already! -- cgit v1.2.3 From b389379c87481b6bc647ceb4d323f861281cad72 Mon Sep 17 00:00:00 2001 From: Vibhav Pant Date: Thu, 20 Apr 2017 20:59:15 +0530 Subject: bytecomp: Don't inline functions that use byte-switch (Bug#26518) * lisp/emacs-lisp/bytecomp.el (byte-compile-unfold-bcf): Don't inline FORM if the bytecode uses the byte-switch instruction. It is impossible to guess the correct stack depth while inlining such bytecode, resulting in faulty code. --- lisp/emacs-lisp/bytecomp.el | 86 ++++++++++++++++++++++++--------------------- 1 file changed, 46 insertions(+), 40 deletions(-) (limited to 'lisp/emacs-lisp/bytecomp.el') diff --git a/lisp/emacs-lisp/bytecomp.el b/lisp/emacs-lisp/bytecomp.el index f0f938da43f..aba07102055 100644 --- a/lisp/emacs-lisp/bytecomp.el +++ b/lisp/emacs-lisp/bytecomp.el @@ -3204,47 +3204,53 @@ for symbols generated by the byte compiler itself." (fmax2 (if (numberp fargs) (lsh fargs -7))) ;2*max+rest. ;; (fmin (if (numberp fargs) (logand fargs 127))) (alen (length (cdr form))) - (dynbinds ())) + (dynbinds ()) + lap) (fetch-bytecode fun) - (mapc 'byte-compile-form (cdr form)) - (unless fmax2 - ;; Old-style byte-code. - (cl-assert (listp fargs)) - (while fargs - (pcase (car fargs) - (`&optional (setq fargs (cdr fargs))) - (`&rest (setq fmax2 (+ (* 2 (length dynbinds)) 1)) - (push (cadr fargs) dynbinds) - (setq fargs nil)) - (_ (push (pop fargs) dynbinds)))) - (unless fmax2 (setq fmax2 (* 2 (length dynbinds))))) - (cond - ((<= (+ alen alen) fmax2) - ;; Add missing &optional (or &rest) arguments. - (dotimes (_ (- (/ (1+ fmax2) 2) alen)) - (byte-compile-push-constant nil))) - ((zerop (logand fmax2 1)) - (byte-compile-report-error - (format "Too many arguments for inlined function %S" form)) - (byte-compile-discard (- alen (/ fmax2 2)))) - (t - ;; Turn &rest args into a list. - (let ((n (- alen (/ (1- fmax2) 2)))) - (cl-assert (> n 0) nil "problem: fmax2=%S alen=%S n=%S" fmax2 alen n) - (if (< n 5) - (byte-compile-out - (aref [byte-list1 byte-list2 byte-list3 byte-list4] (1- n)) - 0) - (byte-compile-out 'byte-listN n))))) - (mapc #'byte-compile-dynamic-variable-bind dynbinds) - (byte-compile-inline-lapcode - (byte-decompile-bytecode-1 (aref fun 1) (aref fun 2) t) - (1+ start-depth)) - ;; Unbind dynamic variables. - (when dynbinds - (byte-compile-out 'byte-unbind (length dynbinds))) - (cl-assert (eq byte-compile-depth (1+ start-depth)) - nil "Wrong depth start=%s end=%s" start-depth byte-compile-depth))) + (setq lap (byte-decompile-bytecode-1 (aref fun 1) (aref fun 2) t)) + ;; optimized switch bytecode makes it impossible to guess the correct + ;; `byte-compile-depth', which can result in incorrect inlined code. + ;; therefore, we do not inline code that uses the `byte-switch' + ;; instruction. + (if (assq 'byte-switch lap) + (byte-compile-normal-call form) + (mapc 'byte-compile-form (cdr form)) + (unless fmax2 + ;; Old-style byte-code. + (cl-assert (listp fargs)) + (while fargs + (pcase (car fargs) + (`&optional (setq fargs (cdr fargs))) + (`&rest (setq fmax2 (+ (* 2 (length dynbinds)) 1)) + (push (cadr fargs) dynbinds) + (setq fargs nil)) + (_ (push (pop fargs) dynbinds)))) + (unless fmax2 (setq fmax2 (* 2 (length dynbinds))))) + (cond + ((<= (+ alen alen) fmax2) + ;; Add missing &optional (or &rest) arguments. + (dotimes (_ (- (/ (1+ fmax2) 2) alen)) + (byte-compile-push-constant nil))) + ((zerop (logand fmax2 1)) + (byte-compile-report-error + (format "Too many arguments for inlined function %S" form)) + (byte-compile-discard (- alen (/ fmax2 2)))) + (t + ;; Turn &rest args into a list. + (let ((n (- alen (/ (1- fmax2) 2)))) + (cl-assert (> n 0) nil "problem: fmax2=%S alen=%S n=%S" fmax2 alen n) + (if (< n 5) + (byte-compile-out + (aref [byte-list1 byte-list2 byte-list3 byte-list4] (1- n)) + 0) + (byte-compile-out 'byte-listN n))))) + (mapc #'byte-compile-dynamic-variable-bind dynbinds) + (byte-compile-inline-lapcode lap (1+ start-depth)) + ;; Unbind dynamic variables. + (when dynbinds + (byte-compile-out 'byte-unbind (length dynbinds))) + (cl-assert (eq byte-compile-depth (1+ start-depth)) + nil "Wrong depth start=%s end=%s" start-depth byte-compile-depth)))) (defun byte-compile-check-variable (var access-type) "Do various error checks before a use of the variable VAR." -- cgit v1.2.3 From 1c91bc9221d12618c9fb5507561dd35b7e392cb6 Mon Sep 17 00:00:00 2001 From: Vibhav Pant Date: Sat, 22 Apr 2017 20:38:53 +0530 Subject: b-c--cond-jump-table-info: Use correct body for singleton clauses * lisp/emacs-lisp/bytecomp.el (byte-compile-cond-jump-table-info): When a clause's body consists of a single constant expression, use that expression as the body to be compiled. This fixes switch bytecode evaluating to nil to such clauses. --- lisp/emacs-lisp/bytecomp.el | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) (limited to 'lisp/emacs-lisp/bytecomp.el') diff --git a/lisp/emacs-lisp/bytecomp.el b/lisp/emacs-lisp/bytecomp.el index aba07102055..15dc24060aa 100644 --- a/lisp/emacs-lisp/bytecomp.el +++ b/lisp/emacs-lisp/bytecomp.el @@ -4066,8 +4066,8 @@ Return a list of the form ((TEST . VAR) ((VALUE BODY) ...))" ;; discard duplicate clauses (not (assq obj2 cases))) (push (list (if (consp obj2) (eval obj2) obj2) body) cases) - (if (eq condition t) - (progn (push (list 'default body) cases) + (if (and (macroexp-const-p condition) condition) + (progn (push (list 'default (or body `(,condition))) cases) (throw 'break t)) (setq ok nil) (throw 'break nil)))))) -- cgit v1.2.3 From c2bbdc3316487e34eba1470dd059c0c290431e00 Mon Sep 17 00:00:00 2001 From: Philipp Stephani Date: Tue, 30 Jun 2015 22:38:35 +0200 Subject: Warn about missing backslashes during load * src/lread.c (load_warn_unescaped_character_literals, Fload, read1) (syms_of_lread): Warn if unescaped character literals are found (Bug#20152). * lisp/emacs-lisp/bytecomp.el (byte-compile-from-buffer): Check for unescaped character literals during byte compilation. * test/src/lread-tests.el (lread-tests--unescaped-char-literals): New unit test. (lread-tests--with-temp-file, lread-tests--last-message): Helper functions for unit test. * test/lisp/emacs-lisp/bytecomp-tests.el (bytecomp-tests--unescaped-char-literals): New unit test. * test/lisp/emacs-lisp/bytecomp-tests.el (bytecomp-tests--with-temp-file): Helper macro for unit test. --- lisp/emacs-lisp/bytecomp.el | 7 ++++++ src/lread.c | 40 ++++++++++++++++++++++++++++++++++ test/lisp/emacs-lisp/bytecomp-tests.el | 23 +++++++++++++++++++ test/src/lread-tests.el | 26 ++++++++++++++++++++++ 4 files changed, 96 insertions(+) (limited to 'lisp/emacs-lisp/bytecomp.el') diff --git a/lisp/emacs-lisp/bytecomp.el b/lisp/emacs-lisp/bytecomp.el index 15dc24060aa..25102548a9d 100644 --- a/lisp/emacs-lisp/bytecomp.el +++ b/lisp/emacs-lisp/bytecomp.el @@ -2027,12 +2027,19 @@ With argument ARG, insert value in current buffer after the form." (setq byte-compile-read-position (point) byte-compile-last-position byte-compile-read-position) (let* ((old-style-backquotes nil) + (lread--unescaped-character-literals nil) (form (read inbuffer))) ;; Warn about the use of old-style backquotes. (when old-style-backquotes (byte-compile-warn "!! The file uses old-style backquotes !! This functionality has been obsolete for more than 10 years already and will be removed soon. See (elisp)Backquote in the manual.")) + (when lread--unescaped-character-literals + (byte-compile-warn + "unescaped character literals %s detected!" + (mapconcat #'string + (sort lread--unescaped-character-literals #'<) + ", "))) (byte-compile-toplevel-file-form form))) ;; Compile pending forms at end of file. (byte-compile-flush-pending) diff --git a/src/lread.c b/src/lread.c index 3b2e123dd39..6467043b1da 100644 --- a/src/lread.c +++ b/src/lread.c @@ -955,6 +955,21 @@ load_warn_old_style_backquotes (Lisp_Object file) } } +static void +load_warn_unescaped_character_literals (Lisp_Object file) +{ + if (NILP (Vlread_unescaped_character_literals)) return; + CHECK_CONS (Vlread_unescaped_character_literals); + AUTO_STRING (format, + "Loading `%s': unescaped character literals %s detected!"); + AUTO_STRING (separator, ", "); + CALLN (Fmessage, + format, file, + Fmapconcat (Qstring, + Fsort (Vlread_unescaped_character_literals, Qlss), + separator)); +} + DEFUN ("get-load-suffixes", Fget_load_suffixes, Sget_load_suffixes, 0, 0, 0, doc: /* Return the suffixes that `load' should try if a suffix is \ required. @@ -1202,6 +1217,11 @@ Return t if the file exists and loads successfully. */) specbind (Qold_style_backquotes, Qnil); record_unwind_protect (load_warn_old_style_backquotes, file); + /* Check for the presence of unescaped character literals and warn + about them. */ + specbind (Qlread_unescaped_character_literals, Qnil); + record_unwind_protect (load_warn_unescaped_character_literals, file); + int is_elc; if ((is_elc = suffix_p (found, ".elc")) != 0 /* version = 1 means the file is empty, in which case we can @@ -3092,6 +3112,16 @@ read1 (Lisp_Object readcharfun, int *pch, bool first_in_list) if (c == ' ' || c == '\t') return make_number (c); + if (c == '(' || c == ')' || c == '[' || c == ']' + || c == '"' || c == ';') + { + CHECK_LIST (Vlread_unescaped_character_literals); + Lisp_Object char_obj = make_natnum (c); + if (NILP (Fmemq (char_obj, Vlread_unescaped_character_literals))) + Vlread_unescaped_character_literals = + Fcons (char_obj, Vlread_unescaped_character_literals); + } + if (c == '\\') c = read_escape (readcharfun, 0); modifiers = c & CHAR_MODIFIER_MASK; @@ -4815,6 +4845,16 @@ variables, this must be set in the first line of a file. */); Vold_style_backquotes = Qnil; DEFSYM (Qold_style_backquotes, "old-style-backquotes"); + DEFVAR_LISP ("lread--unescaped-character-literals", + Vlread_unescaped_character_literals, + doc: /* List of deprecated unescaped character literals encountered by `read'. +For internal use only. */); + Vlread_unescaped_character_literals = Qnil; + DEFSYM (Qlread_unescaped_character_literals, + "lread--unescaped-character-literals"); + + DEFSYM (Qlss, "<"); + DEFVAR_BOOL ("load-prefer-newer", load_prefer_newer, doc: /* Non-nil means `load' prefers the newest version of a file. This applies when a filename suffix is not explicitly specified and diff --git a/test/lisp/emacs-lisp/bytecomp-tests.el b/test/lisp/emacs-lisp/bytecomp-tests.el index e8feec31d26..3624904753c 100644 --- a/test/lisp/emacs-lisp/bytecomp-tests.el +++ b/test/lisp/emacs-lisp/bytecomp-tests.el @@ -506,6 +506,29 @@ bytecompiled code, and their results compared.") (dolist (pat bytecomp-lexbind-tests) (should (bytecomp-lexbind-check-1 pat)))) +(defmacro bytecomp-tests--with-temp-file (file-name-var &rest body) + (declare (indent 1)) + (cl-check-type file-name-var symbol) + `(let ((,file-name-var (make-temp-file "emacs"))) + (unwind-protect + (progn ,@body) + (delete-file ,file-name-var)))) + +(ert-deftest bytecomp-tests--unescaped-char-literals () + "Check that byte compiling warns about unescaped character +literals (Bug#20852)." + (should (boundp 'lread--unescaped-character-literals)) + (bytecomp-tests--with-temp-file source + (write-region "(list ?) ?( ?; ?\" ?[ ?])" nil source) + (bytecomp-tests--with-temp-file destination + (let* ((byte-compile-dest-file-function (lambda (_) destination)) + (byte-compile-error-on-warn t) + (byte-compile-debug t) + (err (should-error (byte-compile-file source)))) + (should (equal (cdr err) + (list (concat "unescaped character literals " + "\", (, ), ;, [, ] detected!")))))))) + ;; Local Variables: ;; no-byte-compile: t ;; End: diff --git a/test/src/lread-tests.el b/test/src/lread-tests.el index 27f967f045b..84342348d45 100644 --- a/test/src/lread-tests.el +++ b/test/src/lread-tests.el @@ -116,4 +116,30 @@ (should (equal '(#s(foo) #s(foo)) (read "(#1=#s(foo) #1#)")))) +(defmacro lread-tests--with-temp-file (file-name-var &rest body) + (declare (indent 1)) + (cl-check-type file-name-var symbol) + `(let ((,file-name-var (make-temp-file "emacs"))) + (unwind-protect + (progn ,@body) + (delete-file ,file-name-var)))) + +(defun lread-tests--last-message () + (with-current-buffer "*Messages*" + (save-excursion + (goto-char (point-max)) + (skip-chars-backward "\n") + (buffer-substring (line-beginning-position) (point))))) + +(ert-deftest lread-tests--unescaped-char-literals () + "Check that loading warns about unescaped character +literals (Bug#20852)." + (lread-tests--with-temp-file file-name + (write-region "?) ?( ?; ?\" ?[ ?]" nil file-name) + (should (equal (load file-name nil :nomessage :nosuffix) t)) + (should (equal (lread-tests--last-message) + (concat (format-message "Loading `%s': " file-name) + "unescaped character literals " + "\", (, ), ;, [, ] detected!"))))) + ;;; lread-tests.el ends here -- cgit v1.2.3 From 233cfb0ea93ecdd2b63298be4243059e2e7a91fd Mon Sep 17 00:00:00 2001 From: Glenn Morris Date: Sat, 6 May 2017 18:01:34 -0700 Subject: Remove obsolete method of changing byte-compile-dest-file * lisp/emacs-lisp/bytecomp.el (byte-compile-dest-file): Define unconditionally. --- lisp/emacs-lisp/bytecomp.el | 23 +++++++++-------------- 1 file changed, 9 insertions(+), 14 deletions(-) (limited to 'lisp/emacs-lisp/bytecomp.el') diff --git a/lisp/emacs-lisp/bytecomp.el b/lisp/emacs-lisp/bytecomp.el index 25102548a9d..201733ff033 100644 --- a/lisp/emacs-lisp/bytecomp.el +++ b/lisp/emacs-lisp/bytecomp.el @@ -166,24 +166,19 @@ file name, and return the name of the compiled file." (funcall handler 'byte-compiler-base-file-name filename) filename))) -(or (fboundp 'byte-compile-dest-file) - ;; The user may want to redefine this along with emacs-lisp-file-regexp, - ;; so only define it if it is undefined. - ;; Note - redefining this function is obsolete as of 23.2. - ;; Customize byte-compile-dest-file-function instead. - (defun byte-compile-dest-file (filename) - "Convert an Emacs Lisp source file name to a compiled file name. +(defun byte-compile-dest-file (filename) + "Convert an Emacs Lisp source file name to a compiled file name. If `byte-compile-dest-file-function' is non-nil, uses that function to do the work. Otherwise, if FILENAME matches `emacs-lisp-file-regexp' (by default, files with the extension `.el'), adds `c' to it; otherwise adds `.elc'." - (if byte-compile-dest-file-function - (funcall byte-compile-dest-file-function filename) - (setq filename (file-name-sans-versions - (byte-compiler-base-file-name filename))) - (cond ((string-match emacs-lisp-file-regexp filename) - (concat (substring filename 0 (match-beginning 0)) ".elc")) - (t (concat filename ".elc")))))) + (if byte-compile-dest-file-function + (funcall byte-compile-dest-file-function filename) + (setq filename (file-name-sans-versions + (byte-compiler-base-file-name filename))) + (cond ((string-match emacs-lisp-file-regexp filename) + (concat (substring filename 0 (match-beginning 0)) ".elc")) + (t (concat filename ".elc"))))) ;; This can be the 'byte-compile property of any symbol. (autoload 'byte-compile-inline-expand "byte-opt") -- cgit v1.2.3 From 16004397f40d15d9db6b90632c236c804f38fc40 Mon Sep 17 00:00:00 2001 From: Philipp Stephani Date: Sat, 13 May 2017 12:28:48 +0200 Subject: Improve unescaped character literal warnings * src/lread.c (load_warn_unescaped_character_literals) (syms_of_lread): lisp/emacs-lisp/bytecomp.el (byte-compile-from-buffer): Improve formatting of unescaped character literal warnings. * test/src/lread-tests.el (lread-tests--unescaped-char-literals): test/lisp/emacs-lisp/bytecomp-tests.el (bytecomp-tests--unescaped-char-literals): Adapt unit tests. --- lisp/emacs-lisp/bytecomp.el | 2 +- src/lread.c | 6 +++++- test/lisp/emacs-lisp/bytecomp-tests.el | 3 ++- test/src/lread-tests.el | 2 +- 4 files changed, 9 insertions(+), 4 deletions(-) (limited to 'lisp/emacs-lisp/bytecomp.el') diff --git a/lisp/emacs-lisp/bytecomp.el b/lisp/emacs-lisp/bytecomp.el index 201733ff033..daad93de182 100644 --- a/lisp/emacs-lisp/bytecomp.el +++ b/lisp/emacs-lisp/bytecomp.el @@ -2032,7 +2032,7 @@ and will be removed soon. See (elisp)Backquote in the manual.")) (when lread--unescaped-character-literals (byte-compile-warn "unescaped character literals %s detected!" - (mapconcat #'string + (mapconcat (lambda (char) (format "`?%c'" char)) (sort lread--unescaped-character-literals #'<) ", "))) (byte-compile-toplevel-file-form form))) diff --git a/src/lread.c b/src/lread.c index f0ad0c28e56..0e5b476a9a2 100644 --- a/src/lread.c +++ b/src/lread.c @@ -963,9 +963,11 @@ load_warn_unescaped_character_literals (Lisp_Object file) AUTO_STRING (format, "Loading `%s': unescaped character literals %s detected!"); AUTO_STRING (separator, ", "); + AUTO_STRING (inner_format, "`?%c'"); CALLN (Fmessage, format, file, - Fmapconcat (Qstring, + Fmapconcat (list3 (Qlambda, list1 (Qchar), + list3 (Qformat, inner_format, Qchar)), Fsort (Vlread_unescaped_character_literals, Qlss), separator)); } @@ -4855,6 +4857,8 @@ For internal use only. */); "lread--unescaped-character-literals"); DEFSYM (Qlss, "<"); + DEFSYM (Qchar, "char"); + DEFSYM (Qformat, "format"); DEFVAR_BOOL ("load-prefer-newer", load_prefer_newer, doc: /* Non-nil means `load' prefers the newest version of a file. diff --git a/test/lisp/emacs-lisp/bytecomp-tests.el b/test/lisp/emacs-lisp/bytecomp-tests.el index 3624904753c..84004a9264a 100644 --- a/test/lisp/emacs-lisp/bytecomp-tests.el +++ b/test/lisp/emacs-lisp/bytecomp-tests.el @@ -527,7 +527,8 @@ literals (Bug#20852)." (err (should-error (byte-compile-file source)))) (should (equal (cdr err) (list (concat "unescaped character literals " - "\", (, ), ;, [, ] detected!")))))))) + "`?\"', `?(', `?)', `?;', `?[', `?]' " + "detected!")))))))) ;; Local Variables: ;; no-byte-compile: t diff --git a/test/src/lread-tests.el b/test/src/lread-tests.el index 0427fe64e4a..685ea682e29 100644 --- a/test/src/lread-tests.el +++ b/test/src/lread-tests.el @@ -140,7 +140,7 @@ literals (Bug#20852)." (should (equal (lread-tests--last-message) (concat (format-message "Loading `%s': " file-name) "unescaped character literals " - "\", (, ), ;, [, ] detected!"))))) + "`?\"', `?(', `?)', `?;', `?[', `?]' detected!"))))) (ert-deftest lread-test-bug26837 () "Test for http://debbugs.gnu.org/26837 ." -- cgit v1.2.3 From a1d461592172ca4c8aac0e4e923ef5e909cfb361 Mon Sep 17 00:00:00 2001 From: Philipp Date: Sat, 6 May 2017 22:23:03 +0200 Subject: Make `old-style-backquotes' variable internal * src/lread.c (load_warn_old_style_backquotes, Fload, read1) (syms_of_lread): Rename `old-style-backquotes' to `lread--old-style-backquotes', and clarify that it's for internal use only. * lisp/emacs-lisp/bytecomp.el (byte-compile-from-buffer): Rename variable. * test/src/lread-tests.el (lread-tests--old-style-backquotes): Add unit test. * emacs-lisp/bytecomp-tests.el (bytecomp-tests--old-style-backquotes): Add unit test. --- etc/NEWS | 5 +++++ lisp/emacs-lisp/bytecomp.el | 4 ++-- src/lread.c | 17 +++++++++-------- test/lisp/emacs-lisp/bytecomp-tests.el | 15 +++++++++++++++ test/src/lread-tests.el | 9 +++++++++ 5 files changed, 40 insertions(+), 10 deletions(-) (limited to 'lisp/emacs-lisp/bytecomp.el') diff --git a/etc/NEWS b/etc/NEWS index 9be6ee0f3f7..380ce710130 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -907,6 +907,11 @@ which was sometimes numerically incorrect. For example, on a 64-bit host (max 1e16 10000000000000001) now returns its second argument instead of its first. ++++ +** The variable 'old-style-backquotes' has been made internal and +renamed to 'lread--old-style-backquotes'. No user code should use +this variable. + * Lisp Changes in Emacs 26.1 diff --git a/lisp/emacs-lisp/bytecomp.el b/lisp/emacs-lisp/bytecomp.el index daad93de182..e716eef10ad 100644 --- a/lisp/emacs-lisp/bytecomp.el +++ b/lisp/emacs-lisp/bytecomp.el @@ -2021,11 +2021,11 @@ With argument ARG, insert value in current buffer after the form." (not (eobp))) (setq byte-compile-read-position (point) byte-compile-last-position byte-compile-read-position) - (let* ((old-style-backquotes nil) + (let* ((lread--old-style-backquotes nil) (lread--unescaped-character-literals nil) (form (read inbuffer))) ;; Warn about the use of old-style backquotes. - (when old-style-backquotes + (when lread--old-style-backquotes (byte-compile-warn "!! The file uses old-style backquotes !! This functionality has been obsolete for more than 10 years already and will be removed soon. See (elisp)Backquote in the manual.")) diff --git a/src/lread.c b/src/lread.c index 0e5b476a9a2..c03aad4f722 100644 --- a/src/lread.c +++ b/src/lread.c @@ -948,7 +948,7 @@ load_error_handler (Lisp_Object data) static void load_warn_old_style_backquotes (Lisp_Object file) { - if (!NILP (Vold_style_backquotes)) + if (!NILP (Vlread_old_style_backquotes)) { AUTO_STRING (format, "Loading `%s': old-style backquotes detected!"); CALLN (Fmessage, format, file); @@ -1216,7 +1216,7 @@ Return t if the file exists and loads successfully. */) version = -1; /* Check for the presence of old-style quotes and warn about them. */ - specbind (Qold_style_backquotes, Qnil); + specbind (Qlread_old_style_backquotes, Qnil); record_unwind_protect (load_warn_old_style_backquotes, file); /* Check for the presence of unescaped character literals and warn @@ -3040,7 +3040,7 @@ read1 (Lisp_Object readcharfun, int *pch, bool first_in_list) "(\`" anyway). */ if (!new_backquote_flag && first_in_list && next_char == ' ') { - Vold_style_backquotes = Qt; + Vlread_old_style_backquotes = Qt; goto default_label; } else @@ -3094,7 +3094,7 @@ read1 (Lisp_Object readcharfun, int *pch, bool first_in_list) } else { - Vold_style_backquotes = Qt; + Vlread_old_style_backquotes = Qt; goto default_label; } } @@ -4843,10 +4843,11 @@ variables, this must be set in the first line of a file. */); doc: /* List of buffers being read from by calls to `eval-buffer' and `eval-region'. */); Veval_buffer_list = Qnil; - DEFVAR_LISP ("old-style-backquotes", Vold_style_backquotes, - doc: /* Set to non-nil when `read' encounters an old-style backquote. */); - Vold_style_backquotes = Qnil; - DEFSYM (Qold_style_backquotes, "old-style-backquotes"); + DEFVAR_LISP ("lread--old-style-backquotes", Vlread_old_style_backquotes, + doc: /* Set to non-nil when `read' encounters an old-style backquote. +For internal use only. */); + Vlread_old_style_backquotes = Qnil; + DEFSYM (Qlread_old_style_backquotes, "lread--old-style-backquotes"); DEFVAR_LISP ("lread--unescaped-character-literals", Vlread_unescaped_character_literals, diff --git a/test/lisp/emacs-lisp/bytecomp-tests.el b/test/lisp/emacs-lisp/bytecomp-tests.el index 84004a9264a..d15bd8b6e65 100644 --- a/test/lisp/emacs-lisp/bytecomp-tests.el +++ b/test/lisp/emacs-lisp/bytecomp-tests.el @@ -530,6 +530,21 @@ literals (Bug#20852)." "`?\"', `?(', `?)', `?;', `?[', `?]' " "detected!")))))))) +(ert-deftest bytecomp-tests--old-style-backquotes () + "Check that byte compiling warns about old-style backquotes." + (should (boundp 'lread--old-style-backquotes)) + (bytecomp-tests--with-temp-file source + (write-region "(` (a b))" nil source) + (bytecomp-tests--with-temp-file destination + (let* ((byte-compile-dest-file-function (lambda (_) destination)) + (byte-compile-error-on-warn t) + (byte-compile-debug t) + (err (should-error (byte-compile-file source)))) + (should (equal (cdr err) + (list "!! The file uses old-style backquotes !! +This functionality has been obsolete for more than 10 years already +and will be removed soon. See (elisp)Backquote in the manual."))))))) + ;; Local Variables: ;; no-byte-compile: t ;; End: diff --git a/test/src/lread-tests.el b/test/src/lread-tests.el index 685ea682e29..98cbb6a301d 100644 --- a/test/src/lread-tests.el +++ b/test/src/lread-tests.el @@ -155,4 +155,13 @@ literals (Bug#20852)." (load "somelib" nil t) (should (string-suffix-p "/somelib.el" (caar load-history))))) +(ert-deftest lread-tests--old-style-backquotes () + "Check that loading warns about old-style backquotes." + (lread-tests--with-temp-file file-name + (write-region "(` (a b))" nil file-name) + (should (equal (load file-name nil :nomessage :nosuffix) t)) + (should (equal (lread-tests--last-message) + (concat (format-message "Loading `%s': " file-name) + "old-style backquotes detected!"))))) + ;;; lread-tests.el ends here -- cgit v1.2.3 From f151eb01418b80d102c767566e93ac332a8bf7c3 Mon Sep 17 00:00:00 2001 From: Andreas Politz Date: Sat, 4 Mar 2017 05:58:34 +0100 Subject: Don't save unrelated buffers before recompiling directory (Bug#25964) * lisp/emacs-lisp/bytecomp.el (byte-recompile-directory): Only save buffers visiting lisp files under the directory being compiled. --- lisp/emacs-lisp/bytecomp.el | 7 ++++++- 1 file changed, 6 insertions(+), 1 deletion(-) (limited to 'lisp/emacs-lisp/bytecomp.el') diff --git a/lisp/emacs-lisp/bytecomp.el b/lisp/emacs-lisp/bytecomp.el index e716eef10ad..6c12e5d8e25 100644 --- a/lisp/emacs-lisp/bytecomp.el +++ b/lisp/emacs-lisp/bytecomp.el @@ -1659,7 +1659,12 @@ that already has a `.elc' file." (if arg (setq arg (prefix-numeric-value arg))) (if noninteractive nil - (save-some-buffers) + (save-some-buffers + nil (lambda () + (let ((file (buffer-file-name))) + (and file + (string-match-p emacs-lisp-file-regexp file) + (file-in-directory-p file directory))))) (force-mode-line-update)) (with-current-buffer (get-buffer-create byte-compile-log-buffer) (setq default-directory (expand-file-name directory)) -- cgit v1.2.3 From ebe0bdae9ded4eab974faefb54a6ba5260523489 Mon Sep 17 00:00:00 2001 From: Philipp Stephani Date: Sat, 27 May 2017 14:39:01 +0200 Subject: Don't attempt to recover from undefined behavior in some cases These functions can only be run in batch mode and exit Emacs on return, so nothing can be recovered. Disable unsafe recover mechanisms so that we get real failures and good stack traces on fatal signals. * lisp/emacs-lisp/bytecomp.el (batch-byte-compile) (batch-byte-recompile-directory): * lisp/emacs-lisp/ert.el (ert-run-tests-batch-and-exit) (ert-summarize-tests-batch-and-exit): Don't attempt to recover from undefined behavior. --- lisp/emacs-lisp/bytecomp.el | 8 ++++++++ lisp/emacs-lisp/ert.el | 10 ++++++++++ 2 files changed, 18 insertions(+) (limited to 'lisp/emacs-lisp/bytecomp.el') diff --git a/lisp/emacs-lisp/bytecomp.el b/lisp/emacs-lisp/bytecomp.el index 6c12e5d8e25..12a7d4afc2a 100644 --- a/lisp/emacs-lisp/bytecomp.el +++ b/lisp/emacs-lisp/bytecomp.el @@ -4960,6 +4960,10 @@ already up-to-date." (defvar command-line-args-left) ;Avoid 'free variable' warning (if (not noninteractive) (error "`batch-byte-compile' is to be used only with -batch")) + ;; Better crash loudly than attempting to recover from undefined + ;; behavior. + (setq attempt-stack-overflow-recovery nil + attempt-orderly-shutdown-on-fatal-signal nil) (let ((error nil)) (while command-line-args-left (if (file-directory-p (expand-file-name (car command-line-args-left))) @@ -5052,6 +5056,10 @@ and corresponding effects." (defvar command-line-args-left) ;Avoid 'free variable' warning (if (not noninteractive) (error "batch-byte-recompile-directory is to be used only with -batch")) + ;; Better crash loudly than attempting to recover from undefined + ;; behavior. + (setq attempt-stack-overflow-recovery nil + attempt-orderly-shutdown-on-fatal-signal nil) (or command-line-args-left (setq command-line-args-left '("."))) (while command-line-args-left diff --git a/lisp/emacs-lisp/ert.el b/lisp/emacs-lisp/ert.el index 280b76acfe4..2c49a634e35 100644 --- a/lisp/emacs-lisp/ert.el +++ b/lisp/emacs-lisp/ert.el @@ -1458,6 +1458,12 @@ The exit status will be 0 if all test results were as expected, 1 on unexpected results, or 2 if the tool detected an error outside of the tests (e.g. invalid SELECTOR or bug in the code that runs the tests)." + (or noninteractive + (user-error "This function is only for use in batch mode")) + ;; Better crash loudly than attempting to recover from undefined + ;; behavior. + (setq attempt-stack-overflow-recovery nil + attempt-orderly-shutdown-on-fatal-signal nil) (unwind-protect (let ((stats (ert-run-tests-batch selector))) (kill-emacs (if (zerop (ert-stats-completed-unexpected stats)) 0 1))) @@ -1475,6 +1481,10 @@ The logfiles should have the `ert-run-tests-batch' format. When finished, this exits Emacs, with status as per `ert-run-tests-batch-and-exit'." (or noninteractive (user-error "This function is only for use in batch mode")) + ;; Better crash loudly than attempting to recover from undefined + ;; behavior. + (setq attempt-stack-overflow-recovery nil + attempt-orderly-shutdown-on-fatal-signal nil) (let ((nlogs (length command-line-args-left)) (ntests 0) (nrun 0) (nexpected 0) (nunexpected 0) (nskipped 0) nnotrun logfile notests badtests unexpected skipped) -- cgit v1.2.3 From 0dd1bbb0bb228acab21b8e16f2f2a0b5a17b19ab Mon Sep 17 00:00:00 2001 From: Philipp Stephani Date: Thu, 1 Jun 2017 00:09:43 +0200 Subject: Implement field numbers in format strings A field number explicitly specifies the argument to be formatted. This is especially important for potential localization work, since grammars of various languages dictate different word orders. * src/editfns.c (Fformat): Update documentation. (styled_format): Implement field numbers. * doc/lispref/strings.texi (Formatting Strings): Document field numbers. * lisp/emacs-lisp/bytecomp.el (byte-compile-format-warn): Adapt. * test/src/editfns-tests.el (format-with-field): New unit test. --- doc/lispref/strings.texi | 31 ++++++++++++++++++++++--- etc/NEWS | 3 +++ lisp/emacs-lisp/bytecomp.el | 11 ++++++--- src/editfns.c | 55 ++++++++++++++++++++++++++++++++++++++------- test/src/editfns-tests.el | 18 +++++++++++++++ 5 files changed, 104 insertions(+), 14 deletions(-) (limited to 'lisp/emacs-lisp/bytecomp.el') diff --git a/doc/lispref/strings.texi b/doc/lispref/strings.texi index 9436a96ead4..526b1fb4ebc 100644 --- a/doc/lispref/strings.texi +++ b/doc/lispref/strings.texi @@ -864,7 +864,8 @@ below, as the first argument, and the string as the second, like this: (format "%s" @var{arbitrary-string}) @end example - If @var{string} contains more than one format specification, the + If @var{string} contains more than one format specification and none +of the format specifications contain an explicit field number, the format specifications correspond to successive values from @var{objects}. Thus, the first format specification in @var{string} uses the first such value, the second format specification uses the @@ -961,6 +962,25 @@ operation} error. @end group @end example +@cindex field numbers in format spec + A specification can have a @dfn{field number}, which is a decimal +number after the initial @samp{%}, followed by a literal dollar sign +@samp{$}. If you provide a field number, then the argument to be +printed corresponds to the given field number instead of the next +argument. Field numbers start at 1. + +You can mix specifications with and without field numbers. A +specification without a field number that follows a specification with +a field number will convert the argument after the one specified by +the field number: + +@example +(format "First argument %2$s, then %s, then %1$s" 1 2 3) + @result{} "First argument 2, then 3, then 1" +@end example + +You can't use field numbers in a @samp{%%} specification. + @cindex field width @cindex padding A specification can have a @dfn{width}, which is a decimal number @@ -996,9 +1016,14 @@ is not truncated. @end group @end example +If you want to use both a field number and a width, place the field +number before the width. For example, in @samp{%2$7s}, @samp{2} is +the field number and @samp{7} is the width. + @cindex flags in format specifications - Immediately after the @samp{%} and before the optional width -specifier, you can also put certain @dfn{flag characters}. + After the @samp{%} and before the optional width specifier, you can +also put certain @dfn{flag characters}. The flag characters need to +come directly after a potential field number. The flag @samp{+} inserts a plus sign before a positive number, so that it always has a sign. A space character as flag inserts a space diff --git a/etc/NEWS b/etc/NEWS index 055de8ca9e8..1b098f98425 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -368,6 +368,9 @@ libraries: 'find-library-other-window' and 'find-library-other-frame'. ** The new variable 'display-raw-bytes-as-hex' allows to change the display of raw bytes from octal to hex. +** You can now provide explicit field numbers in format specifiers. +For example, '(format "%2$s %1$s" 1 2)' produces "2 1". + * Editing Changes in Emacs 26.1 diff --git a/lisp/emacs-lisp/bytecomp.el b/lisp/emacs-lisp/bytecomp.el index 12a7d4afc2a..e5b9b47b1d0 100644 --- a/lisp/emacs-lisp/bytecomp.el +++ b/lisp/emacs-lisp/bytecomp.el @@ -1375,10 +1375,15 @@ extra args." (let ((nfields (with-temp-buffer (insert (nth 1 form)) (goto-char (point-min)) - (let ((n 0)) + (let ((i 0) (n 0)) (while (re-search-forward "%." nil t) - (unless (eq ?% (char-after (1+ (match-beginning 0)))) - (setq n (1+ n)))) + (backward-char) + (unless (eq ?% (char-after)) + (setq i (if (looking-at "\\([0-9]+\\)\\$") + (string-to-number (match-string 1) 10) + (1+ i)) + n (max n i))) + (forward-char)) n))) (nargs (- (length form) 2))) (unless (= nargs nfields) diff --git a/src/editfns.c b/src/editfns.c index 89a67241044..44341cef2d3 100644 --- a/src/editfns.c +++ b/src/editfns.c @@ -48,6 +48,7 @@ along with GNU Emacs. If not, see . */ #include #include +#include #include #include #include @@ -3856,7 +3857,7 @@ The first argument is a format control string. The other arguments are substituted into it to make the result, a string. The format control string may contain %-sequences meaning to substitute -the next available argument: +the next available argument, or the argument explicitly specified: %s means print a string argument. Actually, prints any object, with `princ'. %d means print as signed number in decimal. @@ -3873,13 +3874,17 @@ the next available argument: The argument used for %d, %o, %x, %e, %f, %g or %c must be a number. Use %% to put a single % into the output. -A %-sequence may contain optional flag, width, and precision -specifiers, as follows: +A %-sequence may contain optional field number, flag, width, and +precision specifiers, as follows: - %character + %character -where flags is [+ #-0]+, width is [0-9]+, and precision is a literal -period "." followed by [0-9]+ +where field is [0-9]+ followed by a literal dollar "$", flags is +[+ #-0]+, width is [0-9]+, and precision is a literal period "." +followed by [0-9]+. + +If field is given, it must be a one-based argument number; the given +argument is substituted instead of the next one. The + flag character inserts a + before any positive number, while a space inserts a space before any positive number; these flags only @@ -4032,14 +4037,19 @@ styled_format (ptrdiff_t nargs, Lisp_Object *args, bool message) { /* General format specifications look like - '%' [flags] [field-width] [precision] format + '%' [field-number] [flags] [field-width] [precision] format where + field-number ::= [0-9]+ '$' flags ::= [-+0# ]+ field-width ::= [0-9]+ precision ::= '.' [0-9]* + If a field-number is specified, it specifies the argument + number to substitute. Otherwise, the next argument is + taken. + If a field-width is specified, it specifies to which width the output should be padded with blanks, if the output string is shorter than field-width. @@ -4048,6 +4058,29 @@ styled_format (ptrdiff_t nargs, Lisp_Object *args, bool message) digits to print after the '.' for floats, or the max. number of chars to print from a string. */ + char *field_end; + uintmax_t raw_field = strtoumax (format, &field_end, 10); + bool has_field = false; + if (c_isdigit (*format) && *field_end == '$') + { + if (raw_field < 1 || raw_field >= PTRDIFF_MAX) + { + /* doprnt doesn't support %.*s, so we need to copy + the field number string. */ + ptrdiff_t length = field_end - format; + eassert (length > 0); + eassert (length < PTRDIFF_MAX); + char *field = SAFE_ALLOCA (length + 1); + memcpy (field, format, length); + field[length] = '\0'; + error ("Invalid field number `%s'", field); + } + has_field = true; + /* n is incremented below. */ + n = raw_field - 1; + format = field_end + 1; + } + bool minus_flag = false; bool plus_flag = false; bool space_flag = false; @@ -4090,7 +4123,13 @@ styled_format (ptrdiff_t nargs, Lisp_Object *args, bool message) memset (&discarded[format0 - format_start], 1, format - format0 - (conversion == '%')); if (conversion == '%') - goto copy_char; + { + if (has_field) + /* FIXME: `error' doesn't appear to support `%%'. */ + error ("Field number specified together with `%c' conversion", + '%'); + goto copy_char; + } ++n; if (! (n < nargs)) diff --git a/test/src/editfns-tests.el b/test/src/editfns-tests.el index 8019eb03838..f76c6c9fd36 100644 --- a/test/src/editfns-tests.el +++ b/test/src/editfns-tests.el @@ -177,4 +177,22 @@ (format-time-string "%Y-%m-%d %H:%M:%S.%3N %z" nil (concat (make-string 2048 ?X) "0"))))) +(ert-deftest format-with-field () + (should (equal (format "First argument %2$s, then %s, then %1$s" 1 2 3) + "First argument 2, then 3, then 1")) + (should (equal (format "a %2$s %d %1$d %2$S %d %d b" 11 "22" 33 44) + "a 22 33 11 \"22\" 33 44 b")) + (should (equal (format "a %08$s %s b" 1 2 3 4 5 6 7 8 9) "a 8 9 b")) + (should (equal (should-error (format "a %999999$s b" 11)) + '(error "Not enough arguments for format string"))) + (should (equal (should-error (format "a %$s b" 11)) + ;; FIXME: there shouldn't be two % in the error + ;; string! + '(error "Invalid format operation %%$"))) + (should (equal (should-error (format "a %0$s b" 11)) + '(error "Invalid field number `0'"))) + (should (equal + (should-error (format "a %1$% %s b" 11)) + '(error "Field number specified together with `%' conversion")))) + ;;; editfns-tests.el ends here -- cgit v1.2.3