* tests/eval.test (promises)[unmemoizing a promise]: New test.

* tests/continuations.test ("continuations"): Use
with-debugging-evaluator.

* standalone/test-use-srfi: Use -q to avoid picking up the user's
~/.guile file

* lib.scm (with-debugging-evaluator*, with-debugging-evaluator):
New utilities.

test-suite/ChangeLog

@@ -1,3 +1,16 @@
+2007-10-19  Neil Jerram  <neil@ossau.uklinux.net>
+
+	* tests/eval.test (promises)[unmemoizing a promise]: New test.
+
+	* tests/continuations.test ("continuations"): Use
+	with-debugging-evaluator.
+
+	* standalone/test-use-srfi: Use -q to avoid picking up the user's
+	~/.guile file
+
+	* lib.scm (with-debugging-evaluator*, with-debugging-evaluator):
+	New utilities.
+
 2007-10-17  Ludovic Courtès  <ludo@gnu.org>
 
 	* tests/reader.test (reading)[CR recognized as a token

test-suite/lib.scm

@@ -42,6 +42,9 @@
  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
@@ -408,6 +411,22 @@
 (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)))
+
+
 
 ;;;; REPORTERS
 ;;;;

test-suite/standalone/test-use-srfi

@@ -19,14 +19,14 @@
 
 # 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
 
@@ -38,7 +38,7 @@ 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))
@@ -47,7 +47,7 @@ guile --use-srfi=1 >/dev/null <<EOF
 (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
 
@@ -56,12 +56,12 @@ 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

test-suite/tests/continuations.test

@@ -53,8 +53,7 @@
   (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)))
@@ -64,8 +63,6 @@
 	(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))))
 
 )

test-suite/tests/eval.test

@@ -294,7 +294,23 @@
 
     (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