[Emacs-diffs] trunk r118320: * lisp/emacs-lisp/bytecomp.el: Add a warning and remove a spurious warning.

[Stefan Monnier]

------------------------------------------------------------
revno: 118320
revision-id: address@hidden
parent: address@hidden
committer: Stefan Monnier <address@hidden>
branch nick: trunk
timestamp: Sat 2014-11-08 12:46:21 -0500
message:
  * 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.
renamed:
  test/automated/cl-lib.el => test/automated/cl-lib-tests.el 
cllib.el-20130711160611-o23w1tyz0y13jq8e-1
modified:
  lisp/ChangeLog                 changelog-20091113204419-o5vbwnq5f7feedwu-1432
  lisp/emacs-lisp/bytecomp.el    bytecomp.el-20091113204419-o5vbwnq5f7feedwu-492
  test/automated/bytecomp-tests.el 
bytecomptestsuite.el-20091113204419-o5vbwnq5f7feedwu-8799

=== modified file 'lisp/ChangeLog'
--- a/lisp/ChangeLog    2014-11-08 15:48:13 +0000
+++ b/lisp/ChangeLog    2014-11-08 17:46:21 +0000
@@ -1,3 +1,10 @@
+2014-11-08  Stefan Monnier  <address@hidden>
+
+       * 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  <address@hidden>
 
        * mail/rmail.el (rmail-epa-decrypt): Detect armor with line prefixes.

=== modified file 'lisp/emacs-lisp/bytecomp.el'
--- a/lisp/emacs-lisp/bytecomp.el       2014-10-30 05:15:28 +0000
+++ b/lisp/emacs-lisp/bytecomp.el       2014-11-08 17:46:21 +0000
@@ -461,10 +461,13 @@
                                  (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 @@
 ;; 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 @@
     ;; 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.")

=== modified file 'test/automated/bytecomp-tests.el'
--- a/test/automated/bytecomp-tests.el  2014-05-22 02:33:07 +0000
+++ b/test/automated/bytecomp-tests.el  2014-11-08 17:46:21 +0000
@@ -316,12 +316,12 @@
            (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 @@
       (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))))

=== renamed file 'test/automated/cl-lib.el' => 'test/automated/cl-lib-tests.el'