source: trunk/source/tests/ansi-tests/shadowing-import.lsp @ 8991

Last change on this file since 8991 was 8991, checked in by gz, 12 years ago

Check in the gcl ansi test suite (original, in preparation for making local changes)

File size: 4.3 KB
Line 
1;-*- Mode:     Lisp -*-
2;;;; Author:   Paul Dietz
3;;;; Created:  Sun Aug 29 07:42:18 2004
4;;;; Contains: Tests for SHADOWING-IMPORT
5
6(in-package :cl-test)
7
8(deftest shadowing-import.1
9  (let ((name1 "TEST1")
10        (name2 "TEST2"))
11    (safely-delete-package name1)
12    (safely-delete-package name2)
13    (prog1
14        (let* ((p1 (make-package name1 :use nil))
15               (p2 (make-package name2))
16               (s1 (intern "X" p1))
17               (s2 (intern "X" p2)))
18          (list
19           (eqt s1 s2)
20           (eqt (find-symbol "X" p2) s2)
21           (shadowing-import s1 p2)
22           (equalt (package-shadowing-symbols p2) (list s1))
23           (eqt (find-symbol "X" p2) s1)))
24      (safely-delete-package name1)
25      (safely-delete-package name2)))
26  (nil t t t t))
27
28(deftest shadowing-import.2
29  (let ((name1 "TEST1")
30        (name2 "TEST2"))
31    (safely-delete-package name1)
32    (safely-delete-package name2)
33    (prog1
34        (let* ((p1 (make-package name1 :use nil))
35               (p2 (make-package name2))
36               (s1 (intern "X" p1)))
37          (list
38           (find-symbol "X" p2)
39           (shadowing-import s1 p2)
40           (equalt (package-shadowing-symbols p2) (list s1))
41           (eqt (find-symbol "X" p2) s1)))
42      (safely-delete-package name1)
43      (safely-delete-package name2)))
44  (nil t t t))
45
46(deftest shadowing-import.3
47  (let ((name1 "TEST1")
48        (name2 "TEST2"))
49    (safely-delete-package name1)
50    (safely-delete-package name2)
51    (prog1
52        (let* ((p1 (make-package name1 :use nil))
53               (p2 (make-package name2 :use nil))
54               (s1 (intern "X" p1))
55               (s2 (intern "X" p2)))
56          (list
57           (eqt s1 s2)
58           (eqt (find-symbol "X" p2) s2)
59           (let ((*package* p2))
60             (shadowing-import s1))
61           (equalt (package-shadowing-symbols p2) (list s1))
62           (eqt (find-symbol "X" p2) s1)))
63      (safely-delete-package name1)
64      (safely-delete-package name2)))
65  (nil t t t t))
66
67(deftest shadowing-import.4
68  (let ((name1 "TEST1")
69        (name2 "TEST2")
70        (name3 "TEST3"))
71    (safely-delete-package name1)
72    (safely-delete-package name2)
73    (safely-delete-package name3)
74    (prog1
75        (let* ((p1 (make-package name1 :use nil))
76               (p3 (make-package name2 :use nil))
77               (p2 (make-package name3 :use (list p3)))
78               (s1 (intern "X" p1))
79               (s2 (intern "X" p3)))
80          (export s2 p3)
81          (list
82           (eqt s1 s2)
83           (eqt (find-symbol "X" p2) s2)
84           (shadowing-import s1 p2)
85           (equalt (package-shadowing-symbols p2) (list s1))
86           (eqt (find-symbol "X" p2) s1)))
87      (safely-delete-package name1)
88      (safely-delete-package name3)
89      (safely-delete-package name2)))
90  (nil t t t t))
91
92;;; Specialized sequence tests
93
94(defmacro def-shadowing-import-test (test-name name-form)
95  `(deftest ,test-name
96     (let ((name1 ,name-form))
97       (safely-delete-package name1)
98       (prog1
99           (let* ((p1 (make-package name1 :use nil)))
100             (list
101              (find-symbol "T" p1)
102              (shadowing-import t name1)
103              (package-shadowing-symbols p1)
104              (find-symbol "T" p1)))
105         (safely-delete-package name1)))
106     (nil t (t) t)))
107 
108(def-shadowing-import-test shadowing-import.5
109  (make-array '(5) :initial-contents "TEST1"
110              :element-type 'base-char))
111
112(def-shadowing-import-test shadowing-import.6
113  (make-array '(7) :initial-contents "TEST1XX"
114              :fill-pointer 7
115              :element-type 'character))
116
117(def-shadowing-import-test shadowing-import.7
118  (make-array '(7) :initial-contents "TEST1XX"
119              :fill-pointer 7
120              :element-type 'base-char))
121
122(def-shadowing-import-test shadowing-import.8
123  (make-array '(5) :initial-contents "TEST1"
124              :adjustable t
125              :element-type 'base-char))
126
127(def-shadowing-import-test shadowing-import.9
128  (make-array '(5) :initial-contents "TEST1"
129              :adjustable t
130              :element-type 'character))
131
132(def-shadowing-import-test shadowing-import.10
133  (let* ((etype 'character)
134         (name2 (make-array '(10) :initial-contents "ABTEST1CDE"
135                            :element-type etype)))
136    (make-array '(5) :element-type etype
137                :displaced-to name2
138                :displaced-index-offset 2)))
139
140(def-shadowing-import-test shadowing-import.11
141  (let* ((etype 'base-char)
142         (name2 (make-array '(10) :initial-contents "ABTEST1CDE"
143                            :element-type etype)))
144    (make-array '(5) :element-type etype
145                :displaced-to name2
146                :displaced-index-offset 2)))
147
148;;; Error tests
149
150(deftest shadowing-import.error.1
151  (signals-error (shadowing-import) program-error)
152  t)
153
154(deftest shadowing-import.error.2
155  (signals-error (shadowing-import nil *package* nil)
156                 program-error)
157  t)
Note: See TracBrowser for help on using the repository browser.