mirrors/emacs
1
Fork 0
mirror of git://git.sv.gnu.org/emacs.git synced 2026-04-28 01:00:52 -07:00
Code Issues Projects Releases Wiki Activity

Fix `comp-cstr-intersection-no-hashcons' for negated result cstr

Browse source 
* lisp/emacs-lisp/comp-cstr.el
	(comp-cstr-intersection-no-hashcons): When negated and
	necessary relax dst to t.
	* test/src/comp-tests.el (comp-tests-type-spec-tests): Add a test.
This commit is contained in:
Andrea Corallo 2021-03-06 22:36:50 +01:00
parent 6c73418c95
commit c60f2f458a
2 changed files with 27 additions and 14 deletions
Download patch file Download diff file Expand all files Collapse all files

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

@ -1001,20 +1001,26 @@ promoted to their types.
DST is returned."
(with-comp-cstr-accessors
(apply #'comp-cstr-intersection dst srcs)
(let (strip-values strip-types)
(cl-loop for v in (valset dst)
unless (or (symbolp v)
(fixnump v))
do (push v strip-values)
(push (type-of v) strip-types))
(when strip-values
(setf (typeset dst) (comp-union-typesets (typeset dst) strip-types)
(valset dst) (cl-set-difference (valset dst) strip-values)))
(cl-loop for (l . h) in (range dst)
when (or (bignump l) (bignump h))
(if (and (neg dst)
(valset dst)
(cl-notevery #'symbolp (valset dst)))
(setf (valset dst) ()
(typeset dst) '(t)
(range dst) ()
(neg dst) nil)
(let (strip-values strip-types)
(cl-loop for v in (valset dst)
unless (symbolp v)
do (push v strip-values)
(push (type-of v) strip-types))
(when strip-values
(setf (typeset dst) (comp-union-typesets (typeset dst) strip-types)
(valset dst) (cl-set-difference (valset dst) strip-values)))
(cl-loop for (l . h) in (range dst)
when (or (bignump l) (bignump h))
do (setf (range dst) '((- . +)))
(cl-return))
dst)))
(cl-return))))
dst))
(defun comp-cstr-intersection-make (&rest srcs)
"Combine SRCS by intersection set operation and return a new constraint."

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

@ -1340,7 +1340,14 @@ Return a list of results."
(unless (eql x -0.0)
(error ""))
x)
float)))
float)
;; 73
((defun comp-tests-ret-type-spec-f (x)
(when (eql x 1.0)
(error ""))
x)
t)))
(defun comp-tests-define-type-spec-test (number x)
`(comp-deftest ,(intern (format "ret-type-spec-%d" number)) ()