acons.lsp 1.71 KB
Newer Older
1 2 3 4 5 6 7
;-*- Mode:     Lisp -*-
;;;; Author:   Paul Dietz
;;;; Created:  Sun Apr 20 07:26:48 2003
;;;; Contains: Tests of ACONS

(in-package :cl-test)

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

10 11
(deftest acons.1
  (let* ((x (copy-tree '((c . d) (e . f))))
sds's avatar
sds committed
12 13
         (xcopy (make-scaffold-copy x))
         (result (acons 'a 'b x)))
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
    (and
     (check-scaffold-copy x xcopy)
     (eqt (cdr result) x)
     result))
  ((a . b) (c . d) (e . f)))

(deftest acons.2
  (acons 'a 'b nil)
  ((a . b)))

(deftest acons.3
  (acons 'a 'b 'c)
  ((a . b) . c))

(deftest acons.4
  (acons '((a b)) '(((c d) e) f) '((1 . 2)))
  (( ((a b)) . (((c d) e) f)) (1 . 2)))

(deftest acons.5
  (acons "ancd" 1.143 nil)
  (("ancd" . 1.143)))

(deftest acons.6
  (acons #\R :foo :bar)
  ((#\R . :foo) . :bar))

40 41 42 43 44 45 46 47 48 49 50 51
(deftest acons.7
  (macrolet ((%m (z) z)) (acons (expand-in-current-env (%m 'a)) 'b '(c)))
  ((a . b) c))

(deftest acons.8
  (macrolet ((%m (z) z)) (acons 'a (expand-in-current-env (%m 'b)) '(c)))
  ((a . b) c))

(deftest acons.9
  (macrolet ((%m (z) z)) (acons 'a 'b (expand-in-current-env (%m '(c)))))
  ((a . b) c))

52 53 54 55
(deftest acons.order.1
  (let ((i 0) x y z)
    (values
     (acons (progn (setf x (incf i)) 'a)
sds's avatar
sds committed
56 57
            (progn (setf y (incf i)) 'b)
            (progn (setf z (incf i)) '((c . d))))
58 59 60 61
     i x y z))
  ((a . b)(c . d))
  3 1 2 3)

pfdietz's avatar
pfdietz committed
62 63 64 65 66
(def-fold-test acons.fold.1 (acons 'x 'y nil))
(def-fold-test acons.fold.2 (acons 1 2 '((3 . 4) (5 . 6))))

;;; Error tests

67
(deftest acons.error.1
68 69
  (signals-error (acons) program-error)
  t)
70 71

(deftest acons.error.2
72 73
  (signals-error (acons 'a) program-error)
  t)
74 75

(deftest acons.error.3
76 77
  (signals-error (acons 'a 'b) program-error)
  t)
78 79

(deftest acons.error.4
80 81
  (signals-error (acons 'a 'b 'c 'd) program-error)
  t)