[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
feature/native-comp ffcd490 5/5: Negate only values while constraining v
From: |
Andrea Corallo |
Subject: |
feature/native-comp ffcd490 5/5: Negate only values while constraining variables (bug#45376) |
Date: |
Wed, 23 Dec 2020 10:23:22 -0500 (EST) |
branch: feature/native-comp
commit ffcd490cb49ba86d625288ea425d98e8cac22a05
Author: Andrea Corallo <akrl@sdf.org>
Commit: Andrea Corallo <akrl@sdf.org>
Negate only values while constraining variables (bug#45376)
* lisp/emacs-lisp/comp-cstr.el (comp-cstr-value-negation): New
function.
* lisp/emacs-lisp/comp.el (comp-fwprop-insn): Use
`comp-cstr-value-negation'.
* test/src/comp-test-funcs.el (comp-test-45376-1-f): Rename.
(comp-test-45376-2-f): New funcion.
* test/src/comp-tests.el (bug-45376-1): Rename test.
(bug-45376-2): Add test.
---
lisp/emacs-lisp/comp-cstr.el | 14 ++++++++++++++
lisp/emacs-lisp/comp.el | 2 +-
test/src/comp-test-funcs.el | 20 +++++++++++++++++++-
test/src/comp-tests.el | 8 ++++++--
4 files changed, 40 insertions(+), 4 deletions(-)
diff --git a/lisp/emacs-lisp/comp-cstr.el b/lisp/emacs-lisp/comp-cstr.el
index 92c981f..8b5639c 100644
--- a/lisp/emacs-lisp/comp-cstr.el
+++ b/lisp/emacs-lisp/comp-cstr.el
@@ -701,6 +701,20 @@ DST is returned."
(neg dst) (not (neg src)))
dst))
+(defun comp-cstr-value-negation (dst src)
+ "Negate values in SRC setting the result in DST.
+DST is returned."
+ (with-comp-cstr-accessors
+ (if (or (valset src) (range src))
+ (setf (typeset dst) ()
+ (valset dst) (valset src)
+ (range dst) (range src)
+ (neg dst) (not (neg src)))
+ (setf (typeset dst) (typeset src)
+ (valset dst) ()
+ (range dst) ()))
+ dst))
+
(defun comp-cstr-negation-make (src)
"Negate SRC and return a new constraint."
(comp-cstr-negation (make-comp-cstr) src))
diff --git a/lisp/emacs-lisp/comp.el b/lisp/emacs-lisp/comp.el
index 485e5dc..6ed50dc 100644
--- a/lisp/emacs-lisp/comp.el
+++ b/lisp/emacs-lisp/comp.el
@@ -2534,7 +2534,7 @@ Fold the call in case."
(not
;; Prevent double negation!
(unless (comp-cstr-neg (car operands))
- (comp-cstr-negation lval (car operands))))))
+ (comp-cstr-value-negation lval (car operands))))))
(`(setimm ,lval ,v)
(setf (comp-mvar-value lval) v))
(`(phi ,lval . ,rest)
diff --git a/test/src/comp-test-funcs.el b/test/src/comp-test-funcs.el
index d6bcfca..7731e65 100644
--- a/test/src/comp-test-funcs.el
+++ b/test/src/comp-test-funcs.el
@@ -417,7 +417,7 @@
(setq args (cons (substring arg start pos) args))))
args))
-(defun comp-test-45376-f ()
+(defun comp-test-45376-1-f ()
;; Reduced from `eshell-ls-find-column-lengths'.
(let* (res
(len 2)
@@ -431,6 +431,24 @@
i (1+ i)))
res))
+(defun comp-test-45376-2-f ()
+ ;; Also reduced from `eshell-ls-find-column-lengths'.
+ (let* ((x 1)
+ res)
+ (while x
+ (let* ((y 4)
+ (i 0))
+ (while (> y 0)
+ (when (= i x)
+ (setq i 0))
+ (setf res (cons i res))
+ (setq y (1- y)
+ i (1+ i)))
+ (if (>= x 3)
+ (setq x nil)
+ (setq x (1+ x)))))
+ res))
+
;;;;;;;;;;;;;;;;;;;;
;; Tromey's tests ;;
diff --git a/test/src/comp-tests.el b/test/src/comp-tests.el
index 5f2d702..e0d4bf8 100644
--- a/test/src/comp-tests.el
+++ b/test/src/comp-tests.el
@@ -409,9 +409,13 @@
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 ()
+(comp-deftest bug-45376-1 ()
"<https://lists.gnu.org/archive/html/bug-gnu-emacs/2020-12/msg01883.html>"
- (should (equal (comp-test-45376-f) '(1 0))))
+ (should (equal (comp-test-45376-1-f) '(1 0))))
+
+(comp-deftest bug-45376-2 ()
+ "<https://lists.gnu.org/archive/html/bug-gnu-emacs/2020-12/msg01883.html>"
+ (should (equal (comp-test-45376-2-f) '(0 2 1 0 1 0 1 0 0 0 0 0))))
(defvar comp-test-primitive-advice)
(comp-deftest primitive-advice ()