From 2d04022ce290feb5eb3d59fc066b5aeed5909cbf Mon Sep 17 00:00:00 2001
From: Neil Jerram <neil@ossau.uklinux.net>
Date: Sun, 21 Oct 2007 20:45:45 +0000
Subject: [PATCH] * 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.
---
 test-suite/ChangeLog                | 13 +++++++++++++
 test-suite/lib.scm                  | 19 +++++++++++++++++++
 test-suite/standalone/test-use-srfi | 12 ++++++------
 test-suite/tests/continuations.test |  7 ++-----
 test-suite/tests/eval.test          | 18 +++++++++++++++++-
 5 files changed, 57 insertions(+), 12 deletions(-)

diff --git a/test-suite/ChangeLog b/test-suite/ChangeLog
index a48a11c12..d7bf15be9 100644
--- a/test-suite/ChangeLog
+++ b/test-suite/ChangeLog
@@ -1,3 +1,16 @@
+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'.
diff --git a/test-suite/lib.scm b/test-suite/lib.scm
index 2daf95c60..c4ddf9e7c 100644
--- a/test-suite/lib.scm
+++ b/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
 ;;;;
diff --git a/test-suite/standalone/test-use-srfi b/test-suite/standalone/test-use-srfi
index 309b3bda7..7186b5a24 100755
--- a/test-suite/standalone/test-use-srfi
+++ b/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
diff --git a/test-suite/tests/continuations.test b/test-suite/tests/continuations.test
index c1b6803cb..7d76b762b 100644
--- a/test-suite/tests/continuations.test
+++ b/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))))
 
 )
diff --git a/test-suite/tests/eval.test b/test-suite/tests/eval.test
index 519e2c0a1..b6ddb7b06 100644
--- a/test-suite/tests/eval.test
+++ b/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
-- 
2.20.1