cons-test-01.lsp 2.84 KB
Newer Older
1 2 3 4 5
;-*- Mode:     Lisp -*-
;;;; Author:   Paul Dietz
;;;; Created:  Sat Mar 28 07:29:48 1998
;;;; Contains: Testing of CL Features related to "CONS", part 1

6

7 8 9

(declaim (optimize (safety 3)))

10

11

12 13 14 15
;;
;; Test the subtype relationships between null, list, cons and atom
;;
(deftest subtypep-null-list
16
  (subtypep* 'null 'list)
17 18 19
  t t)

(deftest subtypep-cons-list
20
  (subtypep* 'cons 'list)
21 22 23
  t t)

(deftest subtypep-null-cons
24
  (subtypep* 'null 'cons)
25 26 27
  nil t)

(deftest subtypep-cons-null
28
  (subtypep* 'cons 'null)
29 30 31
  nil t)

(deftest subtypep-null-atom
32
  (subtypep* 'null 'atom)
33 34 35
  t t)

(deftest subtypep-cons-atom
36
  (subtypep* 'cons 'atom)
37 38 39
  nil t)

(deftest subtypep-atom-cons
40
  (subtypep* 'atom 'cons)
41 42 43
  nil t)

(deftest subtypep-atom-list
44
  (subtypep* 'atom 'list)
45 46 47
  nil t)

(deftest subtypep-list-atom
48
  (subtypep* 'list 'atom)
49 50 51 52 53 54 55
  nil t)

;;
;; Check that the elements of *universe* in type null
;; are those for which the null predice is true.
;;
(deftest null-null-universe
56
  (check-type-predicate 'null 'null)
57
  nil)
58 59

(defvar *cons-fns*
60
  (list 'cons 'consp 'atom 'rplaca 'rplacd
sds's avatar
sds committed
61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105
        'car 'cdr 'caar 'cadr 'cdar 'cddr
        'caaar 'caadr 'cadar 'caddr
        'cdaar 'cdadr 'cddar 'cdddr
        'caaaar 'caaadr 'caadar 'caaddr
        'cadaar 'cadadr 'caddar 'cadddr
        'cdaaar 'cdaadr 'cdadar 'cdaddr
        'cddaar 'cddadr 'cdddar 'cddddr
        'copy-tree 'sublis 'nsublis
        'subst 'subst-if 'subst-if-not
        'nsubst 'nsubst-if 'nsubst-if-not
        'tree-equal
        'copy-list
        'list
        'list*
        'list-length
        'listp
        'make-list
        'first 'second 'third 'fourth
        'fifth 'sixth 'seventh 'eighth 'ninth 'tenth
        'nth
        'endp
        'null
        'nconc
        'append
        'revappend 'nreconc
        'butlast 'nbutlast
        'last 'ldiff 'tailp
        'nthcdr 'rest
        'member 'member-if 'member-if-not
        'mapc 'mapcar 'mapcan 'mapl 'maplist 'mapcon
        'acons
        'assoc 'assoc-if 'assoc-if-not
        'copy-alist
        'pairlis
        'rassoc 'rassoc-if 'rassoc-if-not
        'get-properties
        'getf
        'intersection
        'nintersection
        'adjoin
        'set-difference 'nset-difference
        'set-exclusive-or 'nset-exclusive-or
        'subsetp
        'union 'nunion
        ))
106

107
;; All the cons functions have a function binding
108 109 110 111 112

(deftest function-bound-cons-fns
  (loop
   for x in *cons-fns* count
   (when (or (not (fboundp x))
sds's avatar
sds committed
113
             (not (functionp (symbol-function x))))
114 115
     (format t "~%~S not bound to a function" x)
     t))
116 117 118 119
  0)

;; All the cons-related macros have a macro binding
(deftest macro-bound-cons-macros
120
  (notnot-mv (every #'macro-function
sds's avatar
sds committed
121
                    (list 'push 'pop 'pushnew 'remf)))
122
  t)
123 124 125

;; None of the cons-related functions have macro bindings
(deftest no-cons-fns-are-macros
126
  (some #'macro-function *cons-fns*)
127
  nil)