Commit c5827567 authored by pfdietz's avatar pfdietz
Browse files

Added tests for (e,c)typecase where the type specifier is a class object. ...

Added tests for (e,c)typecase where the type specifier is a class object.  Tests for handler-bind; stub file for tests for handler-case.  More subtypep tests on array types.
parent e3674151
Loading
Loading
Loading
Loading
+7 −0
Original line number Diff line number Diff line
@@ -1419,3 +1419,10 @@ the condition to go uncaught if it cannot be classified."
(defun frob-simple-warning (c expected-fmt &rest expected-args)
  (and (typep c 'simple-warning)
       (apply #'frob-simple-condition c expected-fmt expected-args)))

(defparameter *array-element-types*
  '(t (integer 0 0)
      bit (unsigned-byte 8) (unsigned-byte 16)
      (unsigned-byte 32) float short-float
      single-float double-float long-float
      nil character base-char symbol boolean null))
+8 −0
Original line number Diff line number Diff line
@@ -78,3 +78,11 @@
;;; (deftest ctypecase.error.1
;;;  (classify-error (ctypecase))
;;;  program-error)


(deftest ctypecase.13
  (ctypecase 'a
	     (number 'bad)
	     (#.(find-class 'symbol nil) 'good))
  good)
+7 −0
Original line number Diff line number Diff line
@@ -52,3 +52,10 @@
(deftest etypecase.11
  (etypecase 1 (integer) (t 'a))
  nil)

(deftest etypecase.12
  (etypecase 'a
    (number 'bad)
    (#.(find-class 'symbol nil) 'good))
  good)
+44 −0
Original line number Diff line number Diff line
@@ -89,6 +89,50 @@
      (error "an error"))))
  good)

(deftest handler-bind.13
  (handler-bind
   ((error #'(lambda (c) (declare (ignore c))
	       (throw 'done 'good))))
   (catch 'done
     (error "an error")))
  good)

(deftest handler-bind.14
  (catch 'done
    (handler-bind
     ((symbol #'identity)  ;; can never succeed
      (error #'(lambda (c) (declare (ignore c))
		 (throw 'done 'good))))
     (error "an error")))
  good)

(deftest handler-bind.15
  (catch 'done
    (handler-bind
     ((t #'(lambda (c) (declare (ignore c))
	     (throw 'done 'good))))
     (error "an error")))
  good)

(deftest handler-bind.16
  (catch 'done
    (handler-bind
     (((not error) #'identity)
      (error
       #'(lambda (c) (declare (ignore c))
	   (throw 'done 'good))))
     (error "an error")))
  good)

(deftest handler-bind.17
  (catch 'done
    (handler-bind
     ((#.(find-class 'error)
	 #'(lambda (c) (declare (ignore c))
	     (throw 'done 'good))))
     (error "an error")))
  good)

;;; More handler-bind tests elsewhere


+9 −0
Original line number Diff line number Diff line
;-*- Mode:     Lisp -*-
;;;; Author:   Paul Dietz
;;;; Created:  Sat Mar  1 14:08:07 2003
;;;; Contains: Tests of HANDLER-CASE

(in-package :cl-test)

;;; (deftest handler-case.1
;;;   (handler-case ((
Loading