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)