Commit 66d3fa5a authored by pfdietz's avatar pfdietz
Browse files

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 -*- ;-*- Mode: Lisp -*-
;;;; Copyright 1998 Motorola, Inc. All right reserved.
;;;; Motorola Internal Use Only.
;;;;
;;;; Author: Paul Dietz ;;;; Author: Paul Dietz
;;;; Created: Sat Mar 7 10:32:13 1998 ;;;; Created: Tue Dec 17 21:10:53 2002
;;;; Contains: Package definition for RT system (new form) ;;;; Contains: Package definition for RT
(eval-when (eval-when
;;(:execute :compile-toplevel :load-toplevel) ;;(:execute :compile-toplevel :load-toplevel)
(load eval compile) (load eval compile)
(defpackage :rt (defpackage :rt
(:nicknames)
(:use :cl) (:use :cl)
(:export (:export
"DEFTEST" "GET-TEST" "DO-TEST" "REM-TEST" "*DO-TESTS-WHEN-DEFINED*"
"REM-ALL-TESTS" "DO-TESTS" "PENDING-TESTS" "*TEST*"
"CONTINUE-TESTING" "*TEST*" "*DO-TESTS-WHEN-DEFINED*"))) "CONTINUE-TESTING"
"DEFTEST"
"DO-TEST"
"DO-TESTS"
"GET-TEST"
"PENDING-TESTS"
"REM-ALL-TESTS"
"REM-TEST"
)))
(in-package :rt) (in-package :rt)
...@@ -31,6 +31,8 @@ ...@@ -31,6 +31,8 @@
(defvar *in-test* nil "Used by TEST") (defvar *in-test* nil "Used by TEST")
(defvar *debug* nil "For debugging") (defvar *debug* nil "For debugging")
(defvar *catch-errors* t "When true, causes errors in a test to be caught.") (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) (defstruct (entry (:conc-name nil)
(:type list)) (:type list))
...@@ -136,17 +138,18 @@ ...@@ -136,17 +138,18 @@
(or aborted (or aborted
(not (equalp-with-case r (vals entry))))) (not (equalp-with-case r (vals entry)))))
(when (pend entry) (when (pend entry)
(format s "~&Test ~:@(~S~) failed~ (let ((*print-circle* *print-circle-on-failure*))
(format s "~&Test ~:@(~S~) failed~
~%Form: ~S~ ~%Form: ~S~
~%Expected value~P: ~ ~%Expected value~P: ~
~{~S~^~%~17t~}~%" ~{~S~^~%~17t~}~%"
*test* (form entry) *test* (form entry)
(length (vals entry)) (length (vals entry))
(vals entry)) (vals entry))
(format s "Actual value~P: ~ (format s "Actual value~P: ~
~{~S~^~%~15t~}.~%" ~{~S~^~%~15t~}.~%"
(length r) r)))) (length r) r)))))
(when (not (pend entry)) *test*)) (when (not (pend entry)) *test*))
(defun continue-testing () (defun continue-testing ()
(if *in-test* (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