diff options
| author | Alan Mackenzie | 2015-11-26 10:36:32 +0000 |
|---|---|---|
| committer | Alan Mackenzie | 2015-11-26 10:36:32 +0000 |
| commit | 5d93a89e805baa2f29941fd801e48235f6c1a6b6 (patch) | |
| tree | d8bb921b2d2a9185aab21ae0165518fd9f8f378c /lisp | |
| parent | 768b6f67746d2ba8407eb264c4b2d5c8ca011f58 (diff) | |
| download | emacs-5d93a89e805baa2f29941fd801e48235f6c1a6b6.tar.gz emacs-5d93a89e805baa2f29941fd801e48235f6c1a6b6.zip | |
Byte compiler: on setq with an odd number of arguments, generate a `signal'
* lisp/emacs-lisp/cconv.el (cconv-convert): Don't transform `setq' form when
it has an odd number of arguments, to allow bytecomp to handle the error.
* lisp/emacs-lisp/bytecomp.el (byte-compile-setq): In a `setq' form with an
odd number of arguments, generate a `signal' instead of the normal code.
Diffstat (limited to 'lisp')
| -rw-r--r-- | lisp/emacs-lisp/bytecomp.el | 32 | ||||
| -rw-r--r-- | lisp/emacs-lisp/cconv.el | 43 |
2 files changed, 40 insertions, 35 deletions
diff --git a/lisp/emacs-lisp/bytecomp.el b/lisp/emacs-lisp/bytecomp.el index 58cce67598c..ffe73defcbb 100644 --- a/lisp/emacs-lisp/bytecomp.el +++ b/lisp/emacs-lisp/bytecomp.el | |||
| @@ -3741,20 +3741,24 @@ discarding." | |||
| 3741 | (byte-defop-compiler-1 quote) | 3741 | (byte-defop-compiler-1 quote) |
| 3742 | 3742 | ||
| 3743 | (defun byte-compile-setq (form) | 3743 | (defun byte-compile-setq (form) |
| 3744 | (let ((args (cdr form))) | 3744 | (let* ((args (cdr form)) |
| 3745 | (if args | 3745 | (len (length args))) |
| 3746 | (while args | 3746 | (if (= (logand len 1) 1) |
| 3747 | (if (eq (length args) 1) | 3747 | (progn |
| 3748 | (byte-compile-log-warning | 3748 | (byte-compile-log-warning |
| 3749 | (format "missing value for `%S' at end of setq" (car args)) | 3749 | (format "missing value for `%S' at end of setq" (car (last args))) |
| 3750 | nil :error)) | 3750 | nil :error) |
| 3751 | (byte-compile-form (car (cdr args))) | 3751 | (byte-compile-form |
| 3752 | (or byte-compile--for-effect (cdr (cdr args)) | 3752 | `(signal 'wrong-number-of-arguments '(setq ,len)))) |
| 3753 | (byte-compile-out 'byte-dup 0)) | 3753 | (if args |
| 3754 | (byte-compile-variable-set (car args)) | 3754 | (while args |
| 3755 | (setq args (cdr (cdr args)))) | 3755 | (byte-compile-form (car (cdr args))) |
| 3756 | ;; (setq), with no arguments. | 3756 | (or byte-compile--for-effect (cdr (cdr args)) |
| 3757 | (byte-compile-form nil byte-compile--for-effect)) | 3757 | (byte-compile-out 'byte-dup 0)) |
| 3758 | (byte-compile-variable-set (car args)) | ||
| 3759 | (setq args (cdr (cdr args)))) | ||
| 3760 | ;; (setq), with no arguments. | ||
| 3761 | (byte-compile-form nil byte-compile--for-effect))) | ||
| 3758 | (setq byte-compile--for-effect nil))) | 3762 | (setq byte-compile--for-effect nil))) |
| 3759 | 3763 | ||
| 3760 | (defun byte-compile-setq-default (form) | 3764 | (defun byte-compile-setq-default (form) |
diff --git a/lisp/emacs-lisp/cconv.el b/lisp/emacs-lisp/cconv.el index 4a3c273bc84..355913acbed 100644 --- a/lisp/emacs-lisp/cconv.el +++ b/lisp/emacs-lisp/cconv.el | |||
| @@ -473,27 +473,28 @@ places where they originally did not directly appear." | |||
| 473 | :fun-body ,(cconv--convert-function () body env form))) | 473 | :fun-body ,(cconv--convert-function () body env form))) |
| 474 | 474 | ||
| 475 | (`(setq . ,forms) ; setq special form | 475 | (`(setq . ,forms) ; setq special form |
| 476 | (let ((prognlist ())) | 476 | (if (= (logand (length forms) 1) 1) |
| 477 | (while forms | 477 | ;; With an odd number of args, let bytecomp.el handle the error. |
| 478 | (let* ((sym (pop forms)) | 478 | form |
| 479 | (sym-new (or (cdr (assq sym env)) sym)) | 479 | (let ((prognlist ())) |
| 480 | (value-in-list | 480 | (while forms |
| 481 | (and forms | 481 | (let* ((sym (pop forms)) |
| 482 | (list (cconv-convert (pop forms) env extend))))) | 482 | (sym-new (or (cdr (assq sym env)) sym)) |
| 483 | (push (pcase sym-new | 483 | (value (cconv-convert (pop forms) env extend))) |
| 484 | ((pred symbolp) `(setq ,sym-new ,@value-in-list)) | 484 | (push (pcase sym-new |
| 485 | (`(car-safe ,iexp) `(setcar ,iexp ,@value-in-list)) | 485 | ((pred symbolp) `(setq ,sym-new ,value)) |
| 486 | ;; This "should never happen", but for variables which are | 486 | (`(car-safe ,iexp) `(setcar ,iexp ,value)) |
| 487 | ;; mutated+captured+unused, we may end up trying to `setq' | 487 | ;; This "should never happen", but for variables which are |
| 488 | ;; on a closed-over variable, so just drop the setq. | 488 | ;; mutated+captured+unused, we may end up trying to `setq' |
| 489 | (_ ;; (byte-compile-report-error | 489 | ;; on a closed-over variable, so just drop the setq. |
| 490 | ;; (format "Internal error in cconv of (setq %s ..)" | 490 | (_ ;; (byte-compile-report-error |
| 491 | ;; sym-new)) | 491 | ;; (format "Internal error in cconv of (setq %s ..)" |
| 492 | (car value-in-list))) | 492 | ;; sym-new)) |
| 493 | prognlist))) | 493 | value)) |
| 494 | (if (cdr prognlist) | 494 | prognlist))) |
| 495 | `(progn . ,(nreverse prognlist)) | 495 | (if (cdr prognlist) |
| 496 | (car prognlist)))) | 496 | `(progn . ,(nreverse prognlist)) |
| 497 | (car prognlist))))) | ||
| 497 | 498 | ||
| 498 | (`(,(and (or `funcall `apply) callsym) ,fun . ,args) | 499 | (`(,(and (or `funcall `apply) callsym) ,fun . ,args) |
| 499 | ;; These are not special forms but we treat them separately for the needs | 500 | ;; These are not special forms but we treat them separately for the needs |