get-properties.lsp 2.34 KB
Newer Older
1 2 3 4 5 6 7
;-*- Mode:     Lisp -*-
;;;; Author:   Paul Dietz
;;;; Created:  Sun Apr 20 07:37:00 2003
;;;; Contains: Tests of GET-PROPERTIES

(in-package :cl-test)

8 9
(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
(deftest get-properties.1
  (get-properties nil nil)
  nil nil nil)

(deftest get-properties.2
  (get-properties '(a b) nil)
  nil nil nil)

(deftest get-properties.3
  (get-properties '(a b c d) '(a))
  a b (a b c d))

(deftest get-properties.4
  (get-properties '(a b c d) '(c))
  c d (c d))

(deftest get-properties.5
  (get-properties '(a b c d) '(c a))
  a b (a b c d))

(deftest get-properties.6
  (get-properties '(a b c d) '(b))
  nil nil nil)

(deftest get-properties.7
  (get-properties '("aa" b c d) (list (copy-seq "aa")))
  nil nil nil)

pfdietz's avatar
pfdietz committed
38 39 40 41 42 43
;;; I removed the next test (noticed by Duane Rettig) because
;;; the non-eqness of numbers may not be necesarily preserved.
;;; The standard says numbers may be copied at any time, and
;;; this might mean eql numbers are copied to a canonical eq
;;; value
#|
44 45 46
(deftest get-properties.8
  (get-properties '(1000000000000 b c d) (list (1+ 999999999999)))
  nil nil nil)
pfdietz's avatar
pfdietz committed
47
|#
48 49 50

(deftest get-properties.9
  (let* ((x (copy-list '(a b c d e f g h a c)))
sds's avatar
sds committed
51 52 53
         (xcopy (make-scaffold-copy x))
         (y (copy-list '(x y f g)))
         (ycopy (make-scaffold-copy y)))
54
    (multiple-value-bind
sds's avatar
sds committed
55 56
        (indicator value tail)
        (get-properties x y)
57 58 59 60 61 62 63 64 65 66 67 68
      (and
       (check-scaffold-copy x xcopy)
       (check-scaffold-copy y ycopy)
       (eqt tail (nthcdr 6 x))
       (values indicator value tail))))
  g h (g h a c))

(deftest get-properties.order.1
  (let ((i 0) x y)
    (values
     (multiple-value-list
      (get-properties (progn (setf x (incf i)) '(a b c d))
sds's avatar
sds committed
69
                      (progn (setf y (incf i)) '(c))))
70 71 72 73
     i x y))
  (c d (c d)) 2 1 2)

(deftest get-properties.error.1
74 75
  (signals-error (get-properties) program-error)
  t)
76 77

(deftest get-properties.error.2
78 79
  (signals-error (get-properties nil) program-error)
  t)
80 81

(deftest get-properties.error.3
82 83
  (signals-error (get-properties nil nil nil) program-error)
  t)
84 85

(deftest get-properties.error.4
86 87
  (signals-error (get-properties '(a 1 b 2 c 3) '(x . y)) type-error)
  t)
88 89

(deftest get-properties.error.5
90 91
  (signals-error (get-properties '(a 1 b 2 c 3 . d) '(x y)) type-error)
  t)
92 93

(deftest get-properties.error.6
94 95
  (signals-error (get-properties '(a 1 b 2 c . d) '(x y)) type-error)
  t)