From 3f00d666e9674ba18f1ded490a27ac2868a32a88 Mon Sep 17 00:00:00 2001 From: Andrea Corallo Date: Tue, 29 Dec 2020 17:39:15 +0100 Subject: [PATCH] Fix missing negation handling in a bunch of predicates * lisp/emacs-lisp/comp.el (comp-mvar-fixnum-p) (comp-mvar-symbol-p, comp-mvar-cons-p): Consider neg slot. * test/src/comp-tests.el (comp-test-not-cons): New test. * test/src/comp-test-funcs.el (comp-test-not-cons-f): New function. --- lisp/emacs-lisp/comp.el | 21 +++++++++++++-------- test/src/comp-test-funcs.el | 6 ++++++ test/src/comp-tests.el | 3 +++ 3 files changed, 22 insertions(+), 8 deletions(-) diff --git a/lisp/emacs-lisp/comp.el b/lisp/emacs-lisp/comp.el index b885ff88411..bf266256f70 100644 --- a/lisp/emacs-lisp/comp.el +++ b/lisp/emacs-lisp/comp.el @@ -538,6 +538,8 @@ CFG is mutated by a pass.") (integerp high) (= low high)))))))) +;; FIXME move these into cstr? + (defun comp-mvar-value (mvar) "Return the constant value of MVAR. `comp-mvar-value-vld-p' *must* be satisfied before calling @@ -556,18 +558,20 @@ CFG is mutated by a pass.") (defun comp-mvar-fixnum-p (mvar) "Return t if MVAR is certainly a fixnum." - (when-let (range (comp-mvar-range mvar)) - (let* ((low (caar range)) - (high (cdar (last range)))) - (unless (or (eq low '-) - (< low most-negative-fixnum) - (eq high '+) - (> high most-positive-fixnum)) - t)))) + (when (null (comp-mvar-neg mvar)) + (when-let (range (comp-mvar-range mvar)) + (let* ((low (caar range)) + (high (cdar (last range)))) + (unless (or (eq low '-) + (< low most-negative-fixnum) + (eq high '+) + (> high most-positive-fixnum)) + t))))) (defun comp-mvar-symbol-p (mvar) "Return t if MVAR is certainly a symbol." (and (null (comp-mvar-range mvar)) + (null (comp-mvar-neg mvar)) (or (and (null (comp-mvar-valset mvar)) (equal (comp-mvar-typeset mvar) '(symbol))) (and (or (null (comp-mvar-typeset mvar)) @@ -578,6 +582,7 @@ CFG is mutated by a pass.") "Return t if MVAR is certainly a cons." (and (null (comp-mvar-valset mvar)) (null (comp-mvar-range mvar)) + (null (comp-mvar-neg mvar)) (equal (comp-mvar-typeset mvar) '(cons)))) (defun comp-mvar-type-hint-match-p (mvar type-hint) diff --git a/test/src/comp-test-funcs.el b/test/src/comp-test-funcs.el index 7731e6547b1..49e80763bee 100644 --- a/test/src/comp-test-funcs.el +++ b/test/src/comp-test-funcs.el @@ -449,6 +449,12 @@ (setq x (1+ x))))) res)) +(defun comp-test-not-cons-f (x) + ;; Reduced from `cl-copy-list'. + (if (consp x) + (print x) + (car x))) + ;;;;;;;;;;;;;;;;;;;; ;; Tromey's tests ;; diff --git a/test/src/comp-tests.el b/test/src/comp-tests.el index 240af102ec4..4546eccb622 100644 --- a/test/src/comp-tests.el +++ b/test/src/comp-tests.el @@ -479,6 +479,9 @@ https://lists.gnu.org/archive/html/bug-gnu-emacs/2020-03/msg00914.html." "Check cond-rw does not break target blocks with multiple predecessor." (should (null (comp-test-cond-rw-1-2-f)))) +(comp-deftest comp-test-not-cons () + (should-not (comp-test-not-cons-f nil))) + ;;;;;;;;;;;;;;;;;;;;; ;; Tromey's tests. ;; -- 2.39.5