append.lsp 2.07 KB
Newer Older
1 2 3 4 5 6 7
;-*- Mode:     Lisp -*-
;;;; Author:   Paul Dietz
;;;; Created:  Sat Apr 19 22:36:46 2003
;;;; Contains: Tests of APPEND

(in-package :cl-test)

8
(compile-and-load "cons-aux.lsp")
9 10 11 12 13 14 15 16 17 18 19

(deftest append.1
  (append)
  nil)

(deftest append.2
  (append 'x)
  x)

(deftest append.3
  (let ((x (list 'a 'b 'c 'd))
sds's avatar
sds committed
20
        (y (list 'e 'f 'g)))
21
    (let ((xcopy (make-scaffold-copy x))
sds's avatar
sds committed
22
          (ycopy (make-scaffold-copy y)))
23
      (let ((result (append x y)))
sds's avatar
sds committed
24 25 26 27
        (and
         (check-scaffold-copy x xcopy)
         (check-scaffold-copy y ycopy)
         result))))
28 29 30 31
  (a b c d e f g))

(deftest append.4
  (append (list 'a) (list 'b) (list 'c)
sds's avatar
sds committed
32 33
          (list 'd) (list 'e) (list 'f)
          (list 'g) 'h)
34 35 36 37 38 39 40 41 42 43
  (a b c d e f g . h))

(deftest append.5
  (append nil nil nil nil nil nil nil nil 'a)
  a)

(deftest append.6
  (append-6-body)
  0)

44 45 46 47 48 49
;;; Test suggested by Peter Graves
(deftest append.7
  (let ((x (list 'a 'b 'c 'd)))
    (eq (append x nil) x))
  nil)

50 51 52 53
;;; Compiler macro expansion in correct env

(deftest append.8
  (macrolet ((%m (z) z))
sds's avatar
sds committed
54
            (append (expand-in-current-env (%m '(a b c)))))
55 56 57 58
  (a b c))

(deftest append.9
  (macrolet ((%m (z) z))
sds's avatar
sds committed
59
            (append (expand-in-current-env (%m (list 1 2 3))) (list 4 5 6)))
60 61 62 63
  (1 2 3 4 5 6))

(deftest append.10
  (macrolet ((%m (z) z))
sds's avatar
sds committed
64
            (append (list 1 2 3) (expand-in-current-env (%m (list 4 5 6)))))
65 66
  (1 2 3 4 5 6))

67 68
;;; Order of evaluation tests

69 70 71 72
(deftest append.order.1
  (let ((i 0) x y z)
    (values
     (append (progn (setf x (incf i)) (copy-list '(a b c)))
sds's avatar
sds committed
73 74
             (progn (setf y (incf i)) (copy-list '(d e f)))
             (progn (setf z (incf i)) (copy-list '(g h i))))
75 76 77 78 79 80 81
     i x y z))
  (a b c d e f g h i) 3 1 2 3)

(deftest append.order.2
  (let ((i 0)) (values (append (incf i)) i))
  1 1)

pfdietz's avatar
pfdietz committed
82 83 84 85 86
(def-fold-test append.fold.1 (append '(a b c) nil))
(def-fold-test append.fold.2 (append nil '(x) nil))

;;; Error tests

87
(deftest append.error.1
88
  (signals-error (append '(a . b) '(z))
sds's avatar
sds committed
89
                 type-error)
90
  t)
91 92

(deftest append.error.2
93
  (signals-error (append '(x y z) '(a . b) '(z))
sds's avatar
sds committed
94
                 type-error)
95
  t)