get.lsp 2.41 KB
Newer Older
pfdietz's avatar
pfdietz committed
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27
;-*- Mode:     Lisp -*-
;;;; Author:   Paul Dietz
;;;; Created:  Tue Jul 13 07:01:47 2004
;;;; Contains: Tests of GET

(in-package :cl-test)

(deftest get.1
  (let ((sym (gensym))) (get sym :foo))
  nil)

(deftest get.2
  (let ((sym (gensym))) (get sym :foo :bar))
  :bar)

(deftest get.3
  (let ((sym (gensym))) (get sym :foo (values :bar nil)))
  :bar)

(deftest get.4
  (let ((sym (gensym)))
    (setf (symbol-plist sym) (list :foo 1 :bar 2 :foo 3))
    (values (get sym :foo) (get sym :bar)))
  1 2)

(deftest get.5
  (let ((evaluated nil)
sds's avatar
sds committed
28
        (sym (gensym)))
pfdietz's avatar
pfdietz committed
29
    (assert (equal (multiple-value-list (setf (get sym :foo) 1))
sds's avatar
sds committed
30
                   '(1)))
pfdietz's avatar
pfdietz committed
31 32 33 34 35 36 37
    (values
     (get sym :foo (progn (setf evaluated t) nil))
     evaluated))
  1 t)

(deftest get.6
  (let ((evaluated nil)
sds's avatar
sds committed
38
        (sym (gensym)))
pfdietz's avatar
pfdietz committed
39
    (assert (equal (multiple-value-list
sds's avatar
sds committed
40 41 42 43
                    (setf (get sym :foo
                               (progn (setf evaluated t) nil))
                          1))
                   '(1)))
pfdietz's avatar
pfdietz committed
44 45 46 47 48
    (values
     (get sym :foo)
     evaluated))
  1 t)

49 50 51 52 53 54 55
;;; Order of evaluation

(deftest get.order.1
  (let (a b (i 0) (sym (gensym)))
    (setf (get sym :foo) t)
    (values
     (get (progn (setf a (incf i)) sym)
sds's avatar
sds committed
56
          (progn (setf b (incf i)) :foo))
57 58 59 60 61 62 63
     a b i))
  t 1 2 2)

(deftest get.order.2
  (let (a b (i 0) (sym (gensym)))
    (values
     (setf (get (progn (setf a (incf i)) sym)
sds's avatar
sds committed
64 65
                (progn (setf b (incf i)) :foo))
           t)
66 67 68 69 70 71 72 73 74 75
     a b i
     (get sym :foo)
     ))
  t 1 2 2 t)

(deftest get.order.3
  (let (a b c (i 0) (sym (gensym)))
    (setf (get sym :foo) t)
    (values
     (get (progn (setf a (incf i)) sym)
sds's avatar
sds committed
76 77
          (progn (setf b (incf i)) :foo)
          (progn (setf c (incf i)) nil))
78 79 80 81 82 83 84
     a b c i))
  t 1 2 3 3)

(deftest get.order.4
  (let (a b c (i 0) (sym (gensym)))
    (values
     (setf (get (progn (setf a (incf i)) sym)
sds's avatar
sds committed
85 86 87
                (progn (setf b (incf i)) :foo)
                (progn (setf c (incf i)) nil))
           t)
88 89 90 91 92
     a b c i
     (get sym :foo)
     ))
  t 1 2 3 3 t)

pfdietz's avatar
pfdietz committed
93 94 95 96 97 98 99 100 101 102 103 104 105 106 107
;;; Error tests

(deftest get.error.1
  (signals-error (get) program-error)
  t)

(deftest get.error.2
  (signals-error (get nil) program-error)
  t)

(deftest get.error.3
  (signals-error (get nil nil nil nil) program-error)
  t)

(deftest get.error.4
108
  (check-type-error #'(lambda (x) (get x :foo)) #'symbolp)
pfdietz's avatar
pfdietz committed
109 110 111
  nil)

(deftest get.error.5
112
  (check-type-error #'(lambda (x) (setf (get x :foo) nil)) #'symbolp)
pfdietz's avatar
pfdietz committed
113
  nil)