Newer
Older
;-*- Mode: Lisp -*-
;;;; Author: Paul Dietz
;;;; Created: Sat Mar 28 07:33:20 1998
;;;; Contains: Tests of ADJOIN
(in-package :cl-test)
(compile-and-load "cons-aux.lsp")
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
(deftest adjoin.1
(adjoin 'a nil)
(a))
(deftest adjoin.2
(adjoin nil nil)
(nil))
(deftest adjoin.3
(adjoin 'a '(a))
(a))
;; Check that a NIL :key argument is the same as no key argument at all
(deftest adjoin.4
(adjoin 'a '(a) :key nil)
(a))
(deftest adjoin.5
(adjoin 'a '(a) :key #'identity)
(a))
(deftest adjoin.6
(adjoin 'a '(a) :key 'identity)
(a))
(deftest adjoin.7
(adjoin (1+ 11) '(4 3 12 2 1))
(4 3 12 2 1))
;; Check that the test is EQL, not EQ (by adjoining a bignum)
(deftest adjoin.8
(adjoin (1+ 999999999999) '(4 1 1000000000000 3816734 a "aa"))
(4 1 1000000000000 3816734 a "aa"))
(deftest adjoin.9
(adjoin (copy-seq "aaa") '(aaa "AAA" "aaa" #\a))
("aaa" aaa "AAA" "aaa" #\a))
(deftest adjoin.10
(adjoin (copy-seq "aaa") '(aaa "AAA" "aaa" #\a) :test #'equal)
(aaa "AAA" "aaa" #\a))
(deftest adjoin.11
(adjoin (copy-seq "aaa") '(aaa "AAA" "aaa" #\a) :test 'equal)
(aaa "AAA" "aaa" #\a))
(deftest adjoin.12
(adjoin (copy-seq "aaa") '(aaa "AAA" "aaa" #\a)
(aaa "AAA" "aaa" #\a))
(deftest adjoin.14
(adjoin (copy-seq "aaa") '(aaa "AAA" "aaa" #\a)
(aaa "AAA" "aaa" #\a))
(deftest adjoin.15
(adjoin (copy-seq "aaa") '(aaa "AAA" "aaa" #\a)
(aaa "AAA" "aaa" #\a))
;; Test that a :key of NIL is the same as no key at all
(deftest adjoin.16
(adjoin (copy-seq "aaa") '(aaa "AAA" "aaa" #\a)
(aaa "AAA" "aaa" #\a))
;; Test that a :key of NIL is the same as no key at all
(deftest adjoin.17
(adjoin (copy-seq "aaa") '(aaa "AAA" "aaa" #\a)
(aaa "AAA" "aaa" #\a))
;; Test that a :key of NIL is the same as no key at all
(deftest adjoin.18
(adjoin (copy-seq "aaa") '(aaa "AAA" "aaa" #\a)
(aaa "AAA" "aaa" #\a))
;;; Ordering in comparison function
(deftest adjoin.19
(adjoin 10 '(1 2 3) :test #'<)
(10 1 2 3))
(deftest adjoin.20
(adjoin 10 '(1 2 3) :test #'>)
(1 2 3))
(deftest adjoin.21
(adjoin 10 '(1 2 3) :test-not #'>)
(10 1 2 3))
(deftest adjoin.22
(adjoin 10 '(1 2 3) :test-not #'<)
(1 2 3))
;;; Test that :key satisfies the description in 17.2.1
;;; This contradicts other parts of the spec, particularly
;;; PUSHNEW, so the test is commented out.
;;; (deftest adjoin.23
;;; (adjoin 1 '(1 2 3) :key '1+)
;;; (1 1 2 3))
(deftest adjoin.24
(macrolet ((%m (z) z))
(values
(adjoin (expand-in-current-env (%m 'a)) '(b c))
(adjoin 'a (expand-in-current-env (%m '(b c))))
(adjoin 'a '(b c) (expand-in-current-env (%m :test)) 'eql)
(adjoin 'a '(a a) (expand-in-current-env (%m :test-not)) 'eql)
(adjoin 'a '(b c) :test (expand-in-current-env (%m 'eql)))
(adjoin 'a '(b c) :test (expand-in-current-env (%m #'eql)))
(adjoin 1 '(1 2 3) :key (expand-in-current-env (%m 'identity)))
))
(a b c)
(a b c)
(a b c)
(a a a)
(a b c)
(a b c)
(1 2 3))
(defharmless adjoin.test-and-test-not.1
(adjoin 'a '(b c) :test #'eql :test-not #'eql))
(defharmless adjoin.test-and-test-not.2
(adjoin 'a '(b c) :test-not #'eql :test #'eql))
(deftest adjoin.order.1
(let ((i 0) w x y z)
(values
(adjoin (progn (setf w (incf i)) 'a)
(progn (setf x (incf i)) '(b c d a e))
:key (progn (setf y (incf i)) #'identity)
:test (progn (setf z (incf i)) #'eql))
i w x y z))
(b c d a e)
4 1 2 3 4)
(deftest adjoin.order.2
(let ((i 0) w x y z p)
(values
(adjoin (progn (setf w (incf i)) 'a)
(progn (setf x (incf i)) '(b c d e))
:test-not (progn (setf y (incf i)) (complement #'eql))
:key (progn (setf z (incf i)) #'identity)
:key (progn (setf p (incf i)) nil))
i w x y z p))
(a b c d e)
5 1 2 3 4 5)
(def-fold-test adjoin.fold.1 (adjoin 'x '(a b c nil d)))
(deftest adjoin.allow-other-keys.1
(adjoin 'a '(b c) :bad t :allow-other-keys t)
(a b c))
(deftest adjoin.allow-other-keys.2
(adjoin 'a '(b c) :allow-other-keys t :foo t)
(a b c))
(deftest adjoin.allow-other-keys.3
(adjoin 'a '(b c) :allow-other-keys t)
(a b c))
(deftest adjoin.allow-other-keys.4
(adjoin 'a '(b c) :allow-other-keys nil)
(a b c))
(deftest adjoin.allow-other-keys.5
(adjoin 'a '(b c) :allow-other-keys t :allow-other-keys nil 'bad t)
(a b c))
(deftest adjoin.repeat-key
(adjoin 'a '(b c) :test #'eq :test (complement #'eq))
(a b c))
(deftest adjoin.error.1
(signals-error (adjoin) program-error)
t)
(deftest adjoin.error.2
(signals-error (adjoin 'a) program-error)
t)
(deftest adjoin.error.3
(signals-error (adjoin 'a '(b c) :bad t) program-error)
t)
(deftest adjoin.error.4
(signals-error (adjoin 'a '(b c) :allow-other-keys nil :bad t) program-error)
t)
(deftest adjoin.error.5
(signals-error (adjoin 'a '(b c) 1 2) program-error)
t)
(deftest adjoin.error.6
(signals-error (adjoin 'a '(b c) :test) program-error)
t)
(deftest adjoin.error.7
(signals-error (adjoin 'a '(b c) :test #'identity) program-error)
t)
(deftest adjoin.error.8
(signals-error (adjoin 'a '(b c) :test-not #'identity) program-error)
t)
(deftest adjoin.error.9
(signals-error (adjoin 'a '(b c) :key #'cons) program-error)
t)
(deftest adjoin.error.10
(signals-error (adjoin 'a (list* 'b 'c 'd)) type-error)
t)