sfos/ecl
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

tests: add a regression test for #605

Browse source
This commit is contained in:
Daniel Kochmański 2020-08-14 16:30:40 +02:00
parent 57f58eaeee
commit b2c9ea8c6e
1 changed files with 57 additions and 31 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

88
src/tests/normal-tests/ansi.lsp
View file

@ -45,41 +45,67 @@
(is-true (typep '* '(nest (3) 3)))
(is-true (typep 3 '(nest (2) 3)))))
;;; 6. Iteration
;;; Regression test for #605.
(test ansi.6.1.1.7-destructuring
(finishes
(loop with (a b) = '(1)
do (return (list a b))))
(finishes
(loop with (a b . rest) = '(1)
do (return (list a b rest))))
(is-equal '(1 nil 2 nil)
(loop with (a b) = '(1)
for (c d) = '(2)
do (return (list a b c d))))
(is-equal '(1 nil 2 nil nil)
(loop with (a b . rest) = '(1)
for (c d) = '(2)
do (return (list a b c d rest))))
(is-equal '(1 2 nil)
(loop for (a (b) ((c))) ='(1 (2))
do (return (list a b c))))
(signals error
(loop for (a (b)) ='(1 2)
do (return (list a b)))))
;;; 8. Structures
(ext:with-clean-symbols
(my-struct make-my-struct my-struct-2 make-my-struct-2 my-struct-compatible-type)
(test ansi.8.redefine-compatible
(let (foo-1 foo-2 foo-3 foo-4)
(defstruct (my-struct (:constructor make-my-struct)) slot-1 slot-2)
(setq foo-1 (make-my-struct :slot-1 3 :slot-2 4))
(finishes (defstruct (my-struct (:constructor make-my-struct))
(slot-1 nil)
(slot-2 t)))
(setq foo-2 (make-my-struct :slot-1 3 :slot-2 4))
(finishes (defstruct (my-struct (:constructor make-my-struct))
(slot-1 3)
(slot-2 4)))
(setq foo-3 (make-my-struct))
(finishes (defstruct (my-struct (:constructor make-my-struct))
(slot-1 8 :type t :read-only nil)
(slot-2 8 :type t :read-only nil)))
(setq foo-4 (make-my-struct :slot-1 3 :slot-2 4))
(is (equalp foo-1 foo-2))
(is (equalp foo-2 foo-3))
(is (equalp foo-3 foo-4)))
(deftype my-struct-compatible-type () `(integer 0 10))
(defstruct (my-struct-2 (:constructor make-my-struct-2))
(slot-1 nil :type my-struct-compatible-type :read-only t))
(finishes
(defstruct my-struct-2
(slot-1 nil :type (integer 0 10) :read-only t)))
(finishes
(defstruct my-struct-2
(slot-1 4 :type (integer 0 10) :read-only t)))
(finishes
(defstruct my-struct-2
(slot-1 4 :type (integer 0 10) :read-only nil)))))
(test ansi.8.redefine-compatible
(let (foo-1 foo-2 foo-3 foo-4)
(defstruct (my-struct (:constructor make-my-struct)) slot-1 slot-2)
(setq foo-1 (make-my-struct :slot-1 3 :slot-2 4))
(finishes (defstruct (my-struct (:constructor make-my-struct))
(slot-1 nil)
(slot-2 t)))
(setq foo-2 (make-my-struct :slot-1 3 :slot-2 4))
(finishes (defstruct (my-struct (:constructor make-my-struct))
(slot-1 3)
(slot-2 4)))
(setq foo-3 (make-my-struct))
(finishes (defstruct (my-struct (:constructor make-my-struct))
(slot-1 8 :type t :read-only nil)
(slot-2 8 :type t :read-only nil)))
(setq foo-4 (make-my-struct :slot-1 3 :slot-2 4))
(is (equalp foo-1 foo-2))
(is (equalp foo-2 foo-3))
(is (equalp foo-3 foo-4)))
(deftype my-struct-compatible-type () `(integer 0 10))
(defstruct (my-struct-2 (:constructor make-my-struct-2))
(slot-1 nil :type my-struct-compatible-type :read-only t))
(finishes
(defstruct my-struct-2
(slot-1 nil :type (integer 0 10) :read-only t)))
(finishes
(defstruct my-struct-2
(slot-1 4 :type (integer 0 10) :read-only t)))
(finishes
(defstruct my-struct-2
(slot-1 4 :type (integer 0 10) :read-only nil)))))
(ext:with-clean-symbols (my-struct make-my-struct)
(test ansi.8.redefine-incompatible