- (let (collect)
- (sb-pcl::map-all-generic-functions
- (lambda (gf)
- (let ((arg-info (sb-pcl::gf-arg-info gf)))
- (when (eq (sb-pcl::arg-info-lambda-list arg-info)
- :no-lambda-list)
- (push gf collect)))))
- (print (nreverse collect)))))
+ (let (collect)
+ (sb-pcl::map-all-generic-functions
+ (lambda (gf)
+ (let ((arg-info (sb-pcl::gf-arg-info gf)))
+ (when (eq (sb-pcl::arg-info-lambda-list arg-info)
+ :no-lambda-list)
+ (push gf collect)))))
+ (print (nreverse collect)))))
+
+;;; Regressing test for invalid slot specification error printing
+(multiple-value-bind (value err)
+ (ignore-errors (macroexpand '(defclass foo () (frob (frob bar)))))
+ (declare (ignore value))
+ (assert (typep err 'simple-condition))
+ (multiple-value-bind (value format-err)
+ (ignore-errors (apply #'format nil
+ (simple-condition-format-control err)
+ (simple-condition-format-arguments err)))
+ (declare (ignore value))
+ (assert (not format-err))))
+
+;;; another not (user-)observable behaviour: make sure that
+;;; sb-pcl::map-all-classes calls its function on each class once and
+;;; exactly once.
+(let (result)
+ (sb-pcl::map-all-classes (lambda (c) (push c result)))
+ (assert (equal result (remove-duplicates result))))
+
+;;; this one's user-observable
+(assert (typep #'(setf class-name) 'generic-function))