[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
feature/native-comp fd8dd75 2/5: Make input constraints into memoization
From: |
Andrea Corallo |
Subject: |
feature/native-comp fd8dd75 2/5: Make input constraints into memoization hash immutable (bug#45376) |
Date: |
Wed, 23 Dec 2020 10:23:20 -0500 (EST) |
branch: feature/native-comp
commit fd8dd75a71eef796ba8fb1d2604fd615bebaae42
Author: Andrea Corallo <akrl@sdf.org>
Commit: Andrea Corallo <akrl@sdf.org>
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.
---
lisp/emacs-lisp/comp-cstr.el | 4 ++--
test/src/comp-test-funcs.el | 14 ++++++++++++++
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 aaeb9cf..480d156 100644
--- a/lisp/emacs-lisp/comp-cstr.el
+++ b/lisp/emacs-lisp/comp-cstr.el
@@ -507,7 +507,7 @@ DST is returned."
(comp-cstr-ctxt-union-1-mem-no-range comp-ctxt)))
(res (or (gethash srcs mem-h)
(puthash
- srcs
+ (mapcar #'comp-cstr-copy srcs)
(apply #'comp-cstr-union-1-no-mem range srcs)
mem-h))))
(setf (typeset dst) (typeset res)
@@ -676,7 +676,7 @@ DST is returned."
(let* ((mem-h (comp-cstr-ctxt-intersection-mem comp-ctxt))
(res (or (gethash srcs mem-h)
(puthash
- srcs
+ (mapcar #'comp-cstr-copy srcs)
(apply #'comp-cstr-intersection-no-mem srcs)
mem-h))))
(setf (typeset dst) (typeset res)
diff --git a/test/src/comp-test-funcs.el b/test/src/comp-test-funcs.el
index a2663ea..d6bcfca 100644
--- a/test/src/comp-test-funcs.el
+++ b/test/src/comp-test-funcs.el
@@ -417,6 +417,20 @@
(setq args (cons (substring arg start pos) args))))
args))
+(defun comp-test-45376-f ()
+ ;; Reduced from `eshell-ls-find-column-lengths'.
+ (let* (res
+ (len 2)
+ (i 0)
+ (j 0))
+ (while (< j len)
+ (if (= i len)
+ (setq i 0))
+ (setq res (cons i res)
+ j (1+ j)
+ i (1+ i)))
+ res))
+
;;;;;;;;;;;;;;;;;;;;
;; Tromey's tests ;;
diff --git a/test/src/comp-tests.el b/test/src/comp-tests.el
index 0594a4e..5f2d702 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."
"Broken call args assumptions lead to infinite loop."
(should (equal (comp-test-assume-in-loop-1-f "cd") '("cd"))))
+(comp-deftest bug-45376 ()
+ "<https://lists.gnu.org/archive/html/bug-gnu-emacs/2020-12/msg01883.html>"
+ (should (equal (comp-test-45376-f) '(1 0))))
+
(defvar comp-test-primitive-advice)
(comp-deftest primitive-advice ()
"Test effectiveness of primitive advicing."