with-debugging-evaluator.
* lib.scm (with-debugging-evaluator*, with-debugging-evaluator):
New utilities.
* standalone/test-use-srfi: Use -q to avoid picking up the user's
~/.guile file.
* tests/eval.test (promises)[unmemoizing a promise]: New test.
+2007-10-21 Neil Jerram <neil@ossau.uklinux.net>
+
+ * tests/continuations.test ("continuations"): Use
+ with-debugging-evaluator.
+
+ * lib.scm (with-debugging-evaluator*, with-debugging-evaluator):
+ New utilities.
+
+ * standalone/test-use-srfi: Use -q to avoid picking up the user's
+ ~/.guile file.
+
+ * tests/eval.test (promises)[unmemoizing a promise]: New test.
+
2007-10-20 Julian Graham <joolean@gmail.com>
* tests/threads.test: Use proper `define-module'.
with-test-prefix with-test-prefix* current-test-prefix
format-test-name
+ ;; Using the debugging evaluator.
+ with-debugging-evaluator with-debugging-evaluator*
+
;; Reporting results in various ways.
register-reporter unregister-reporter reporter-registered?
make-count-reporter print-counts
(defmacro with-test-prefix (prefix . body)
`(with-test-prefix* ,prefix (lambda () ,@body)))
+;;; Call THUNK using the debugging evaluator.
+(define (with-debugging-evaluator* thunk)
+ (let ((dopts #f))
+ (dynamic-wind
+ (lambda ()
+ (set! dopts (debug-options))
+ (debug-enable 'debug))
+ thunk
+ (lambda ()
+ (debug-options dopts)))))
+
+;;; Evaluate BODY... using the debugging evaluator.
+(define-macro (with-debugging-evaluator . body)
+ `(with-debugging-evaluator* (lambda () ,@body)))
+
+
\f
;;;; REPORTERS
;;;;
# Test that two srfi numbers on the command line work.
#
-guile --use-srfi=1,10 >/dev/null <<EOF
+guile -q --use-srfi=1,10 >/dev/null <<EOF
(if (and (defined? 'partition)
(defined? 'define-reader-ctor))
(exit 0) ;; good
(exit 1)) ;; bad
EOF
if test $? = 0; then :; else
- echo "guile --user-srfi=1,10 fails to run"
+ echo "guile --use-srfi=1,10 fails to run"
exit 1
fi
# `top-repl' the core bindings got ahead of anything --use-srfi gave.
#
-guile --use-srfi=1 >/dev/null <<EOF
+guile -q --use-srfi=1 >/dev/null <<EOF
(catch #t
(lambda ()
(iota 2 3 4))
(exit 0) ;; good
EOF
if test $? = 0; then :; else
- echo "guile --user-srfi=1 doesn't give SRFI-1 iota"
+ echo "guile --use-srfi=1 doesn't give SRFI-1 iota"
exit 1
fi
# exercises duplicates handling in `top-repl' versus `use-srfis' (in
# boot-9.scm).
#
-guile --use-srfi=17 >/dev/null <<EOF
+guile -q --use-srfi=17 >/dev/null <<EOF
(if (procedure-with-setter? car)
(exit 0) ;; good
(exit 1)) ;; bad
EOF
if test $? = 0; then :; else
- echo "guile --user-srfi=17 doesn't give SRFI-17 car"
+ echo "guile --use-srfi=17 doesn't give SRFI-17 car"
exit 1
fi
(pass-if "throwing to a rewound catch context"
(eq? (dont-crash-please) 'no-reentry))
- (let ((dopts (debug-options)))
- (debug-enable 'debug)
+ (with-debugging-evaluator
(pass-if "make a stack from a continuation"
(stack? (call-with-current-continuation make-stack)))
(or (boolean? id) (symbol? id))))
(pass-if "get a continuation's innermost frame"
- (pair? (call-with-current-continuation last-stack-frame)))
-
- (debug-options dopts))
+ (pair? (call-with-current-continuation last-stack-frame))))
)
(pass-if-exception "implicit forcing is not supported"
exception:wrong-type-arg
- (+ (delay (* 3 7)) 13))))
+ (+ (delay (* 3 7)) 13))
+
+ ;; Tests that require the debugging evaluator...
+ (with-debugging-evaluator
+
+ (pass-if "unmemoizing a promise"
+ (display-backtrace
+ (let ((stack #f))
+ (false-if-exception (lazy-catch #t
+ (lambda ()
+ (let ((f (lambda (g) (delay (g)))))
+ (force (f error))))
+ (lambda _
+ (set! stack (make-stack #t)))))
+ stack)
+ (%make-void-port "w"))
+ #t))))
;;;
;;; letrec init evaluation