procyberian/emacs
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

Negate only values while constraining variables (bug#45376)

Browse source 
* 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.
This commit is contained in:
Andrea Corallo 2020-12-23 15:51:55 +01:00
parent 0a89ed7a96
commit ffcd490cb4
4 changed files with 40 additions and 4 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

14
lisp/emacs-lisp/comp-cstr.el
View file

@ -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))

2
lisp/emacs-lisp/comp.el
View file

@ -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)

20
test/src/comp-test-funcs.el
View file

@ -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 ;;

8
test/src/comp-tests.el
View file

@ -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 ()