diff --git a/test-suite/ChangeLog b/test-suite/ChangeLog
index c095c6c5f..29ab92c83 100644
--- a/test-suite/ChangeLog
+++ b/test-suite/ChangeLog
@@ -1,3 +1,8 @@
+2006-02-04  Neil Jerram  <neil@ossau.uklinux.net>
+
+	* tests/exceptions.test: 19 new test cases.
+	(throw-test): New macro for testing catches and throw handlers.
+
 2006-02-04  Kevin Ryde  <user42@zip.com.au>
 
 	* standalone/test-list.c: New file.
diff --git a/test-suite/tests/exceptions.test b/test-suite/tests/exceptions.test
index db52126b6..565cc8fea 100644
--- a/test-suite/tests/exceptions.test
+++ b/test-suite/tests/exceptions.test
@@ -18,6 +18,19 @@
 
 (use-modules (test-suite lib))
 
+(define-macro (throw-test title result . exprs)
+  `(pass-if ,title
+     (equal? ,result
+	     (letrec ((stack '())
+		      (push (lambda (val)
+			      (set! stack (cons val stack)))))
+	       (begin ,@exprs)
+	       ;;(display ,title)
+	       ;;(display ": ")
+	       ;;(write (reverse stack))
+	       ;;(newline)
+	       (reverse stack)))))
+
 (with-test-prefix "throw/catch"
 
   (with-test-prefix "wrong type argument"
@@ -60,7 +73,385 @@
       exception:wrong-num-args
       (catch 'a
 	(lambda () (throw 'a))
-	(lambda (x y . rest) #f)))))
+	(lambda (x y . rest) #f))))
+
+  (with-test-prefix "with lazy handler"
+
+    (pass-if "lazy fluid state"
+      (equal? '(inner outer arg)
+       (let ((fluid-parm (make-fluid))
+	     (inner-val #f))
+	 (fluid-set! fluid-parm 'outer)
+	 (catch 'misc-exc
+	   (lambda ()
+	     (with-fluids ((fluid-parm 'inner))
+	       (throw 'misc-exc 'arg)))
+	   (lambda (key . args)
+	     (list inner-val
+		   (fluid-ref fluid-parm)
+		   (car args)))
+	   (lambda (key . args)
+	     (set! inner-val (fluid-ref fluid-parm))))))))
+
+  (throw-test "normal catch"
+	      '(1 2)
+	      (catch 'a
+		     (lambda ()
+		       (push 1)
+		       (throw 'a))
+		     (lambda (key . args)
+		       (push 2))))
+
+  (throw-test "catch and lazy catch"
+	      '(1 2 3 4)
+	      (catch 'a
+		     (lambda ()
+		       (push 1)
+		       (lazy-catch 'a
+				   (lambda ()
+				     (push 2)
+				     (throw 'a))
+				   (lambda (key . args)
+				     (push 3))))
+		     (lambda (key . args)
+		       (push 4))))
+
+  (throw-test "catch with rethrowing lazy catch handler"
+	      '(1 2 3 4)
+	      (catch 'a
+		     (lambda ()
+		       (push 1)
+		       (lazy-catch 'a
+				   (lambda ()
+				     (push 2)
+				     (throw 'a))
+				   (lambda (key . args)
+				     (push 3)
+				     (apply throw key args))))
+		     (lambda (key . args)
+		       (push 4))))
+
+  (throw-test "catch with pre-unwind handler"
+	      '(1 3 2)
+	      (catch 'a
+		     (lambda ()
+		       (push 1)
+		       (throw 'a))
+		     (lambda (key . args)
+		       (push 2))
+		     (lambda (key . args)
+		       (push 3))))
+
+  (throw-test "catch with rethrowing pre-unwind handler"
+	      '(1 3 2)
+	      (catch 'a
+		     (lambda ()
+		       (push 1)
+		       (throw 'a))
+		     (lambda (key . args)
+		       (push 2))
+		     (lambda (key . args)
+		       (push 3)
+		       (apply throw key args))))
+
+  (throw-test "catch with throw handler"
+	      '(1 2 3 4)
+	      (catch 'a
+		     (lambda ()
+		       (push 1)
+		       (with-throw-handler 'a
+					   (lambda ()
+					     (push 2)
+					     (throw 'a))
+					   (lambda (key . args)
+					     (push 3))))
+		     (lambda (key . args)
+		       (push 4))))
+
+  (throw-test "catch with rethrowing throw handler"
+	      '(1 2 3 4)
+	      (catch 'a
+		     (lambda ()
+		       (push 1)
+		       (with-throw-handler 'a
+					   (lambda ()
+					     (push 2)
+					     (throw 'a))
+					   (lambda (key . args)
+					     (push 3)
+					     (apply throw key args))))
+		     (lambda (key . args)
+		       (push 4))))
+
+  (throw-test "effect of lazy-catch unwinding on throw to another key"
+	      '(1 2 3 5 7)
+	      (catch 'a
+		     (lambda ()
+		       (push 1)
+		       (lazy-catch 'b
+				   (lambda ()
+				     (push 2)
+				     (catch 'a
+					    (lambda ()
+					      (push 3)
+					      (throw 'b))
+					    (lambda (key . args)
+					      (push 4))))
+				   (lambda (key . args)
+				     (push 5)
+				     (throw 'a)))
+		       (push 6))
+		     (lambda (key . args)
+		       (push 7))))
+
+  (throw-test "effect of with-throw-handler not-unwinding on throw to another key"
+	      '(1 2 3 5 4 6)
+	      (catch 'a
+		     (lambda ()
+		       (push 1)
+		       (with-throw-handler 'b
+				   (lambda ()
+				     (push 2)
+				     (catch 'a
+					    (lambda ()
+					      (push 3)
+					      (throw 'b))
+					    (lambda (key . args)
+					      (push 4))))
+				   (lambda (key . args)
+				     (push 5)
+				     (throw 'a)))
+		       (push 6))
+		     (lambda (key . args)
+		       (push 7))))
+
+  (throw-test "lazy-catch chaining"
+	      '(1 2 3 4 6 8)
+	      (catch 'a
+	        (lambda ()
+		  (push 1)
+		  (lazy-catch 'a
+		    (lambda ()
+		      (push 2)
+		      (lazy-catch 'a
+                        (lambda ()
+			  (push 3)
+			  (throw 'a))
+			(lambda (key . args)
+			  (push 4)))
+		      (push 5))
+		    (lambda (key . args)
+		      (push 6)))
+		  (push 7))
+		(lambda (key . args)
+		  (push 8))))
+
+  (throw-test "with-throw-handler chaining"
+	      '(1 2 3 4 6 8)
+	      (catch 'a
+	        (lambda ()
+		  (push 1)
+		  (with-throw-handler 'a
+		    (lambda ()
+		      (push 2)
+		      (with-throw-handler 'a
+                        (lambda ()
+			  (push 3)
+			  (throw 'a))
+			(lambda (key . args)
+			  (push 4)))
+		      (push 5))
+		    (lambda (key . args)
+		      (push 6)))
+		  (push 7))
+		(lambda (key . args)
+		  (push 8))))
+
+  (throw-test "with-throw-handler inside lazy-catch"
+	      '(1 2 3 4 6 8)
+	      (catch 'a
+	        (lambda ()
+		  (push 1)
+		  (lazy-catch 'a
+		    (lambda ()
+		      (push 2)
+		      (with-throw-handler 'a
+                        (lambda ()
+			  (push 3)
+			  (throw 'a))
+			(lambda (key . args)
+			  (push 4)))
+		      (push 5))
+		    (lambda (key . args)
+		      (push 6)))
+		  (push 7))
+		(lambda (key . args)
+		  (push 8))))
+
+  (throw-test "lazy-catch inside with-throw-handler"
+	      '(1 2 3 4 6 8)
+	      (catch 'a
+	        (lambda ()
+		  (push 1)
+		  (with-throw-handler 'a
+		    (lambda ()
+		      (push 2)
+		      (lazy-catch 'a
+                        (lambda ()
+			  (push 3)
+			  (throw 'a))
+			(lambda (key . args)
+			  (push 4)))
+		      (push 5))
+		    (lambda (key . args)
+		      (push 6)))
+		  (push 7))
+		(lambda (key . args)
+		  (push 8))))
+
+  (throw-test "throw handlers throwing to each other recursively"
+	      '(1 2 3 4 8 6 10 12)
+	      (catch #t
+                (lambda ()
+		  (push 1)
+		  (with-throw-handler 'a
+                    (lambda ()
+		      (push 2)
+		      (with-throw-handler 'b
+		        (lambda ()
+			  (push 3)
+			  (with-throw-handler 'c
+			    (lambda ()
+			      (push 4)
+			      (throw 'b)
+			      (push 5))
+			    (lambda (key . args)
+			      (push 6)
+			      (throw 'a)))
+			  (push 7))
+			(lambda (key . args)
+			  (push 8)
+			  (throw 'c)))
+		      (push 9))
+		    (lambda (key . args)
+		      (push 10)
+		      (throw 'b)))
+		  (push 11))
+		(lambda (key . args)
+		  (push 12))))
+
+  (throw-test "repeat of previous test but with lazy-catch"
+	      '(1 2 3 4 8 12)
+	      (catch #t
+                (lambda ()
+		  (push 1)
+		  (lazy-catch 'a
+                    (lambda ()
+		      (push 2)
+		      (lazy-catch 'b
+		        (lambda ()
+			  (push 3)
+			  (lazy-catch 'c
+			    (lambda ()
+			      (push 4)
+			      (throw 'b)
+			      (push 5))
+			    (lambda (key . args)
+			      (push 6)
+			      (throw 'a)))
+			  (push 7))
+			(lambda (key . args)
+			  (push 8)
+			  (throw 'c)))
+		      (push 9))
+		    (lambda (key . args)
+		      (push 10)
+		      (throw 'b)))
+		  (push 11))
+		(lambda (key . args)
+		  (push 12))))
+
+  (throw-test "throw handler throwing to lexically inside catch"
+	      '(1 2 7 5 4 6 9)
+	      (with-throw-handler 'a
+				  (lambda ()
+				    (push 1)
+				    (catch 'b
+					   (lambda ()
+					     (push 2)
+					     (throw 'a)
+					     (push 3))
+					   (lambda (key . args)
+					     (push 4))
+					   (lambda (key . args)
+					     (push 5)))
+				    (push 6))
+				  (lambda (key . args)
+				    (push 7)
+				    (throw 'b)
+				    (push 8)))
+	      (push 9))
+
+  (throw-test "reuse of same throw handler after lexically inside catch"
+	      '(0 1 2 7 5 4 6 7 10)
+	      (catch 'b
+	        (lambda ()
+		  (push 0)
+		  (with-throw-handler 'a
+		    (lambda ()
+		      (push 1)
+		      (catch 'b
+		        (lambda ()
+			  (push 2)
+			  (throw 'a)
+			  (push 3))
+			(lambda (key . args)
+			  (push 4))
+			(lambda (key . args)
+			  (push 5)))
+		      (push 6)
+		      (throw 'a))
+		    (lambda (key . args)
+		      (push 7)
+		      (throw 'b)
+		      (push 8)))
+		  (push 9))
+		(lambda (key . args)
+		  (push 10))))
+
+  (throw-test "again but with two chained throw handlers"
+	      '(0 1 11 2 13 7 5 4 12 13 7 10)
+	      (catch 'b
+	        (lambda ()
+		  (push 0)
+		  (with-throw-handler 'a
+		    (lambda ()
+		      (push 1)
+		      (with-throw-handler 'a
+		        (lambda ()
+			  (push 11)
+			  (catch 'b
+			    (lambda ()
+			      (push 2)
+			      (throw 'a)
+			      (push 3))
+			    (lambda (key . args)
+			      (push 4))
+			    (lambda (key . args)
+			      (push 5)))
+			  (push 12)
+			  (throw 'a))
+			(lambda (key . args)
+			  (push 13)))
+		      (push 6))
+		    (lambda (key . args)
+		      (push 7)
+		      (throw 'b)))
+		  (push 9))
+		(lambda (key . args)
+		  (push 10))))
+
+  )
 
 (with-test-prefix "false-if-exception"