266 lines
11 KiB
Common Lisp
266 lines
11 KiB
Common Lisp
;;; Copyright 2013 Google Inc.
|
|
;;;
|
|
;;; Licensed under the Apache License, Version 2.0 (the "License");
|
|
;;; you may not use this file except in compliance with the License.
|
|
;;; You may obtain a copy of the License at
|
|
;;;
|
|
;;; http://www.apache.org/licenses/LICENSE-2.0
|
|
;;;
|
|
;;; Unless required by applicable law or agreed to in writing, software
|
|
;;; distributed under the License is distributed on an "AS IS" BASIS,
|
|
;;; WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
|
|
;;; See the License for the specific language governing permissions and
|
|
;;; limitations under the License.
|
|
|
|
;;; Lisp condition types are very similar to classes. The standard specifies
|
|
;;; multiple standard condition types: among them, CONDITION, WARNING,
|
|
;;; SERIOUS-CONDITION, and ERROR.
|
|
|
|
;;; The type CONDITION is the base type of all condition objects.
|
|
|
|
(define-condition my-condition () ())
|
|
|
|
;;; The type WARNING is the base type of all conditions of which the programmer
|
|
;;; should be warned, unless the condition is somehow handled by the program.
|
|
|
|
(define-condition my-warning (warning) ())
|
|
|
|
;;; The type SERIOUS-CONDITION includes programming errors and other situations
|
|
;;; where computation cannot proceed (e.g. due to memory or storage issues).
|
|
|
|
(define-condition my-serious-condition (serious-condition) ())
|
|
|
|
;;; The type ERROR is the base type for all error situations in code.
|
|
|
|
(define-condition my-error (error) ())
|
|
|
|
(define-test type-hierarchy
|
|
;; Inheritance for condition types works the same way as for classes.
|
|
(let ((condition (make-condition 'my-condition)))
|
|
(true-or-false? ____ (typep condition 'my-condition))
|
|
(true-or-false? ____ (typep condition 'condition))
|
|
(true-or-false? ____ (typep condition 'warning))
|
|
(true-or-false? ____ (typep condition 'error)))
|
|
(let ((condition (make-condition 'my-warning)))
|
|
(true-or-false? ____ (typep condition 'my-warning))
|
|
(true-or-false? ____ (typep condition 'warning))
|
|
(true-or-false? ____ (typep condition 'error)))
|
|
(let ((condition (make-condition 'my-serious-condition)))
|
|
(true-or-false? ____ (typep condition 'my-serious-condition))
|
|
(true-or-false? ____ (typep condition 'serious-condition))
|
|
(true-or-false? ____ (typep condition 'warning))
|
|
(true-or-false? ____ (typep condition 'error)))
|
|
(let ((condition (make-condition 'my-error)))
|
|
(true-or-false? ____ (typep condition 'my-error))
|
|
(true-or-false? ____ (typep condition 'my-serious-condition))
|
|
(true-or-false? ____ (typep condition 'serious-condition))
|
|
(true-or-false? ____ (typep condition 'warning))
|
|
(true-or-false? ____ (typep condition 'error))))
|
|
|
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
|
|
;;; A condition handler is composed of a handler function that accepts a
|
|
;;; condition object and a condition type for which the function will be called.
|
|
|
|
(defvar *list*)
|
|
|
|
(define-condition silly-condition () ())
|
|
|
|
(define-condition very-silly-condition (silly-condition) ())
|
|
|
|
(define-condition most-silly-condition (very-silly-condition) ())
|
|
|
|
(defun handle-silly-condition (condition)
|
|
(declare (ignore condition))
|
|
(push :silly-condition *list*))
|
|
|
|
(defun handle-very-silly-condition (condition)
|
|
(declare (ignore condition))
|
|
(push :very-silly-condition *list*))
|
|
|
|
(defun handle-most-silly-condition (condition)
|
|
(declare (ignore condition))
|
|
(push :most-silly-condition *list*))
|
|
|
|
(define-test handler-bind
|
|
;; When a condition is signaled, all handlers whose type matches the
|
|
;; condition's type are allowed to execute.
|
|
(let ((*list* '()))
|
|
(handler-bind ((very-silly-condition #'handle-very-silly-condition)
|
|
(silly-condition #'handle-silly-condition)
|
|
(most-silly-condition #'handle-most-silly-condition))
|
|
(signal (make-condition 'most-silly-condition)))
|
|
(assert-equal ____ *list*)))
|
|
|
|
(define-test handler-order
|
|
;; The order of binding handlers matters.
|
|
(let ((*list* '()))
|
|
(handler-bind ((silly-condition #'handle-silly-condition)
|
|
(very-silly-condition #'handle-very-silly-condition)
|
|
(most-silly-condition #'handle-most-silly-condition))
|
|
(signal (make-condition 'most-silly-condition)))
|
|
(assert-equal ____ *list*)))
|
|
|
|
(define-test multiple-handler-binds
|
|
;; It is possible to bind handlers in steps.
|
|
(let ((*list* '()))
|
|
(handler-bind ((silly-condition #'handle-silly-condition)
|
|
(most-silly-condition #'handle-most-silly-condition))
|
|
(handler-bind ((very-silly-condition #'handle-very-silly-condition))
|
|
(signal (make-condition 'most-silly-condition))))
|
|
(assert-equal ____ *list*)))
|
|
|
|
(define-test same-handler
|
|
;; The same handler may be bound multiple times.
|
|
(let ((*list* '()))
|
|
(handler-bind ((silly-condition #'handle-silly-condition)
|
|
(silly-condition #'handle-silly-condition))
|
|
(handler-bind ((very-silly-condition #'handle-very-silly-condition)
|
|
(silly-condition #'handle-silly-condition)
|
|
(very-silly-condition #'handle-very-silly-condition))
|
|
(signal (make-condition 'most-silly-condition))))
|
|
(assert-equal ____ *list*)))
|
|
|
|
(define-test handler-types
|
|
;; A handler is not executed if it does not match the condition type.
|
|
(let ((*list* '()))
|
|
(handler-bind ((silly-condition #'handle-silly-condition)
|
|
(very-silly-condition #'handle-very-silly-condition)
|
|
(most-silly-condition #'handle-most-silly-condition))
|
|
(signal (make-condition 'very-silly-condition)))
|
|
(assert-equal ____ *list*)))
|
|
|
|
(define-test handler-transfer-of-control
|
|
;; A handler may decline to handle the condition if it returns normally,
|
|
;; or it may handle the condition by transferring control elsewhere.
|
|
(let ((*list* '()))
|
|
(block my-block
|
|
(handler-bind ((silly-condition #'handle-silly-condition)
|
|
(silly-condition (lambda (condition)
|
|
(declare (ignore condition))
|
|
(return-from my-block)))
|
|
(silly-condition #'handle-silly-condition))
|
|
(signal (make-condition 'silly-condition))))
|
|
(assert-equal ____ *list*)))
|
|
|
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
|
|
(defun handle-error (condition)
|
|
(declare (ignore condition))
|
|
(push :error *list*))
|
|
|
|
(define-condition my-error (error) ())
|
|
|
|
(defun handle-my-error (condition)
|
|
(declare (ignore condition))
|
|
(push :my-error *list*))
|
|
|
|
(define-test handler-case
|
|
;; HANDLER-CASE always transfers control before executing the case forms.
|
|
(let ((*list* '()))
|
|
(handler-case (signal (make-condition 'my-error))
|
|
(error (condition) (handle-error condition))
|
|
(my-error (condition) (handle-my-error condition)))
|
|
(assert-equal ____ *list*)))
|
|
|
|
(define-test handler-case-order
|
|
;; The order of handler cases matters.
|
|
(let ((*list* '()))
|
|
(handler-case (signal (make-condition 'my-error))
|
|
(my-error (condition) (handle-my-error condition))
|
|
(error (condition) (handle-error condition)))
|
|
(assert-equal ____ *list*)))
|
|
|
|
(define-test handler-case-type
|
|
;; A handler cases is not executed if it does not match the condition type.
|
|
(let ((*list* '()))
|
|
(handler-case (signal (make-condition 'error))
|
|
(my-error (condition) (handle-my-error condition))
|
|
(error (condition) (handle-error condition)))
|
|
(assert-equal ____ *list*)))
|
|
|
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
|
|
(defun divide (numerator denominator)
|
|
(/ numerator denominator))
|
|
|
|
(define-test error-signaling
|
|
;; ASSERT-ERROR is a Lisp Koans macro which verifies that the correct error
|
|
;; type is signaled.
|
|
(assert-equal 3 (divide 6 2))
|
|
(assert-error (divide 6 0) 'division-by-zero)
|
|
(assert-error (divide 6 :zero) 'type-error))
|
|
|
|
(define-test error-signaling-handler-case
|
|
(flet ((try-to-divide (numerator denominator)
|
|
;; In code outside Lisp Koans, HANDLER-CASE should be used.
|
|
(handler-case (divide numerator denominator)
|
|
(division-by-zero () :division-by-zero)
|
|
(type-error () :type-error))))
|
|
(assert-equal ____ (try-to-divide 6 2))
|
|
(assert-equal ____ (try-to-divide 6 0))
|
|
(assert-equal ____ (try-to-divide 6 :zero))))
|
|
|
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
|
|
;;; Condition objects can contain metadata about the specific situation that
|
|
;;; occurred in the code.
|
|
|
|
(define-test accessors-division-by-zero
|
|
(let ((condition (handler-case (divide 6 0) (division-by-zero (c) c))))
|
|
;; Disabled on CLISP and ABCL due to conformance bugs.
|
|
;; See https://gitlab.com/gnu-clisp/clisp/-/issues/22
|
|
;; See https://github.com/armedbear/abcl/issues/177
|
|
#-(or clisp abcl)
|
|
(assert-equal ____ (arithmetic-error-operands condition))
|
|
(let ((operation (arithmetic-error-operation condition)))
|
|
;; Disabled on ABCL due to a conformance bug.
|
|
;; See https://github.com/armedbear/abcl/issues/177
|
|
#-abcl
|
|
(assert-equal ____ (funcall operation 12 4)))))
|
|
|
|
(define-test accessors-type-error
|
|
(let ((condition (handler-case (divide 6 :zero) (type-error (c) c))))
|
|
(assert-equal ____ (type-error-datum condition))
|
|
(let ((expected-type (type-error-expected-type condition)))
|
|
(true-or-false? ____ (typep :zero expected-type))
|
|
(true-or-false? ____ (typep 0 expected-type))
|
|
(true-or-false? ____ (typep "zero" expected-type))
|
|
(true-or-false? ____ (typep 0.0 expected-type)))))
|
|
|
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
|
|
;; We can define slots in our own condition types in a way that is similar to
|
|
;; DEFCLASS.
|
|
|
|
(define-condition parse-log-line-error (parse-error)
|
|
((line :initarg :line :reader line)
|
|
(reason :initarg :reason :reader reason)))
|
|
|
|
(defun log-line-type (line)
|
|
;; The macro CHECK-TYPE signals a TYPE-ERROR if the object is not of the
|
|
;; specified type.
|
|
(check-type line string)
|
|
(cond ((eql 0 (search "TIMESTAMP" line)) :timestamp)
|
|
((eql 0 (search "HTTP" line)) :http)
|
|
((eql 0 (search "LOGIN" line)) :login)
|
|
;; The function ERROR should be used for signaling serious conditions
|
|
;; and errors: if the condition is not handled, it halts program
|
|
;; execution and starts the Lisp debugger.
|
|
(t (error 'parse-log-line-error :line line
|
|
:reason :unknown-log-line-type))))
|
|
|
|
(define-test log-line-type-errors
|
|
(flet ((try-log-line-type (line)
|
|
(handler-case (log-line-type line)
|
|
(error (condition) condition))))
|
|
(assert-equal ____ (try-log-line-type "TIMESTAMP 2020-05-08 16:59:39"))
|
|
(assert-equal ____ (try-log-line-type "HTTP GET / from 127.0.0.1"))
|
|
(assert-equal ____ (try-log-line-type "LOGIN administrator:hunter2"))
|
|
(let ((condition (try-log-line-type "WARNING: 95% of disk space used")))
|
|
(assert-equal ____ (line condition))
|
|
(assert-equal ____ (reason condition)))
|
|
(let ((condition (try-log-line-type 5555)))
|
|
(assert-equal 'string (____ condition))
|
|
(assert-equal 5555 (____ condition)))))
|