diff options
| author | Andrea Corallo | 2020-12-23 10:46:33 +0100 |
|---|---|---|
| committer | Andrea Corallo | 2020-12-23 10:58:42 +0100 |
| commit | fd8dd75a71eef796ba8fb1d2604fd615bebaae42 (patch) | |
| tree | a1d0e3d81d71e18fee0baa768719d56b2a922ac9 | |
| parent | 2a22fa8b68d18b83b0a20be66b9123454bf7b6e5 (diff) | |
| download | emacs-fd8dd75a71eef796ba8fb1d2604fd615bebaae42.tar.gz emacs-fd8dd75a71eef796ba8fb1d2604fd615bebaae42.zip | |
Make input constraints into memoization hash immutable (bug#45376)
* lisp/emacs-lisp/comp-cstr.el (comp-cstr-union-1)
(comp-cstr-intersection): Copy input before soting it into the
memoization hash table.
| -rw-r--r-- | lisp/emacs-lisp/comp-cstr.el | 4 | ||||
| -rw-r--r-- | test/src/comp-test-funcs.el | 14 | ||||
| -rw-r--r-- | test/src/comp-tests.el | 4 |
3 files changed, 20 insertions, 2 deletions
diff --git a/lisp/emacs-lisp/comp-cstr.el b/lisp/emacs-lisp/comp-cstr.el index aaeb9cf3e9b..480d15616a0 100644 --- a/lisp/emacs-lisp/comp-cstr.el +++ b/lisp/emacs-lisp/comp-cstr.el | |||
| @@ -507,7 +507,7 @@ DST is returned." | |||
| 507 | (comp-cstr-ctxt-union-1-mem-no-range comp-ctxt))) | 507 | (comp-cstr-ctxt-union-1-mem-no-range comp-ctxt))) |
| 508 | (res (or (gethash srcs mem-h) | 508 | (res (or (gethash srcs mem-h) |
| 509 | (puthash | 509 | (puthash |
| 510 | srcs | 510 | (mapcar #'comp-cstr-copy srcs) |
| 511 | (apply #'comp-cstr-union-1-no-mem range srcs) | 511 | (apply #'comp-cstr-union-1-no-mem range srcs) |
| 512 | mem-h)))) | 512 | mem-h)))) |
| 513 | (setf (typeset dst) (typeset res) | 513 | (setf (typeset dst) (typeset res) |
| @@ -676,7 +676,7 @@ DST is returned." | |||
| 676 | (let* ((mem-h (comp-cstr-ctxt-intersection-mem comp-ctxt)) | 676 | (let* ((mem-h (comp-cstr-ctxt-intersection-mem comp-ctxt)) |
| 677 | (res (or (gethash srcs mem-h) | 677 | (res (or (gethash srcs mem-h) |
| 678 | (puthash | 678 | (puthash |
| 679 | srcs | 679 | (mapcar #'comp-cstr-copy srcs) |
| 680 | (apply #'comp-cstr-intersection-no-mem srcs) | 680 | (apply #'comp-cstr-intersection-no-mem srcs) |
| 681 | mem-h)))) | 681 | mem-h)))) |
| 682 | (setf (typeset dst) (typeset res) | 682 | (setf (typeset dst) (typeset res) |
diff --git a/test/src/comp-test-funcs.el b/test/src/comp-test-funcs.el index a2663eaf9cf..d6bcfca2d94 100644 --- a/test/src/comp-test-funcs.el +++ b/test/src/comp-test-funcs.el | |||
| @@ -417,6 +417,20 @@ | |||
| 417 | (setq args (cons (substring arg start pos) args)))) | 417 | (setq args (cons (substring arg start pos) args)))) |
| 418 | args)) | 418 | args)) |
| 419 | 419 | ||
| 420 | (defun comp-test-45376-f () | ||
| 421 | ;; Reduced from `eshell-ls-find-column-lengths'. | ||
| 422 | (let* (res | ||
| 423 | (len 2) | ||
| 424 | (i 0) | ||
| 425 | (j 0)) | ||
| 426 | (while (< j len) | ||
| 427 | (if (= i len) | ||
| 428 | (setq i 0)) | ||
| 429 | (setq res (cons i res) | ||
| 430 | j (1+ j) | ||
| 431 | i (1+ i))) | ||
| 432 | res)) | ||
| 433 | |||
| 420 | 434 | ||
| 421 | ;;;;;;;;;;;;;;;;;;;; | 435 | ;;;;;;;;;;;;;;;;;;;; |
| 422 | ;; Tromey's tests ;; | 436 | ;; Tromey's tests ;; |
diff --git a/test/src/comp-tests.el b/test/src/comp-tests.el index 0594a4e086c..5f2d702fca0 100644 --- a/test/src/comp-tests.el +++ b/test/src/comp-tests.el | |||
| @@ -409,6 +409,10 @@ https://lists.gnu.org/archive/html/bug-gnu-emacs/2020-03/msg00914.html." | |||
| 409 | "Broken call args assumptions lead to infinite loop." | 409 | "Broken call args assumptions lead to infinite loop." |
| 410 | (should (equal (comp-test-assume-in-loop-1-f "cd") '("cd")))) | 410 | (should (equal (comp-test-assume-in-loop-1-f "cd") '("cd")))) |
| 411 | 411 | ||
| 412 | (comp-deftest bug-45376 () | ||
| 413 | "<https://lists.gnu.org/archive/html/bug-gnu-emacs/2020-12/msg01883.html>" | ||
| 414 | (should (equal (comp-test-45376-f) '(1 0)))) | ||
| 415 | |||
| 412 | (defvar comp-test-primitive-advice) | 416 | (defvar comp-test-primitive-advice) |
| 413 | (comp-deftest primitive-advice () | 417 | (comp-deftest primitive-advice () |
| 414 | "Test effectiveness of primitive advicing." | 418 | "Test effectiveness of primitive advicing." |