| ... |
... |
@@ -13,20 +13,6 @@ |
|
13
|
13
|
(defpackage :test-locked-package
|
|
14
|
14
|
(:use :cl))
|
|
15
|
15
|
|
|
16
|
|
-(let* ((p (find-package :test-locked-package))
|
|
17
|
|
- (sym (intern "TOPLEVEL-PROBE" p)))
|
|
18
|
|
- (setf (ext:package-lock p) t)
|
|
19
|
|
- (format t "~&TOPLEVEL: package-lock=~S enable=~S~%"
|
|
20
|
|
- (ext:package-lock p) lisp::*enable-package-locked-errors*)
|
|
21
|
|
- (handler-case
|
|
22
|
|
- (let ((result (unintern sym p)))
|
|
23
|
|
- (format t "~&TOPLEVEL: unintern returned ~S (no error)~%" result))
|
|
24
|
|
- (lisp::package-locked-error (c)
|
|
25
|
|
- (format t "~&TOPLEVEL: caught error ~A~%" c))
|
|
26
|
|
- (error (c)
|
|
27
|
|
- (format t "~&TOPLEVEL: caught other error ~A (~A)~%" c (type-of c))))
|
|
28
|
|
- (setf (ext:package-lock p) nil))
|
|
29
|
|
-
|
|
30
|
16
|
(defmacro with-definition-locked ((package) &body body)
|
|
31
|
17
|
"Run BODY with PACKAGE's definition-lock enabled and namespace-lock
|
|
32
|
18
|
disabled, so failures from BODY can be attributed unambiguously to
|
| ... |
... |
@@ -103,45 +89,3 @@ |
|
103
|
89
|
(assert-error 'lisp::package-locked-error
|
|
104
|
90
|
(unexport sym p)))))
|
|
105
|
91
|
|
|
106
|
|
-(define-test package-lock-debug
|
|
107
|
|
- (:tag :issues)
|
|
108
|
|
- (let* ((p (find-package :test-locked-package))
|
|
109
|
|
- (sym (intern "DEBUG-SYM" p)))
|
|
110
|
|
- (setf (ext:package-lock p) t)
|
|
111
|
|
- (format t "~&Just before unintern:~%")
|
|
112
|
|
- (format t " package-lock: ~S~%" (ext:package-lock p))
|
|
113
|
|
- (format t " *enable-package-locked-errors*: ~S~%"
|
|
114
|
|
- lisp::*enable-package-locked-errors*)
|
|
115
|
|
- (format t " *package*: ~S~%" *package*)
|
|
116
|
|
- (format t " package of unintern fn: ~S~%"
|
|
117
|
|
- (symbol-package 'unintern))
|
|
118
|
|
- (handler-case
|
|
119
|
|
- (let ((result (unintern sym p)))
|
|
120
|
|
- (format t " unintern returned: ~S~%" result))
|
|
121
|
|
- (lisp::package-locked-error (c)
|
|
122
|
|
- (format t " GOT package-locked-error: ~A~%" c))
|
|
123
|
|
- (error (c)
|
|
124
|
|
- (format t " got OTHER error: ~A~%" c)))
|
|
125
|
|
- (setf (ext:package-lock p) nil)
|
|
126
|
|
- (assert-true t)))
|
|
127
|
|
-
|
|
128
|
|
-;; At end of file:
|
|
129
|
|
-(format *error-output* "~&~%==== TOPLEVEL PROBE ====~%")
|
|
130
|
|
-(force-output *error-output*)
|
|
131
|
|
-(let* ((p (find-package :test-locked-package))
|
|
132
|
|
- (sym (intern "TOPLEVEL-PROBE" p)))
|
|
133
|
|
- (setf (ext:package-lock p) t)
|
|
134
|
|
- (format *error-output* "package-lock=~S enable=~S~%"
|
|
135
|
|
- (ext:package-lock p) lisp::*enable-package-locked-errors*)
|
|
136
|
|
- (force-output *error-output*)
|
|
137
|
|
- (handler-case
|
|
138
|
|
- (let ((result (unintern sym p)))
|
|
139
|
|
- (format *error-output* "unintern returned ~S (NO ERROR!)~%" result))
|
|
140
|
|
- (lisp::package-locked-error (c)
|
|
141
|
|
- (format *error-output* "GOT package-locked-error: ~A~%" c))
|
|
142
|
|
- (error (c)
|
|
143
|
|
- (format *error-output* "got OTHER error: ~A (~A)~%" c (type-of c))))
|
|
144
|
|
- (force-output *error-output*)
|
|
145
|
|
- (setf (ext:package-lock p) nil))
|
|
146
|
|
-(format *error-output* "==== END PROBE ====~%~%")
|
|
147
|
|
-(force-output *error-output*) |