+
+(multiple-value-bind (result error)
+ (ignore-errors (apply #'butlast (list t)))
+ (assert (null result))
+ (assert (typep error 'type-error)))
+
+;;; reported by Paul Dietz on cmucl-imp: LDIFF does not check type of
+;;; its first argument
+(assert (not (ignore-errors (ldiff 1 2))))
+
+;;; evaluation order in PUSH, PUSHNEW
+(let ((a (map 'vector #'list '(a b c))))
+ (let ((i 0))
+ (pushnew (incf i) (aref a (incf i)))
+ (assert (equalp a #((a) (b) (1 c))))))
+
+(symbol-macrolet ((s (aref a (incf i))))
+ (let ((a (map 'vector #'list '(a b c))))
+ (let ((i 0))
+ (push t s)
+ (assert (equalp a #((a) (t b) (c))))
+ (pushnew 1 s)
+ (assert (equalp a #((a) (t b) (1 c))))
+ (setq i 0)
+ (assert (eql (pop s) 't))
+ (assert (equalp a #((a) (b) (1 c)))))))
+
+;;; Type checking in NCONC
+(let ((tests '((((1 . 2)) (1 . 2))
+ (((1 . 2) (3 . 4)) (1 3 . 4))
+ (((1 . 2) 3) (1 . 3))
+ ((3) 3))))
+ (loop for (args result) in tests
+ do (assert (equal (apply 'nconc (copy-tree args)) result))
+ do (let ((exp `(nconc ,@ (mapcar (lambda (arg)
+ `',(copy-tree arg))
+ args))))
+ (assert (equal (funcall (compile nil `(lambda () ,exp))) result)))))
+
+(let ((tests '(((3 (1 . 2)) 3)
+ (((1 . 2) 3 (4 . 5)) 3))))
+ (macrolet ((check-error (form failed-arg)
+ `(multiple-value-bind (.result. .error.)
+ (ignore-errors ,form)
+ (assert (null .result.))
+ (assert (typep .error. 'type-error))
+ (assert (eq (type-error-expected-type .error.) 'list))
+ (assert (equal (type-error-datum .error.) ,failed-arg)))))
+ (loop for (args fail) in tests
+ do (check-error (apply #'nconc (copy-tree args)) fail)
+ do (let ((exp `(nconc ,@ (mapcar (lambda (arg)
+ `',(copy-tree arg))
+ args))))
+ (check-error (funcall (compile nil `(lambda () ,exp))) fail)))))
+
+(dolist (test '((append 1 2)
+ (append (1 2) nil (3 . 4) nil)
+ (append nil (1 2) nil (3 . 4) nil)
+ (reverse (1 2 . 3))
+ (nreverse (1 2 . 3))
+ (nreconc (1 2 . 3) (4 5))))
+ (assert (raises-error? (apply (first test) (copy-tree (rest test))) type-error)))