Commit 9ab8da0f authored by pfdietz's avatar pfdietz

Added report-and-ignore-errors forms to enable gcl to at least load the tests...

Added report-and-ignore-errors forms to enable gcl to at least load the tests without aborting (although it currently dies in CLOS for some reason.)  Remove reader conditions in eval-when.  Reduce number of warnings when loaded with sbcl.
parent bccf9469
......@@ -27,5 +27,16 @@
'(should-never-be-called)))
`(if *should-always-be-true* ,form ,default-form))
;;; Macro to ignore errors, but report them anyway
(defmacro report-and-ignore-errors (&body body)
`(eval-when (:load-toplevel :compile-toplevel :execute)
(#+sbcl let #+sbcl () #-sbcl progn
(handler-case
(progn ,@body)
(error (condition)
(princ condition)
(terpri)
(values nil condition))))))
......@@ -31,6 +31,13 @@
(not (first results))
(rest results))))
(declaim (ftype (function (t) function) to-function))
(defun to-function (fn)
(etypecase fn
(function fn)
(symbol (symbol-function fn))
((cons (eql setf) symbol) (fdefinition fn))))
;;; Macro to check that a function is returning a specified number of values
;;; (defaults to 1)
......@@ -107,7 +114,7 @@ Results: ~A~%" expected-number form n results))))
(typep a2 'array)
(= (array-rank a1) (array-rank a2))
(if (= (array-rank a1) 0)
(equal (aref a1) (aref a2))
(equal (rt::my-aref a1) (rt::my-aref a2))
(let ((ad (array-dimensions a1)))
(and (equal ad (array-dimensions a2))
(locally
......@@ -116,13 +123,13 @@ Results: ~A~%" expected-number form n results))))
(let ((as (first ad)))
(loop
for i from 0 below as
always (equal (aref a1 i) (aref a2 i))))
always (equal (rt::my-aref a1 i) (rt::my-aref a2 i))))
(let ((as (array-total-size a1)))
(and (= as (array-total-size a2))
(loop
for i from 0 below as
always (equal (row-major-aref a1 i)
(row-major-aref a2 i))))))))))))
always (equal (rt::my-row-major-aref a1 i)
(rt::my-row-major-aref a2 i))))))))))))
;;; *universe* is defined elsewhere -- it is a list of various
;;; lisp objects used when stimulating things in various tests.
......@@ -1281,8 +1288,7 @@ the condition to go uncaught if it cannot be classified."
(classify-error* (elt x n)))
(defmacro defstruct* (&body args)
`(eval-when #+gcl (load eval compile)
#-gcl (:load-toplevel :compile-toplevel :execute)
`(eval-when (:load-toplevel :compile-toplevel :execute)
(handler-case (eval '(defstruct ,@args))
(serious-condition () nil))))
......
......@@ -376,14 +376,14 @@
(defclass change-class-class-05 ()
(a b c))
(ignore-errors
(defmethod change-class
((obj change-class-class-05)
(new-class (eql (find-class 'change-class-class-05)))
&rest initargs &key &allow-other-keys)
(declare (ignore initargs new-class))
(setq *changed-class-on-class-05* t)
obj))
(report-and-ignore-errors
(defmethod change-class
((obj change-class-class-05)
(new-class (eql (find-class 'change-class-class-05)))
&rest initargs &key &allow-other-keys)
(declare (ignore initargs new-class))
(setq *changed-class-on-class-05* t)
obj))
(deftest change-class.5
(let ((*changed-class-on-class-05* nil)
......@@ -398,14 +398,14 @@
(defclass change-class-class-06 ()
((a :initarg :a) (b :initarg :b) (c :initarg :c)))
(ignore-errors
(defmethod change-class
((obj change-class-class-06)
(new-class standard-class)
&rest initargs &key &allow-other-keys)
(declare (ignore initargs))
(setf (slot-value obj 'a) 123)
(call-next-method)))
(report-and-ignore-errors
(defmethod change-class
((obj change-class-class-06)
(new-class standard-class)
&rest initargs &key &allow-other-keys)
(declare (ignore initargs))
(setf (slot-value obj 'a) 123)
(call-next-method)))
(deftest change-class.6.1
(let* ((class (find-class 'change-class-class-06))
......@@ -446,14 +446,14 @@
((a :initform 'aa :initarg :a)
(d :initform 'dd :initarg :d)))
(ignore-errors
(defmethod change-class :before
((obj change-class-class-07)
(new-class standard-class)
&rest initargs &key &allow-other-keys)
(declare (ignore initargs))
(setf (slot-value obj 'a) 'z)
obj))
(report-and-ignore-errors
(defmethod change-class :before
((obj change-class-class-07)
(new-class standard-class)
&rest initargs &key &allow-other-keys)
(declare (ignore initargs))
(setf (slot-value obj 'a) 'z)
obj))
(deftest change-class.7.1
(let* ((class (find-class 'change-class-class-07))
......@@ -531,17 +531,18 @@
;;; After method
(ignore-errors
(defclass change-class-class-08 () ((a :initarg :a) (b :initarg :b))))
(ignore-errors
(defmethod change-class :after
((obj change-class-class-08)
(class (eql (find-class 'change-class-class-08)))
&rest initargs &key &allow-other-keys)
(declare (ignore initargs))
(setf (slot-value obj 'a) 'z)
obj))
(report-and-ignore-errors
(defclass change-class-class-08 ()
((a :initarg :a) (b :initarg :b))))
(report-and-ignore-errors
(defmethod change-class :after
((obj change-class-class-08)
(class (eql (find-class 'change-class-class-08)))
&rest initargs &key &allow-other-keys)
(declare (ignore initargs))
(setf (slot-value obj 'a) 'z)
obj))
(deftest change-class.8.1
(let* ((class (find-class 'change-class-class-08))
......
......@@ -5,7 +5,6 @@
(defpackage :cl-test
(:use :cl :regression-test)
;; #+gcl (:use defpackage)
(:nicknames)
(:shadow #:handler-case #:handler-bind)
(:import-from "COMMON-LISP-USER" #:compile-and-load "==>")
......
......@@ -5,13 +5,15 @@
(in-package :cl-test)
(unless #| (fboundp 'class-precedence-list) |# nil
(defgeneric class-precedence-list (x)
(:method-combination list)
.
#.(loop for s in *cl-types-that-are-classes-symbols*
collect
`(:method list ((x ,s)) ',s))))
(eval-when (:load-toplevel :compile-toplevel :execute)
(unless #| (fboundp 'class-precedence-list) |# nil
(report-and-ignore-errors
(defgeneric class-precedence-list (x)
(:method-combination list)
.
#.(loop for s in *cl-types-that-are-classes-symbols*
collect
`(:method list ((x ,s)) ',s))))))
(defmacro def-cpl-test (objform expected-cpl &optional name)
(let* ((ordered (loop for e = expected-cpl then (cdr e)
......
......@@ -6,8 +6,7 @@
(when (eq excl:*current-case-mode* :case-sensitive-lower)
(push :lower-case *features*)))
(eval-when #+gcl (load eval compile)
#-gcl (:load-toplevel :compile-toplevel :execute)
(eval-when (:load-toplevel :compile-toplevel :execute)
(intern "==>" "CL-USER")
(unless (fboundp 'compile-file-pathname)
(defun compile-file-pathname (pathname)
......
......@@ -49,23 +49,25 @@
(compute-applicable-methods #'cam-gf-02 '(1))
nil)
(defgeneric cam-gf-03 (x)
(:method-combination + :most-specific-first))
(defparameter *cam-gf-03-method1*
(defmethod cam-gf-03 + ((x integer)) 1))
(defparameter *cam-gf-03-method2*
(defmethod cam-gf-03 + ((x rational)) 2))
(defparameter *cam-gf-03-method3*
(defmethod cam-gf-03 + ((x real)) 4))
(defparameter *cam-gf-03-method4*
(defmethod cam-gf-03 + ((x number)) 8))
(defparameter *cam-gf-03-method5*
(defmethod cam-gf-03 + ((x t)) 16))
(eval-when (:load-toplevel :compile-toplevel :execute)
(report-and-ignore-errors
(defgeneric cam-gf-03 (x)
(:method-combination + :most-specific-first))
(defparameter *cam-gf-03-method1*
(defmethod cam-gf-03 + ((x integer)) 1))
(defparameter *cam-gf-03-method2*
(defmethod cam-gf-03 + ((x rational)) 2))
(defparameter *cam-gf-03-method3*
(defmethod cam-gf-03 + ((x real)) 4))
(defparameter *cam-gf-03-method4*
(defmethod cam-gf-03 + ((x number)) 8))
(defparameter *cam-gf-03-method5*
(defmethod cam-gf-03 + ((x t)) 16))))
(deftest compute-applicable-methods.6
(equalt (compute-applicable-methods #'cam-gf-03 (list 0))
......@@ -73,24 +75,27 @@
*cam-gf-03-method4* *cam-gf-03-method5*))
t)
(defgeneric cam-gf-04 (x)
(:method-combination + :most-specific-last))
(defparameter *cam-gf-04-method1*
(defmethod cam-gf-04 + ((x integer)) 1))
(defparameter *cam-gf-04-method2*
(defmethod cam-gf-04 + ((x rational)) 2))
(defparameter *cam-gf-04-method3*
(defmethod cam-gf-04 + ((x real)) 4))
(defparameter *cam-gf-04-method4*
(defmethod cam-gf-04 + ((x number)) 8))
(defparameter *cam-gf-04-method5*
(defmethod cam-gf-04 + ((x t)) 16))
(eval-when (:load-toplevel :compile-toplevel :execute)
(report-and-ignore-errors
(defgeneric cam-gf-04 (x)
(:method-combination + :most-specific-last))
(defparameter *cam-gf-04-method1*
(defmethod cam-gf-04 + ((x integer)) 1))
(defparameter *cam-gf-04-method2*
(defmethod cam-gf-04 + ((x rational)) 2))
(defparameter *cam-gf-04-method3*
(defmethod cam-gf-04 + ((x real)) 4))
(defparameter *cam-gf-04-method4*
(defmethod cam-gf-04 + ((x number)) 8))
(defparameter *cam-gf-04-method5*
(defmethod cam-gf-04 + ((x t)) 16))
))
(deftest compute-applicable-methods.7
(equalt (compute-applicable-methods #'cam-gf-04 (list 0))
(list *cam-gf-04-method1* *cam-gf-04-method2* *cam-gf-04-method3*
......
......@@ -15,10 +15,18 @@
(setq test (complement test-not)))
((not test) (setq test #'eql)))
(when (symbolp test) (setq test (symbol-function test)))
;;; (when (symbolp test) (setq test (symbol-function test)))
(etypecase test
(symbol (setq test (symbol-function test)))
(function nil))
(let* ((keys1 (if key (mapcar key set1) set1))
(keys2 (if key (mapcar key set2) set2))
(etypecase key
(null nil)
(symbol (setq key (symbol-function key)))
(function nil))
(let* ((keys1 (if key (mapcar (the function key) set1) set1))
(keys2 (if key (mapcar (the function key) set2) set2))
(mask1 (make-array (length set1) :element-type 'bit
:initial-element 0))
(mask2 (make-array (length set2) :element-type 'bit
......@@ -28,7 +36,7 @@
do
(loop for i2 from 0
for k2 in keys2
when (funcall test k1 k2)
when (funcall (the function test) k1 k2)
do (setf (sbit mask1 i1) 1
(sbit mask2 i2) 1)))
(nconc
......@@ -64,24 +72,28 @@
(list test-args test-not-args key-args))))))
(defun random-set-exclusive-or-test (n reps &optional (fn 'set-exclusive-or))
(loop for i below reps
for args = (make-random-set-exclusive-or-input n)
for set1 = (car args)
for set2 = (cadr args)
for result1 = (apply #'remove-duplicates
(sort (copy-list (apply #'my-set-exclusive-or args))
#'<)
(cddr args))
for result2 = (apply #'remove-duplicates
(sort (copy-list (apply fn
(copy-list set1)
(copy-list set2)
(cddr args)))
#'<)
(cddr args))
unless (equal result1 result2)
return (list (list 'remove-duplicates (list 'sort (cons fn args) '<) "...")
"actual: " result2 "should be: " result1)))
(let ((actual-fn (etypecase fn
(symbol (symbol-function fn))
(function fn))))
(declare (type function actual-fn))
(loop for i below reps
for args = (make-random-set-exclusive-or-input n)
for set1 = (car args)
for set2 = (cadr args)
for result1 = (apply #'remove-duplicates
(sort (copy-list (apply #'my-set-exclusive-or args))
#'<)
(cddr args))
for result2 = (apply #'remove-duplicates
(sort (copy-list (apply actual-fn
(copy-list set1)
(copy-list set2)
(cddr args)))
#'<)
(cddr args))
unless (equal result1 result2)
return (list (list 'remove-duplicates (list 'sort (cons fn args) '<) "...")
"actual: " result2 "should be: " result1))))
(defun rev-assoc-list (x)
(cond
......
......@@ -167,9 +167,8 @@
`(progn
(declaim (special ,class-var-name))
(eval-when #+gcl (load eval compile)
#-gcl (:load-toplevel :compile-toplevel :execute)
(ignore-errors (setq ,class-var-name (defclass ,@(cdr args)))))
(report-and-ignore-errors (setq ,class-var-name
(defclass ,@(cdr args))))
(deftest ,(make-defclass-test-name class-name "-DEFCLASS-RETURNS-CLASS")
(eqt (find-class ',class-name) ,class-var-name)
......
......@@ -19,10 +19,9 @@
(dolist (parent parents) (assert (symbolp parent)))
(let ((name (symbol-name name-symbol)))
`(eval-when #+gcl (load eval compile)
#-gcl (:load-toplevel :compile-toplevel :execute)
(ignore-errors (eval '(define-condition ,name-symbol ,parents
,slot-specs ,@options)))
`(eval-when (:load-toplevel :compile-toplevel :execute)
(report-and-ignore-errors (eval '(define-condition ,name-symbol ,parents
,slot-specs ,@options)))
,@(loop for parent in (adjoin 'condition parents)
collect
`(deftest ,(make-def-cond-name name "IS-SUBTYPE-OF/" parent)
......
......@@ -14,18 +14,21 @@
(defclass dmc-class-01g (dmc-class-01a) ())
(defclass dmc-class-01h (dmc-class-01f dmc-class-01g) ())
(defvar *dmc-times*
(define-method-combination times
:documentation "Multiplicative method combination, version 1"
:operator *))
(defgeneric dmc-gf-01 (x) (:method-combination times))
(defmethod dmc-gf-01 times ((x integer)) 2)
(defmethod dmc-gf-01 times ((x rational)) 3)
(defmethod dmc-gf-01 times ((x real)) 5)
(defmethod dmc-gf-01 times ((x number)) 7)
(defmethod dmc-gf-01 times ((x complex)) 11)
(eval-when (:load-toplevel :compile-toplevel :execute)
(report-and-ignore-errors
(defvar *dmc-times*
(define-method-combination times
:documentation "Multiplicative method combination, version 1"
:operator *))
(defgeneric dmc-gf-01 (x) (:method-combination times))
(defmethod dmc-gf-01 times ((x integer)) 2)
(defmethod dmc-gf-01 times ((x rational)) 3)
(defmethod dmc-gf-01 times ((x real)) 5)
(defmethod dmc-gf-01 times ((x number)) 7)
(defmethod dmc-gf-01 times ((x complex)) 11)
))
(deftest define-method-combination-01.1
(values
......@@ -46,13 +49,16 @@
*dmc-times*
times)
(defgeneric dmc-gf-02 (x) (:method-combination times))
(defmethod dmc-gf-02 times ((x integer)) 2)
(defmethod dmc-gf-02 :around ((x rational)) (1- (call-next-method)))
(defmethod dmc-gf-02 times ((x real)) 3)
(defmethod dmc-gf-02 times ((x number)) 5)
(defmethod dmc-gf-02 :around ((x (eql 1.0s0))) 1)
(eval-when (:load-toplevel :compile-toplevel :execute)
(report-and-ignore-errors
(defgeneric dmc-gf-02 (x) (:method-combination times))
(defmethod dmc-gf-02 times ((x integer)) 2)
(defmethod dmc-gf-02 :around ((x rational)) (1- (call-next-method)))
(defmethod dmc-gf-02 times ((x real)) 3)
(defmethod dmc-gf-02 times ((x number)) 5)
(defmethod dmc-gf-02 :around ((x (eql 1.0s0))) 1)
))
(deftest define-method-combination-02.1
(values
......@@ -63,7 +69,9 @@
(dmc-gf-02 #c(1 2)))
29 14 1 15 5)
(defgeneric dmc-gf-03 (x) (:method-combination times))
(eval-when (:load-toplevel :compile-toplevel :execute)
(report-and-ignore-errors
(defgeneric dmc-gf-03 (x) (:method-combination times))))
(deftest define-method-combination-03.1
(prog1
......@@ -101,16 +109,19 @@
(remove-method #'dmc-gf-03 meth)))
:good)
(define-method-combination times2
:operator *
:identity-with-one-argument t)
(defgeneric dmc-gf-04 (x) (:method-combination times2))
(defmethod dmc-gf-04 times2 ((x dmc-class-01b)) 2)
(defmethod dmc-gf-04 times2 ((x dmc-class-01c)) 3)
(defmethod dmc-gf-04 times2 ((x dmc-class-01d)) 5)
(defmethod dmc-gf-04 times2 ((x symbol)) nil)
(eval-when (:load-toplevel :compile-toplevel :execute)
(report-and-ignore-errors
(define-method-combination times2
:operator *
:identity-with-one-argument t)
(defgeneric dmc-gf-04 (x) (:method-combination times2))
(defmethod dmc-gf-04 times2 ((x dmc-class-01b)) 2)
(defmethod dmc-gf-04 times2 ((x dmc-class-01c)) 3)
(defmethod dmc-gf-04 times2 ((x dmc-class-01d)) 5)
(defmethod dmc-gf-04 times2 ((x symbol)) nil)
))
(deftest define-method-combination-04.1
(dmc-gf-04 (make-instance 'dmc-class-01h))
......
......@@ -53,8 +53,7 @@
c
(c b))
(eval-when #+gcl (load eval compile)
#-gcl (:load-toplevel :compile-toplevel :execute)
(ignore-errors
(defun (setf defun-test-fun-4) (newval x)
(return-from defun-test-fun-4 (setf (car x) newval)))))
(report-and-ignore-errors
(defun (setf defun-test-fun-4) (newval x)
(return-from defun-test-fun-4 (setf (car x) newval))))
......@@ -27,10 +27,8 @@
(not-mv (fboundp 'fboundp-5-fn))
nil)
(eval-when #+gcl (eval compile load)
#-gcl (:load-toplevel :compile-toplevel :execute)
(ignore-errors
(defun (setf fboundp-6-accessor) (y x) (setf (car x) y))))
(report-and-ignore-errors
(defun (setf fboundp-6-accessor) (y x) (setf (car x) y)))
(deftest fboundp.6
(not-mv (fboundp '(setf fboundp-6-accessor)))
......
......@@ -5,15 +5,22 @@
(in-package :cl-test)
(defgeneric find-method-gf-01 (x))
(defparameter *find-method-gf-01-method1*
(defmethod find-method-gf-01 ((x integer)) 'a))
(defparameter *find-method-gf-01-method2*
(defmethod find-method-gf-01 ((x rational)) 'b))
(defparameter *find-method-gf-01-method3*
(defmethod find-method-gf-01 ((x real)) 'c))
(defparameter *find-method-gf-01-method4*
(defmethod find-method-gf-01 ((x t)) 'd))
(eval-when (:load-toplevel :compile-toplevel :execute)
(report-and-ignore-errors
(defgeneric find-method-gf-01 (x)))
(report-and-ignore-errors
(defparameter *find-method-gf-01-method1*
(defmethod find-method-gf-01 ((x integer)) 'a)))
(report-and-ignore-errors
(defparameter *find-method-gf-01-method2*
(defmethod find-method-gf-01 ((x rational)) 'b)))
(report-and-ignore-errors
(defparameter *find-method-gf-01-method3*
(defmethod find-method-gf-01 ((x real)) 'c)))
(report-and-ignore-errors
(defparameter *find-method-gf-01-method4*
(defmethod find-method-gf-01 ((x t)) 'd)))
)
(deftest find-method.1
(eqt (find-method #'find-method-gf-01 nil (list (find-class 'integer)))
......
......@@ -47,10 +47,8 @@
(typep '(lambda (x) x) 'function)
nil)
(eval-when #+gcl (eval compile)
#-gcl (:load-toplevel :compile-toplevel :execute)
(ignore-errors
(defun (setf function-7-accessor) (y x) (setf (car x) y) y)))
(report-and-ignore-errors
(defun (setf function-7-accessor) (y x) (setf (car x) y) y))
(deftest function.7
(not-mv (typep #'(setf function-7-accessor) 'function))
......
......@@ -46,10 +46,8 @@
(functionp '(lambda (x) x))
nil)
(eval-when #+gcl (eval compile)
#-gcl (:load-toplevel :compile-toplevel :execute)
(ignore-errors
(defun (setf functionp-7-accessor) (y x) (setf (car x) y) y)))
(report-and-ignore-errors
(defun (setf functionp-7-accessor) (y x) (setf (car x) y) y))
(deftest functionp.7
(not-mv (functionp #'(setf functionp-7-accessor)))
......
......@@ -202,42 +202,42 @@
0)
(deftest loop.15.70
(progn
(let ()
(ignore-errors (delete-package "LOOP.15.PACKAGE"))
(let ((p (make-package "LOOP.15.PACKAGE" :use nil)))
(loop :for x :being :the :symbols :of p :count t)))
0)
(deftest loop.15.71
(progn
(let ()
(ignore-errors (delete-package "LOOP.15.PACKAGE"))
(let ((p (make-package "LOOP.15.PACKAGE" :use nil)))
(loop :for x :being :each :symbol :of p :count t)))
0)
(deftest loop.15.72
(progn
(let ()
(ignore-errors (delete-package "LOOP.15.PACKAGE"))
(let ((p (make-package "LOOP.15.PACKAGE" :use nil)))
(loop :for x :being :the :external-symbols :of p :count t)))
0)
(deftest loop.15.73
(progn
(let ()
(ignore-errors (delete-package "LOOP.15.PACKAGE"))
(let ((p (make-package "LOOP.15.PACKAGE" :use nil)))
(loop :for x :being :each :external-symbol :of p :count t)))
0)
(deftest loop.15.74
(progn
(let ()
(ignore-errors (delete-package "LOOP.15.PACKAGE"))
(let ((p (make-package "LOOP.15.PACKAGE" :use nil)))
(loop :for x :being :the :present-symbols :of p :count t)))
0)
(deftest loop.15.75
(progn
(let ()
(ignore-errors (delete-package "LOOP.15.PACKAGE"))
(let ((p (make-package "LOOP.15.PACKAGE" :use nil)))
(loop :for x :being :each :present-symbol :of p :count t)))
......
......@@ -201,42 +201,42 @@
0)
(deftest loop.16.70
(progn
(let ()
(ignore-errors (delete-package "LOOP.16.PACKAGE"))
(let ((p (make-package "LOOP.16.PACKAGE" :use nil)))
(loop #:for x #:being #:the #:symbols #:of p #:count t)))
0)
(deftest loop.16.71
(progn
(let ()
(ignore-errors (delete-package "LOOP.16.PACKAGE"))
(let ((p (make-package "LOOP.16.PACKAGE" :use nil)))
(loop #:for x #:being #:each #:symbol #:of p #:count t)))
0)
(deftest loop.16.72
(progn
(let ()
(ignore-errors (delete-package "LOOP.16.PACKAGE"))
(let ((p (make-package "LOOP.16.PACKAGE" :use nil)))
(loop #:for x #:being #:the #:external-symbols #:of p #:count t)))
0)
(deftest loop.16.73
(progn
(let ()
(ignore-errors (delete-package "LOOP.16.PACKAGE"))
(let ((p (make-package "LOOP.16.PACKAGE" :use nil)))
(loop #:for x #:being #:each #:external-symbol #:of p #:count t)))
0)
(deftest loop.16.74
(progn
(let ()
(ignore-errors (delete-package "LOOP.16.PACKAGE"))
(let ((p (make-package "LOOP.16.PACKAGE" :use nil)))
(loop #:for x #:being #:the #:present-symbols #:of p #:count t)))
0)
(deftest loop.16.75
(progn
(let ()
(ignore-errors (delete-package "LOOP.16.PACKAGE"))
(let ((p (make-package "LOOP.16.PACKAGE" :use nil)))
(loop #:for x #:being #:each #:present-symbol #:of p #:count t)))
......
......@@ -124,21 +124,21 @@
;;; (section 6.1.2.1.7), this should cause a pacakge-error.
(deftest loop.7.18
(progn
(let ()
(ignore-errors (delete-package "LOOP.MISSING.PACKAGE"))
(classify-error
(loop for x being each symbol of "LOOP.MISSING.PACKAGE" collect x)))
package-error)
(deftest loop.7.19
(progn
(let ()
(ignore-errors (delete-package "LOOP.MISSING.PACKAGE"))
(classify-error
(loop for x being each present-symbol of "LOOP.MISSING.PACKAGE" collect x)))
package-error)
(deftest loop.7.20
(progn
(let ()
(ignore-errors (delete-package "LOOP.MISSING.PACKAGE"))
(classify-error
(loop for x being each external-symbol of "LOOP.MISSING.PACKAGE" collect x)))
......
......@@ -6,30 +6,30 @@
(in-package :cl-test)
(declaim (optimize (safety 3)))
(ignore-errors
(report-and-ignore-errors
(defpackage "A"
(:use)
(:nicknames "Q")
(:export "FOO")))
(ignore-errors
(report-and-ignore-errors
(defpackage "B"
(:use "A")
(:export "BAR")))
(ignore-errors
(report-and-ignore-errors
(defpackage "DS1"
(:use)
(:intern "C" "D")
(:export "A" "B")))
(ignore-errors
(report-and-ignore-errors
(defpackage "DS2"
(:use)
(:intern "E" "F")
(:export "G" "H" "A")))
(ignore-errors
(report-and-ignore-errors
(defpackage "DS3"
(:shadow "B")
(:shadowing-import-from "DS1" "A")
......@@ -37,7 +37,7 @@
(:export "A" "B" "G" "I" "J" "K")
(:intern "L" "M")))
(ignore-errors
(report-and-ignore-errors
(defpackage "DS4"
(:shadowing-import-from "DS1" "B")
(:use "DS1" "DS3")
......
......@@ -49,19 +49,19 @@
;;; package-name
(deftest package-name.1
(ignore-errors (package-name "A"))
(let () (ignore-errors (package-name "A")))
"A")
(deftest package-name.2
(ignore-errors (package-name #\A))
(let () (ignore-errors (package-name #\A)))
"A")
(deftest package-name.3