diff --git a/etc/NEWS b/etc/NEWS index 3bef9d2ed2a..7d033b0b13e 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -509,6 +509,26 @@ simplified away. This warning can be suppressed using 'with-suppressed-warnings' with the warning name 'suspicious'. +--- +*** Warn about mutation of constant values. +The compiler now warns about code that modifies program constants in +some obvious cases. Examples: + + (setcar '(1 2) 7) + (aset [3 4] 0 8) + (aset "abc" 1 ?d) + +Such code may have unpredictable behaviour because the constants are +part of the program, not data structures generated afresh during +execution, and the compiler does not expect them to change. + +To avoid the warning, operate on an object created by the program +(maybe a copy of the constant), or use a non-destructive operation +instead. + +This warning can be suppressed using 'with-suppressed-warnings' with +the warning name 'suspicious'. + --- *** Warn about more ignored function return values. The compiler now warns when the return value from certain functions is diff --git a/lisp/emacs-lisp/bytecomp.el b/lisp/emacs-lisp/bytecomp.el index 6c804056ee7..d17f1c93a76 100644 --- a/lisp/emacs-lisp/bytecomp.el +++ b/lisp/emacs-lisp/bytecomp.el @@ -3488,6 +3488,22 @@ lambda-expression." (format-message "; use `%s' instead." interactive-only)) (t ".")))) + (let ((mutargs (function-get (car form) 'mutates-arguments))) + (when mutargs + (dolist (idx (if (eq mutargs 'all-but-last) + (number-sequence 1 (- (length form) 2)) + mutargs)) + (let ((arg (nth idx form))) + (when (and (or (and (eq (car-safe arg) 'quote) + (consp (nth 1 arg))) + (arrayp arg)) + (byte-compile-warning-enabled-p + 'suspicious (car form))) + (byte-compile-warn-x form "`%s' on constant %s (arg %d)" + (car form) + (if (consp arg) "list" (type-of arg)) + idx)))))) + (if (eq (car-safe (symbol-function (car form))) 'macro) (byte-compile-report-error (format-message "`%s' defined after use in %S (missing `require' of a library file?)" @@ -3557,6 +3573,43 @@ lambda-expression." (dolist (fn important-return-value-fns) (put fn 'important-return-value t))) +(let ((mutating-fns + ;; FIXME: Should there be a function declaration for this? + ;; + ;; (FUNC . ARGS) means that FUNC mutates arguments whose indices are + ;; in the list ARGS, starting at 1, or all but the last argument if + ;; ARGS is `all-but-last'. + '( + (setcar 1) (setcdr 1) (aset 1) + (nreverse 1) + (nconc . all-but-last) + (nbutlast 1) (ntake 2) + (sort 1) + (delq 2) (delete 2) + (delete-dups 1) (delete-consecutive-dups 1) + (plist-put 1) + (fillarray 1) + (store-substring 1) + (clear-string 1) + + (add-text-properties 4) (put-text-property 5) (set-text-properties 4) + (remove-text-properties 4) (remove-list-of-text-properties 4) + (alter-text-property 5) + (add-face-text-property 5) (add-display-text-property 5) + + (cl-delete 2) (cl-delete-if 2) (cl-delete-if-not 2) + (cl-delete-duplicates 1) + (cl-nsubst 3) (cl-nsubst-if 3) (cl-nsubst-if-not 3) + (cl-nsubstitute 3) (cl-nsubstitute-if 3) (cl-nsubstitute-if-not 3) + (cl-nsublis 2) + (cl-nunion 1 2) (cl-nintersection 1 2) (cl-nset-difference 1 2) + (cl-nset-exclusive-or 1 2) + (cl-nreconc 1) + (cl-sort 1) (cl-stable-sort 1) (cl-merge 2 3) + ))) + (dolist (entry mutating-fns) + (put (car entry) 'mutates-arguments (cdr entry)))) + (defun byte-compile-normal-call (form) (when (and (symbolp (car form)) diff --git a/test/lisp/emacs-lisp/bytecomp-tests.el b/test/lisp/emacs-lisp/bytecomp-tests.el index 222065c2e4e..9136a6cd9b3 100644 --- a/test/lisp/emacs-lisp/bytecomp-tests.el +++ b/test/lisp/emacs-lisp/bytecomp-tests.el @@ -1518,6 +1518,36 @@ literals (Bug#20852)." )) '((empty-body with-suppressed-warnings)) "Warning: `with-suppressed-warnings' with empty body") + + (test-suppression + '(defun zot () + (setcar '(1 2) 3)) + '((suspicious setcar)) + "Warning: `setcar' on constant list (arg 1)") + + (test-suppression + '(defun zot () + (aset [1 2] 1 3)) + '((suspicious aset)) + "Warning: `aset' on constant vector (arg 1)") + + (test-suppression + '(defun zot () + (aset "abc" 1 ?d)) + '((suspicious aset)) + "Warning: `aset' on constant string (arg 1)") + + (test-suppression + '(defun zot (x y) + (nconc x y '(1 2) '(3 4))) + '((suspicious nconc)) + "Warning: `nconc' on constant list (arg 3)") + + (test-suppression + '(defun zot () + (put-text-property 0 2 'prop 'val "abc")) + '((suspicious put-text-property)) + "Warning: `put-text-property' on constant string (arg 5)") ) (ert-deftest bytecomp-tests--not-writable-directory ()