From 507a80a062168b9407ef0957eabba07b31c30a40 Mon Sep 17 00:00:00 2001 From: "Robert P. Goldman" Date: Mon, 8 Nov 2021 12:25:25 -0600 Subject: [PATCH] Add *on-warning*. Permit tests to throw into the debugger or generate a backtrace on warning conditions. --- src/run.lisp | 17 +++++++++++++++++ 1 file changed, 17 insertions(+) diff --git a/src/run.lisp b/src/run.lisp index 30ae199..6ee254e 100644 --- a/src/run.lisp +++ b/src/run.lisp @@ -38,6 +38,12 @@ (declaim (type on-problem-action *on-error* *on-failure*)) +(defvar *on-warning* nil + "The action to perform on warning: +- :DEBUG if we should drop into the debugger +- :BACKTRACE to print a backtrace +- NIL to simply continue") + (defvar *on-error* nil "The action to perform on error: - :DEBUG if we should drop into the debugger @@ -190,6 +196,17 @@ run.")) *test-dribble*)) (invoke-restart (find-restart 'ignore-failure)))))) + (warning (lambda (c) + (ecase *on-warning* + (:debug (invoke-debugger c)) + (:backtrace + (format t "~&WARNING: ~a~%" c) + (trivial-backtrace:print-backtrace-to-stream + *test-dribble*) + (continue c)) + ((nil) + (format t "~&WARNING: ~a~%" c) + (continue c))))) (error (lambda (e) (unless (or (eql *on-error* :debug) (typep e 'check-failure))