Commit f8868f7e authored by pfdietz's avatar pfdietz

Relaxed continuable error tests, since the standard does not require them to...

Relaxed continuable error tests, since the standard does not require them to be continuable with the continue restart.
parent 4a264a6a
......@@ -161,20 +161,21 @@
(let* ((pkg (eval `(defpackage ,pkg-name (:use))))
(sym 'foo)
(name (symbol-name sym))
(isym (intern name pkg)))
(values
(handler-bind
((package-error
#'(lambda (c)
(let ((r (find-restart 'continue c)))
;; Get rid of the conflicting symbol
(unintern isym)
(and r (invoke-restart r))))))
(import sym pkg))
(eqlt (find-symbol (symbol-name sym) pkg) sym)
(eqlt (symbol-package sym) (find-package :cl-test))
(external-symbols-in-package pkg))))
t t t nil)
(isym (intern name pkg))
(outer-restarts (compute-restarts)))
(block done
(handler-bind
((package-error
#'(lambda (c)
;; There should be at least one restart
;; associated with this condition that was
;; not a preexisting restart
(assert (set-difference (compute-restarts c)
outer-restarts))
(return-from done :good))))
(import sym pkg)))))
:good)
(deftest import.error.5
(let ((pkg-name *import-package-test-name*))
......@@ -182,17 +183,17 @@
(let* ((pkg (eval `(defpackage ,pkg-name (:use))))
(sym 'foo)
(name (symbol-name sym))
(isym (shadow name pkg)))
(values
(handler-bind
((package-error
#'(lambda (c)
(let ((r (find-restart 'continue c)))
;; Get rid of the conflicting symbol
(unintern isym)
(and r (invoke-restart r))))))
(import sym pkg))
(eqlt (find-symbol (symbol-name sym) pkg) sym)
(eqlt (symbol-package sym) (find-package :cl-test))
(external-symbols-in-package pkg))))
t t t nil)
(isym (shadow name pkg)) ;; shadow instead of intern
(outer-restarts (compute-restarts)))
(block done
(handler-bind
((package-error
#'(lambda (c)
;; There should be at least one restart
;; associated with this condition that was
;; not a preexisting restart
(assert (set-difference (compute-restarts c)
outer-restarts))
(return-from done :good))))
(import sym pkg)))))
:good)
......@@ -55,31 +55,37 @@
;;; PFD 01.18.03 This test is working, but suspicious.
(deftest delete-package.5
(prog (P1 S1 P2 S2 P3)
(prog (p1 s1 p2 s2 p3)
(declare (ignorable p1 p2 p3 s1 s2))
(safely-delete-package "P3")
(safely-delete-package "P2")
(safely-delete-package "P1")
(setq P1 (make-package "P1" :use ()))
(setq S1 (intern "S1" P1))
(export S1 "P1")
(setq p1 (make-package "P1" :use ()))
(setq s1 (intern "S1" P1))
(export s1 "P1")
(setq P2 (make-package "P2" :use '("P1")))
(setq S2 (intern "S2" P2))
(export S1 P2)
(export S2 "P2")
(setq p2 (make-package "P2" :use '("P1")))
(setq s2 (intern "S2" p2))
(export s1 p2)
(export s2 "P2")
(setf P3 (make-package "P3" :use '("P2")))
(setf p3 (make-package "P3" :use '("P2")))
;; Delete the P2 package, catching the continuable
;; error and deleting the package
(let ((outer-restarts (compute-restarts)))
(handler-bind ((package-error
#'(lambda (c)
;; (let ((r (find-restart 'continue c))) (and r (invoke-restart r)))
(assert (set-difference (compute-restarts c)
outer-restarts))
(return t)
)))
(delete-package p2)))
(handler-bind ((package-error
#'(lambda (c)
(let ((r (find-restart 'continue c)))
(and r (invoke-restart r))))))
(delete-package P2))
#|
(unless (and (equal (package-name P1) "P1")
(null (package-name P2))
(equal (package-name P3) "P3"))
......@@ -112,28 +118,26 @@
(safely-delete-package P3)
(safely-delete-package P1)
(return t))
(return t)
|#
)
t)
;; deletion of a nonexistent package should cause a continuable
;; package-error (same comments for delete-package.5 apply
;; here as well)
;;; PFD 10/14/02 -- These tests are broken again. I suspect
;;; some sort of interaction with the test harness.
;;; PFD 01.18.03 This test is working, but suspicious.
(deftest delete-package.6
(progn
(safely-delete-package "TEST-20")
(handler-bind ((package-error
#'(lambda (c)
(let ((r (find-restart 'continue c)))
(and r (invoke-restart r))))))
(and (not (delete-package "TEST-20"))
t)))
t)
(block done
(let ((outer-restarts (compute-restarts)))
(safely-delete-package "TEST-20")
(handler-bind ((package-error
#'(lambda (c)
(assert (set-difference (compute-restarts c)
outer-restarts))
(return-from done :good))))
(delete-package "TEST-20"))))
:good)
(deftest delete-package.error.1
(signals-error (delete-package) program-error)
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment