Commit 66d3fa5a authored by pfdietz's avatar pfdietz

Rewrote rt-package.lsp to avoid possible copyright problem.

Added *print-circle-on-failure*, which when true causes the
failure report of do-test(s) to be printed with *print-circle*
bound to true.  This is disabled normally, however, since
*print-circle* is very slow on gcl (and caused at least one
mysterious stack overflow).
parent 80db50c0
;-*- Mode: Lisp -*-
;;;; Copyright 1998 Motorola, Inc. All right reserved.
;;;; Motorola Internal Use Only.
;;;; Author: Paul Dietz
;;;; Created: Sat Mar 7 10:32:13 1998
;;;; Contains: Package definition for RT system (new form)
;;;; Created: Tue Dec 17 21:10:53 2002
;;;; Contains: Package definition for RT
;;(:execute :compile-toplevel :load-toplevel)
(load eval compile)
(defpackage :rt
(:use :cl)
(in-package :rt)
......@@ -31,6 +31,8 @@
(defvar *in-test* nil "Used by TEST")
(defvar *debug* nil "For debugging")
(defvar *catch-errors* t "When true, causes errors in a test to be caught.")
(defvar *print-circle-on-failure* nil
"Failure reports are printed with *PRINT-CIRCLE* bound to this value.")
(defstruct (entry (:conc-name nil)
(:type list))
......@@ -136,17 +138,18 @@
(or aborted
(not (equalp-with-case r (vals entry)))))
(when (pend entry)
(format s "~&Test ~:@(~S~) failed~
(let ((*print-circle* *print-circle-on-failure*))
(format s "~&Test ~:@(~S~) failed~
~%Form: ~S~
~%Expected value~P: ~
*test* (form entry)
(length (vals entry))
(vals entry))
(format s "Actual value~P: ~
*test* (form entry)
(length (vals entry))
(vals entry))
(format s "Actual value~P: ~
(length r) r))))
(when (not (pend entry)) *test*))
(length r) r)))))
(when (not (pend entry)) *test*))
(defun continue-testing ()
(if *in-test*
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment