rplacd.lsp 1.01 KB
Newer Older
1 2 3 4 5 6 7
;-*- Mode:     Lisp -*-
;;;; Author:   Paul Dietz
;;;; Created:  Sat Apr 19 21:30:28 2003
;;;; Contains: Tests of RPLACD

(in-package :cl-test)

8 9
(compile-and-load "cons-aux.lsp")

10 11 12 13
(deftest rplacd.1
  (let ((x (cons 'a 'b)))
    (let ((y x))
      (and (eqt (rplacd x 'd) y)
sds's avatar
sds committed
14 15 16
           (eqt x y)
           (eqt (car x) 'a)
           (eqt (cdr x) 'd))))
17 18 19 20
  t)

(deftest rplacd.order.1
  (let ((x (cons 'a 'b))
sds's avatar
sds committed
21
        (i 0) a b)
22 23
    (values
     (rplacd (progn (setf a (incf i)) x)
sds's avatar
sds committed
24
             (progn (setf b (incf i)) 'c))
25 26 27
     i a b))
  (a . c) 2 1 2)

pfdietz's avatar
pfdietz committed
28
;; rplacd on a non-cons is a type error
29
(deftest rplacd.error.1
30
  (check-type-error #'(lambda (x) (rplacd x 1)) #'consp)
31 32 33
  nil)

(deftest rplacd.error.2
34 35
  (signals-error (rplacd) program-error)
  t)
36 37

(deftest rplacd.error.3
38 39
  (signals-error (rplacd (cons 'a 'b)) program-error)
  t)
40 41

(deftest rplacd.error.4
42 43
  (signals-error (rplacd (cons 'a 'b) (cons 'c 'd) 'garbage) program-error)
  t)
44 45

(deftest rplacd.error.6
46 47
  (signals-error (locally (rplacd 'a 1) t) type-error)
  t)
48