copy-symbol.lsp 2.49 KB
Newer Older
1 2 3 4 5 6 7 8 9 10 11
;-*- Mode:     Lisp -*-
;;;; Author:   Paul Dietz
;;;; Created:  Sat Jun 14 05:44:41 2003
;;;; Contains: Tests of COPY-SYMBOL

(in-package :cl-test)

(deftest copy-symbol.1
  (notnot-mv
   (every
    #'(lambda (x)
sds's avatar
sds committed
12 13 14 15 16 17 18 19 20
        (let ((y (copy-symbol x)))
          (and (null (symbol-plist y))
               (symbolp y)
               (not (boundp y))
               (not (fboundp y))
               (null (symbol-package y))
               (string= (symbol-name x) (symbol-name y))
               (symbolp (copy-symbol y))
               )))
21 22 23 24 25 26 27 28 29 30
    '(nil t a b |a| |123|)))
  t)

(deftest copy-symbol.2
  (progn
    (setf (symbol-plist '|foo|) '(a b c d))
    (makunbound '|foo|)
    (notnot-mv
     (every
      #'(lambda (x)
sds's avatar
sds committed
31 32 33 34 35 36 37 38 39 40 41
          (let ((y (copy-symbol x t)))
            (and
             (equal (symbol-plist y) (symbol-plist x))
             (symbolp y)
             (if (boundp x)
                 (boundp y)
               (not (boundp y)))
             (if (fboundp x) (fboundp y) (not (fboundp y)))
             (null (symbol-package y))
             (string= (symbol-name x) (symbol-name y))
             )))
42 43 44 45 46 47 48 49 50 51
      '(nil t a b |foo| |a| |123|))))
  t)

(deftest copy-symbol.3
  (progn
    (setf (symbol-plist '|foo|) '(a b c d))
    (setf (symbol-value '|a|) 12345)
    (notnot-mv
     (every
      #'(lambda (x)
sds's avatar
sds committed
52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68
          (let ((y (copy-symbol x t)))
            (and
             (eql (length (symbol-plist y))
                  (length (symbol-plist x)))
             ;; Is a list copy
             (every #'eq (symbol-plist y) (symbol-plist x))
             (symbolp y)
             (if (boundp x)
                 (eqt (symbol-value x)
                      (symbol-value y))
               (not (boundp y)))
             (if (fboundp x) (fboundp y) (not (fboundp y)))
             (null (symbol-package y))
             (string= (symbol-name x) (symbol-name y))
             (eql (length (symbol-plist x))
                  (length (symbol-plist y)))
             )))
69 70 71 72 73 74 75 76 77 78
      '(nil t a b |foo| |a| |123|))))
  t)

(deftest copy-symbol.4
  (eqt (copy-symbol 'a) (copy-symbol 'a))
  nil)

(deftest copy-symbol.5
  (let ((i 0) x y (s '#:|x|))
    (let ((s2 (copy-symbol
sds's avatar
sds committed
79 80
               (progn (setf x (incf i)) s)
               (progn (setf y (incf i)) nil))))
81 82 83 84 85 86
      (values
       (symbol-name s2)
       (eq s s2)
       i x y)))
  "x" nil 2 1 2)

87 88
;;; Error tests

89
(deftest copy-symbol.error.1
90 91
  (signals-error (copy-symbol) program-error)
  t)
92 93

(deftest copy-symbol.error.2
94 95
  (signals-error (copy-symbol 'a t 'foo) program-error)
  t)