* 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.

diff --git a/test-suite/ChangeLog b/test-suite/ChangeLog
index a48a11c..d7bf15b 100644 (file)
--- 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 2daf95c..c4ddf9e 100644 (file)
--- 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)))
+
+
 \f
 ;;;; REPORTERS
 ;;;;

diff --git a/test-suite/standalone/test-use-srfi b/test-suite/standalone/test-use-srfi
index 309b3bd..7186b5a 100755 (executable)
--- 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 c1b6803..7d76b76 100644 (file)
--- 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 519e2c0..b6ddb7b 100644 (file)
--- 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