mirrors/ecl
1
Fork 0
mirror of https://gitlab.com/embeddable-common-lisp/ecl.git synced 2026-03-07 21:00:39 -08:00
Code Issues Projects Releases Packages Wiki Activity

tests: add tests with regressions curbed from ANSI-TEST

Browse source
This commit is contained in:
Daniel Kochmański 2025-08-27 14:07:39 +02:00
parent 21b5c79b4b
commit 06d9050de0
1 changed files with 62 additions and 0 deletions
Download patch file Download diff file Expand all files Collapse all files

62
src/tests/normal-tests/compiler.lsp
View file

@ -2664,3 +2664,65 @@
(is (typep (cons 1 2) '(cons integer integer)))
(is (not (typep (cons 1 2) '(cons integer float))))
(is (typep (list 1 2 3) '(cons integer t))))
;;; These tests are curbed from ANSI-TEST and revealed a regression.
(deftest cmp.0116.subtypep-cons.ansi-test ()
;; SUBTYPEP.CONS.5
(is-subtypep (t t)
(and cons (not (cons symbol symbol)))
(or (cons (not symbol) *)
(cons * (not symbol))))
;; SUBTYPEP.CONS.12 (test suggested by C.R) - this one is mean!
(is-subtypep (nil t)
(cons (or integer symbol)
(or integer symbol))
(or (cons integer symbol)
(cons symbol integer)))
;; SUBTYPEP.CONS.14 (a -> b, a ==> b)
(is-subtypep (t t)
(and (or (cons (not symbol)) (cons * integer))
(cons symbol))
(cons * integer))
;; SUBTYPEP.CONS.15 (a -> b, not b ==> not a)
(is-subtypep (t t)
(and (or (cons (not symbol)) (cons * integer))
(cons * (not integer)))
(cons (not symbol)))
;; SUBTYPEP.CONS.17
(is-subtypep (t t)
(and (or (cons symbol (cons * *))
(cons * (cons integer *)))
(or (cons * (cons (not integer)))
(cons * (cons * float)))
(or (cons * (cons * (not float)))
(cons symbol (cons * *))))
(cons symbol))
;; SUBTYPEP.CONS.20
(is-subtypep (t t)
(or (cons (eql a) (eql x))
(cons (eql b) (eql y))
(cons (eql a) (eql y))
(cons (eql b) (eql z))
(cons (eql c) (eql x))
(cons (eql a) (eql z))
(cons (eql b) (eql x))
(cons (eql c) (eql y)))
(and (cons (member a b c) (member x y z))
(not (cons (eql c) (eql z)))))
;; SUBTYPEP.CONS.32
(let ((t2 '(cons t
(or (not (cons integer (eql 0)))
(not (cons (or float (eql 0)) cons))))))
(is (eql (subtypep 'cons t2)
(subtypep `(not ,t2) '(not cons))))
;; These two were derived while testing (not really in ansi-test).
(is (not (subtypep 'cons t2)))
(is (subtypep t2 'cons)))
;; Despite sharing leafs, some lists may not be EQL. This is the defining
;; specimen of all MEMBER-related regressions.
(let ((l1 (list 1 2 3))
(l2 (list 1 2 3)))
(multiple-value-bind (yes sure)
(subtypep `(eql ,l1) `(eql ,l2))
(is (and (null yes) sure)
"EQL types of freshly consed lists are SUBTYPEP to each other."))))