From 97cd730164baf67617e1031730105523315c068f Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Sat, 8 Nov 2014 12:46:21 -0500 Subject: [PATCH] * lisp/emacs-lisp/bytecomp.el: Add a warning and remove a spurious warning. (byte-compile-initial-macro-environment): Don't compile before eval in `eval-and-compile'. (byte-compile-arglist-warn): Add check for defining macros after their first use. Check call use even if the function is fboundp. --- lisp/ChangeLog | 7 ++ lisp/emacs-lisp/bytecomp.el | 104 +++++++++++++------------- test/automated/bytecomp-tests.el | 26 ++++++- test/automated/{cl-lib.el => cl-lib-tests.el} | 0 4 files changed, 85 insertions(+), 52 deletions(-) rename test/automated/{cl-lib.el => cl-lib-tests.el} (100%) diff --git a/lisp/ChangeLog b/lisp/ChangeLog index aac6ba5d739..a67f9220bbb 100644 --- a/lisp/ChangeLog +++ b/lisp/ChangeLog @@ -1,3 +1,10 @@ +2014-11-08 Stefan Monnier + + * emacs-lisp/bytecomp.el (byte-compile-initial-macro-environment): + Don't compile before eval in `eval-and-compile'. + (byte-compile-arglist-warn): Add check for defining macros after their + first use. Check call use even if the function is fboundp. + 2014-11-08 Richard Stallman * mail/rmail.el (rmail-epa-decrypt): Detect armor with line prefixes. diff --git a/lisp/emacs-lisp/bytecomp.el b/lisp/emacs-lisp/bytecomp.el index 392f6ee83cd..7fd72dd7705 100644 --- a/lisp/emacs-lisp/bytecomp.el +++ b/lisp/emacs-lisp/bytecomp.el @@ -461,10 +461,13 @@ Return the compile-time value of FORM." (byte-compile-recurse-toplevel (cons 'progn body) (lambda (form) - (let ((compiled (byte-compile-top-level - (byte-compile-preprocess form)))) - (eval compiled lexical-binding) - compiled)))))) + ;; Don't compile here, since we don't know + ;; whether to compile as byte-compile-form + ;; or byte-compile-file-form. + (let ((expanded + (byte-compile-preprocess form))) + (eval expanded lexical-binding) + expanded)))))) "The default macro-environment passed to macroexpand by the compiler. Placing a macro here will cause a macro to have different semantics when expanded by the compiler as when expanded by the interpreter.") @@ -1361,6 +1364,33 @@ extra args." ;; Warn if the function or macro is being redefined with a different ;; number of arguments. (defun byte-compile-arglist-warn (name arglist macrop) + ;; This is the first definition. See if previous calls are compatible. + (let ((calls (assq name byte-compile-unresolved-functions)) + nums sig min max) + (when (and calls macrop) + (byte-compile-warn "macro `%s' defined too late" name)) + (setq byte-compile-unresolved-functions + (delq calls byte-compile-unresolved-functions)) + (setq calls (delq t calls)) ;Ignore higher-order uses of the function. + (when (cdr calls) + (when (and (symbolp name) + (eq (function-get name 'byte-optimizer) + 'byte-compile-inline-expand)) + (byte-compile-warn "defsubst `%s' was used before it was defined" + name)) + (setq sig (byte-compile-arglist-signature arglist) + nums (sort (copy-sequence (cdr calls)) (function <)) + min (car nums) + max (car (nreverse nums))) + (when (or (< min (car sig)) + (and (cdr sig) (> max (cdr sig)))) + (byte-compile-set-symbol-position name) + (byte-compile-warn + "%s being defined to take %s%s, but was previously called with %s" + name + (byte-compile-arglist-signature-string sig) + (if (equal sig '(1 . 1)) " arg" " args") + (byte-compile-arglist-signature-string (cons min max)))))) (let* ((old (byte-compile-fdefinition name macrop)) (initial (and macrop (cdr (assq name @@ -1369,52 +1399,26 @@ extra args." ;; to a defined function. (Bug#8646) (and initial (symbolp initial) (setq old (byte-compile-fdefinition initial nil))) - (if (and old (not (eq old t))) - (progn - (and (eq 'macro (car-safe old)) - (eq 'lambda (car-safe (cdr-safe old))) - (setq old (cdr old))) - (let ((sig1 (byte-compile-arglist-signature - (pcase old - (`(lambda ,args . ,_) args) - (`(closure ,_ ,args . ,_) args) - ((pred byte-code-function-p) (aref old 0)) - (t '(&rest def))))) - (sig2 (byte-compile-arglist-signature arglist))) - (unless (byte-compile-arglist-signatures-congruent-p sig1 sig2) - (byte-compile-set-symbol-position name) - (byte-compile-warn - "%s %s used to take %s %s, now takes %s" - (if macrop "macro" "function") - name - (byte-compile-arglist-signature-string sig1) - (if (equal sig1 '(1 . 1)) "argument" "arguments") - (byte-compile-arglist-signature-string sig2))))) - ;; This is the first definition. See if previous calls are compatible. - (let ((calls (assq name byte-compile-unresolved-functions)) - nums sig min max) - (setq byte-compile-unresolved-functions - (delq calls byte-compile-unresolved-functions)) - (setq calls (delq t calls)) ;Ignore higher-order uses of the function. - (when (cdr calls) - (when (and (symbolp name) - (eq (function-get name 'byte-optimizer) - 'byte-compile-inline-expand)) - (byte-compile-warn "defsubst `%s' was used before it was defined" - name)) - (setq sig (byte-compile-arglist-signature arglist) - nums (sort (copy-sequence (cdr calls)) (function <)) - min (car nums) - max (car (nreverse nums))) - (when (or (< min (car sig)) - (and (cdr sig) (> max (cdr sig)))) - (byte-compile-set-symbol-position name) - (byte-compile-warn - "%s being defined to take %s%s, but was previously called with %s" - name - (byte-compile-arglist-signature-string sig) - (if (equal sig '(1 . 1)) " arg" " args") - (byte-compile-arglist-signature-string (cons min max))))))))) + (when (and old (not (eq old t))) + (and (eq 'macro (car-safe old)) + (eq 'lambda (car-safe (cdr-safe old))) + (setq old (cdr old))) + (let ((sig1 (byte-compile-arglist-signature + (pcase old + (`(lambda ,args . ,_) args) + (`(closure ,_ ,args . ,_) args) + ((pred byte-code-function-p) (aref old 0)) + (t '(&rest def))))) + (sig2 (byte-compile-arglist-signature arglist))) + (unless (byte-compile-arglist-signatures-congruent-p sig1 sig2) + (byte-compile-set-symbol-position name) + (byte-compile-warn + "%s %s used to take %s %s, now takes %s" + (if macrop "macro" "function") + name + (byte-compile-arglist-signature-string sig1) + (if (equal sig1 '(1 . 1)) "argument" "arguments") + (byte-compile-arglist-signature-string sig2))))))) (defvar byte-compile-cl-functions nil "List of functions defined in CL.") diff --git a/test/automated/bytecomp-tests.el b/test/automated/bytecomp-tests.el index 1d96f1cdfce..2bdc3c5bf12 100644 --- a/test/automated/bytecomp-tests.el +++ b/test/automated/bytecomp-tests.el @@ -316,12 +316,12 @@ Subtests signal errors if something goes wrong." (with-temp-buffer (dolist (form forms) (print form (current-buffer))) - (write-region (point-min) (point-max) elfile)) + (write-region (point-min) (point-max) elfile nil 'silent)) (if compile (let ((byte-compile-dest-file-function (lambda (e) elcfile))) (byte-compile-file elfile t)) - (load elfile))) + (load elfile nil 'nomessage))) (when elfile (delete-file elfile)) (when elcfile (delete-file elcfile))))) (put 'test-byte-comp-compile-and-load 'lisp-indent-function 1) @@ -360,6 +360,28 @@ Subtests signal errors if something goes wrong." (defun def () (m)))) (should (equal (funcall 'def) 4))) +(ert-deftest bytecomp-tests--warnings () + (with-current-buffer (get-buffer-create "*Compile-Log*") + (let ((inhibit-read-only t)) (erase-buffer))) + (test-byte-comp-compile-and-load t + '(progn + (defun my-test0 () + (my--test11 3) + (my--test12 3) + (my--test2 5)) + (defmacro my--test11 (arg) (+ arg 1)) + (eval-and-compile + (defmacro my--test12 (arg) (+ arg 1)) + (defun my--test2 (arg) (+ arg 1))))) + (with-current-buffer (get-buffer-create "*Compile-Log*") + (goto-char (point-min)) + ;; Should warn that mt--test1[12] are first used as functions. + (should (re-search-forward "my--test11:\n.*macro" nil t)) + (should (re-search-forward "my--test12:\n.*macro" nil t)) + (goto-char (point-min)) + ;; Should not warn that mt--test2 is not known to be defined. + (should-not (re-search-forward "my--test2" nil t)))) + (ert-deftest test-eager-load-macro-expansion () (test-byte-comp-compile-and-load nil '(progn (defmacro abc (arg) 1) (defun def () (abc 2)))) diff --git a/test/automated/cl-lib.el b/test/automated/cl-lib-tests.el similarity index 100% rename from test/automated/cl-lib.el rename to test/automated/cl-lib-tests.el -- 2.11.4.GIT