shadowing-import.lsp 4.86 KB
Newer Older
1 2 3 4 5 6 7 8 9
;-*- Mode:     Lisp -*-
;;;; Author:   Paul Dietz
;;;; Created:  Sun Aug 29 07:42:18 2004
;;;; Contains: Tests for SHADOWING-IMPORT

(in-package :cl-test)

(deftest shadowing-import.1
  (let ((name1 "TEST1")
sds's avatar
sds committed
10
        (name2 "TEST2"))
11 12 13
    (safely-delete-package name1)
    (safely-delete-package name2)
    (prog1
sds's avatar
sds committed
14 15 16 17 18 19 20 21 22 23
        (let* ((p1 (make-package name1 :use nil))
               (p2 (make-package name2))
               (s1 (intern "X" p1))
               (s2 (intern "X" p2)))
          (list
           (eqt s1 s2)
           (eqt (find-symbol "X" p2) s2)
           (shadowing-import s1 p2)
           (equalt (package-shadowing-symbols p2) (list s1))
           (eqt (find-symbol "X" p2) s1)))
24 25 26 27 28 29
      (safely-delete-package name1)
      (safely-delete-package name2)))
  (nil t t t t))

(deftest shadowing-import.2
  (let ((name1 "TEST1")
sds's avatar
sds committed
30
        (name2 "TEST2"))
31 32 33
    (safely-delete-package name1)
    (safely-delete-package name2)
    (prog1
sds's avatar
sds committed
34 35 36 37 38 39 40 41
        (let* ((p1 (make-package name1 :use nil))
               (p2 (make-package name2))
               (s1 (intern "X" p1)))
          (list
           (find-symbol "X" p2)
           (shadowing-import s1 p2)
           (equalt (package-shadowing-symbols p2) (list s1))
           (eqt (find-symbol "X" p2) s1)))
42 43 44 45 46 47
      (safely-delete-package name1)
      (safely-delete-package name2)))
  (nil t t t))

(deftest shadowing-import.3
  (let ((name1 "TEST1")
sds's avatar
sds committed
48
        (name2 "TEST2"))
49 50 51
    (safely-delete-package name1)
    (safely-delete-package name2)
    (prog1
sds's avatar
sds committed
52 53 54 55 56 57 58 59 60 61 62
        (let* ((p1 (make-package name1 :use nil))
               (p2 (make-package name2 :use nil))
               (s1 (intern "X" p1))
               (s2 (intern "X" p2)))
          (list
           (eqt s1 s2)
           (eqt (find-symbol "X" p2) s2)
           (let ((*package* p2))
             (shadowing-import s1))
           (equalt (package-shadowing-symbols p2) (list s1))
           (eqt (find-symbol "X" p2) s1)))
63 64 65 66 67 68
      (safely-delete-package name1)
      (safely-delete-package name2)))
  (nil t t t t))

(deftest shadowing-import.4
  (let ((name1 "TEST1")
sds's avatar
sds committed
69 70
        (name2 "TEST2")
        (name3 "TEST3"))
71 72 73 74
    (safely-delete-package name1)
    (safely-delete-package name2)
    (safely-delete-package name3)
    (prog1
sds's avatar
sds committed
75 76 77 78 79 80 81 82 83 84 85 86
        (let* ((p1 (make-package name1 :use nil))
               (p3 (make-package name2 :use nil))
               (p2 (make-package name3 :use (list p3)))
               (s1 (intern "X" p1))
               (s2 (intern "X" p3)))
          (export s2 p3)
          (list
           (eqt s1 s2)
           (eqt (find-symbol "X" p2) s2)
           (shadowing-import s1 p2)
           (equalt (package-shadowing-symbols p2) (list s1))
           (eqt (find-symbol "X" p2) s1)))
87 88 89 90 91 92 93 94 95 96 97 98
      (safely-delete-package name1)
      (safely-delete-package name3)
      (safely-delete-package name2)))
  (nil t t t t))

;;; Specialized sequence tests

(defmacro def-shadowing-import-test (test-name name-form)
  `(deftest ,test-name
     (let ((name1 ,name-form))
       (safely-delete-package name1)
       (prog1
sds's avatar
sds committed
99 100 101 102 103 104 105
           (let* ((p1 (make-package name1 :use nil)))
             (list
              (find-symbol "T" p1)
              (shadowing-import t name1)
              (package-shadowing-symbols p1)
              (find-symbol "T" p1)))
         (safely-delete-package name1)))
106
     (nil t (t) t)))
sds's avatar
sds committed
107

108 109
(def-shadowing-import-test shadowing-import.5
  (make-array '(5) :initial-contents "TEST1"
sds's avatar
sds committed
110
              :element-type 'base-char))
111 112 113

(def-shadowing-import-test shadowing-import.6
  (make-array '(7) :initial-contents "TEST1XX"
sds's avatar
sds committed
114 115
              :fill-pointer 7
              :element-type 'character))
116 117 118

(def-shadowing-import-test shadowing-import.7
  (make-array '(7) :initial-contents "TEST1XX"
sds's avatar
sds committed
119 120
              :fill-pointer 7
              :element-type 'base-char))
121 122 123

(def-shadowing-import-test shadowing-import.8
  (make-array '(5) :initial-contents "TEST1"
sds's avatar
sds committed
124 125
              :adjustable t
              :element-type 'base-char))
126 127 128

(def-shadowing-import-test shadowing-import.9
  (make-array '(5) :initial-contents "TEST1"
sds's avatar
sds committed
129 130
              :adjustable t
              :element-type 'character))
131 132 133

(def-shadowing-import-test shadowing-import.10
  (let* ((etype 'character)
sds's avatar
sds committed
134 135
         (name2 (make-array '(10) :initial-contents "ABTEST1CDE"
                            :element-type etype)))
136
    (make-array '(5) :element-type etype
sds's avatar
sds committed
137 138
                :displaced-to name2
                :displaced-index-offset 2)))
139 140 141

(def-shadowing-import-test shadowing-import.11
  (let* ((etype 'base-char)
sds's avatar
sds committed
142 143
         (name2 (make-array '(10) :initial-contents "ABTEST1CDE"
                            :element-type etype)))
144
    (make-array '(5) :element-type etype
sds's avatar
sds committed
145 146
                :displaced-to name2
                :displaced-index-offset 2)))
147 148 149 150 151 152 153 154 155

;;; Error tests

(deftest shadowing-import.error.1
  (signals-error (shadowing-import) program-error)
  t)

(deftest shadowing-import.error.2
  (signals-error (shadowing-import nil *package* nil)
sds's avatar
sds committed
156
                 program-error)
157
  t)