← Back to branch summary

~ubuntu-branches/ubuntu/quantal/gclcvs/quantal

« back to all changes in this revision

Viewing changes to ansi-tests/copy-symbol.lsp

  • Committer: Bazaar Package Importer
  • Author(s): Camm Maguire
  • Date: 2004-06-24 15:13:46 UTC
  • Revision ID: james.westby@ubuntu.com-20040624151346-xh0xaaktyyp7aorc
Tags: 2.7.0-26
C_GC_OFFSET is 2 on m68k-linux

Show diffs side-by-side

added added

removed removed

Lines of Context:
ansi-tests/copy-symbol.lsp
 
1
;-*- Mode:     Lisp -*-
 
2
;;;; Author:   Paul Dietz
 
3
;;;; Created:  Sat Jun 14 05:44:41 2003
 
4
;;;; Contains: Tests of COPY-SYMBOL
 
5
 
 
6
(in-package :cl-test)
 
7
 
 
8
(deftest copy-symbol.1
 
9
  (notnot-mv
 
10
   (every
 
11
    #'(lambda (x)
 
12
        (let ((y (copy-symbol x)))
 
13
          (and (null (symbol-plist y))
 
14
               (symbolp y)
 
15
               (not (boundp y))
 
16
               (not (fboundp y))
 
17
               (null (symbol-package y))
 
18
               (string= (symbol-name x) (symbol-name y))
 
19
               (symbolp (copy-symbol y))
 
20
               )))
 
21
    '(nil t a b |a| |123|)))
 
22
  t)
 
23
 
 
24
(deftest copy-symbol.2
 
25
  (progn
 
26
    (setf (symbol-plist '|foo|) '(a b c d))
 
27
    (makunbound '|foo|)
 
28
    (notnot-mv
 
29
     (every
 
30
      #'(lambda (x)
 
31
          (let ((y (copy-symbol x t)))
 
32
            (and
 
33
             (equal (symbol-plist y) (symbol-plist x))
 
34
             (symbolp y)
 
35
             (if (boundp x)
 
36
                 (boundp y)
 
37
               (not (boundp y)))
 
38
             (if (fboundp x) (fboundp y) (not (fboundp y)))
 
39
             (null (symbol-package y))
 
40
             (string= (symbol-name x) (symbol-name y))
 
41
             )))
 
42
      '(nil t a b |foo| |a| |123|))))
 
43
  t)
 
44
 
 
45
(deftest copy-symbol.3
 
46
  (progn
 
47
    (setf (symbol-plist '|foo|) '(a b c d))
 
48
    (setf (symbol-value '|a|) 12345)
 
49
    (notnot-mv
 
50
     (every
 
51
      #'(lambda (x)
 
52
          (let ((y (copy-symbol x t)))
 
53
            (and
 
54
             (eql (length (symbol-plist y))
 
55
                  (length (symbol-plist x)))
 
56
             ;; Is a list copy
 
57
             (every #'eq (symbol-plist y) (symbol-plist x))
 
58
             (symbolp y)
 
59
             (if (boundp x)
 
60
                 (eqt (symbol-value x)
 
61
                      (symbol-value y))
 
62
               (not (boundp y)))
 
63
             (if (fboundp x) (fboundp y) (not (fboundp y)))
 
64
             (null (symbol-package y))
 
65
             (string= (symbol-name x) (symbol-name y))
 
66
             (eql (length (symbol-plist x))
 
67
                  (length (symbol-plist y)))
 
68
             )))
 
69
      '(nil t a b |foo| |a| |123|))))
 
70
  t)
 
71
 
 
72
(deftest copy-symbol.4
 
73
  (eqt (copy-symbol 'a) (copy-symbol 'a))
 
74
  nil)
 
75
 
 
76
(deftest copy-symbol.5
 
77
  (let ((i 0) x y (s '#:|x|))
 
78
    (let ((s2 (copy-symbol
 
79
               (progn (setf x (incf i)) s)
 
80
               (progn (setf y (incf i)) nil))))
 
81
      (values
 
82
       (symbol-name s2)
 
83
       (eq s s2)
 
84
       i x y)))
 
85
  "x" nil 2 1 2)
 
86
 
 
87
;;; Error tests
 
88
 
 
89
(deftest copy-symbol.error.1
 
90
  (signals-error (copy-symbol) program-error)
 
91
  t)
 
92
 
 
93
(deftest copy-symbol.error.2
 
94
  (signals-error (copy-symbol 'a t 'foo) program-error)
 
95
  t)