Have `scm_take_locale_symbol ()' return an interned symbol (fixes bug #25865).

[bpt/guile.git] / test-suite / lib.scm

diff --git a/test-suite/lib.scm b/test-suite/lib.scm
index 818a9b0..c4ddf9e 100644 (file)
--- a/test-suite/lib.scm
+++ b/test-suite/lib.scm
@@ -1,5 +1,5 @@
 ;;;; test-suite/lib.scm --- generic support for testing
-;;;; Copyright (C) 1999, 2000, 2001, 2004, 2006 Free Software Foundation, Inc.
+;;;; Copyright (C) 1999, 2000, 2001, 2004, 2006, 2007 Free Software Foundation, Inc.
 ;;;;
 ;;;; This program is free software; you can redistribute it and/or modify
 ;;;; it under the terms of the GNU General Public License as published by
@@ -29,7 +29,9 @@
  exception:wrong-num-args exception:wrong-type-arg
  exception:numerical-overflow
  exception:struct-set!-denied
+ exception:system-error
  exception:miscellaneous-error
+ exception:string-contains-nul
 
  ;; Reporting passes and failures.
  run-test
@@ -40,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
@@ -256,9 +261,16 @@
   (cons 'numerical-overflow "^Numerical overflow"))
 (define exception:struct-set!-denied
   (cons 'misc-error "^set! denied for field"))
+(define exception:system-error
+  (cons 'system-error ".*"))
 (define exception:miscellaneous-error
   (cons 'misc-error "^.*"))
 
+;; as per throw in scm_to_locale_stringn()
+(define exception:string-contains-nul
+  (cons 'misc-error "^string contains #\\\\nul character"))
+
+
 ;;; Display all parameters to the default output port, followed by a newline.
 (define (display-line . objs)
   (for-each display objs)
@@ -399,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
 ;;;;