mirrors/emacs
1
Fork 0
mirror of git://git.sv.gnu.org/emacs.git synced 2026-01-03 18:41:25 -08:00
Code Issues Projects Releases Wiki Activity

Fix `=' propagation to handle -0.0 0.0 case

Browse source 
* lisp/emacs-lisp/comp-cstr.el
	(comp-cstr-intersection-homogeneous): Fix indent + use `memql'.
	(comp-cstr-=): Handle 0.0 -0.0 idiosyncrasy
	* test/src/comp-tests.el (comp-tests-type-spec-tests): Add two
	tests and fix enumeration.
This commit is contained in:
Andrea Corallo 2021-03-06 20:38:00 +01:00
parent 552ef6d6c0
commit 05259c4a23
2 changed files with 30 additions and 10 deletions
Download patch file Download diff file Expand all files Collapse all files

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

@ -682,7 +682,7 @@ DST is returned."
;; If (member value) is subtypep of all other sources then
;; is good to be colleted.
when (cl-every (lambda (s)
(or (memq val (valset s))
(or (memql val (valset s))
(cl-some (lambda (type)
(cl-typep val type))
(typeset s))))
@ -890,6 +890,10 @@ Non memoized version of `comp-cstr-intersection-no-mem'."
(cl-return cstr)
finally (setf (valset cstr)
(append vals-to-add (valset cstr))))
(when (memql 0.0 (valset cstr))
(cl-pushnew -0.0 (valset cstr)))
(when (memql -0.0 (valset cstr))
(cl-pushnew 0.0 (valset cstr)))
cstr))
(comp-cstr-intersection dst (relax-cstr op1) (relax-cstr op2)))))

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

@ -1299,32 +1299,48 @@ Return a list of results."
(error "")))
cons)
;; 69
;; 68
((defun comp-tests-ret-type-spec-f (x)
(if (and (floatp x)
(= x 0))
(= x 1))
x
(error "")))
;; Conservative (see cstr relax in `comp-cstr-=').
(or (member 0.0) (integer 0 0)))
(or (member 1.0) (integer 1 1)))
;; 70
;; 69
((defun comp-tests-ret-type-spec-f (x)
(if (and (integer x)
(= x 0))
(= x 1))
x
(error "")))
;; Conservative (see cstr relax in `comp-cstr-=').
(or (member 0.0) (integer 0 0)))
(or (member 1.0) (integer 1 1)))
;; 71
;; 70
((defun comp-tests-ret-type-spec-f (x y)
(if (and (floatp x)
(integerp y)
(= x y))
x
(error "")))
(or float integer))))
(or float integer))
;; 71
((defun comp-tests-ret-type-spec-f (x)
(if (= x 0.0)
x
(error "")))
(or (member -0.0 0.0) (integer 0 0)))
;; 72
((defun comp-tests-ret-type-spec-f (x)
(unless (= x 0.0)
(error ""))
(unless (eql x -0.0)
(error ""))
x)
float)))
(defun comp-tests-define-type-spec-test (number x)
`(comp-deftest ,(intern (format "ret-type-spec-%d" number)) ()