summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorAndy Wingo <wingo@pobox.com>2014-03-15 19:30:26 +0100
committerAndy Wingo <wingo@pobox.com>2014-03-15 19:41:03 +0100
commitf57d4316c2048f0c58a47c56b63d25d10511f98f (patch)
tree57d0a6cb3a250900451a373484be45c2f561e1cb
parent4189a5c0bd4c235c383b043bef69dc66a7ef64d0 (diff)
downloadguile-f57d4316c2048f0c58a47c56b63d25d10511f98f.tar.gz
Add call-with-stack-overflow-handler tests
* test-suite/tests/eval.test ("stack overflow handlers"): Add call-with-stack-overflow-handler tests, replacing the old stack overflow test.
-rw-r--r--test-suite/tests/eval.test93
1 files changed, 86 insertions, 7 deletions
diff --git a/test-suite/tests/eval.test b/test-suite/tests/eval.test
index 3fc1d9444..10d26690b 100644
--- a/test-suite/tests/eval.test
+++ b/test-suite/tests/eval.test
@@ -18,7 +18,7 @@
(define-module (test-suite test-eval)
:use-module (test-suite lib)
:use-module ((srfi srfi-1) :select (unfold count))
- :use-module ((system vm vm) :select (call-with-vm))
+ :use-module ((system vm vm) :select (call-with-stack-overflow-handler))
:use-module (ice-9 documentation)
:use-module (ice-9 local-eval))
@@ -442,13 +442,92 @@
;;; stack overflow handling
;;;
-(with-test-prefix "stack overflow"
+(with-test-prefix "stack overflow handlers"
+ (define (trigger-overflow)
+ (trigger-overflow)
+ (error "not reached"))
+
+ (define (dynwind-test n)
+ (catch 'foo
+ (lambda ()
+ (call-with-stack-overflow-handler n
+ (lambda ()
+ (dynamic-wind (lambda () #t)
+ trigger-overflow
+ trigger-overflow))
+ (lambda ()
+ (throw 'foo))))
+ (lambda _ #t)))
+
+ (pass-if-exception "limit should be number"
+ exception:wrong-type-arg
+ (call-with-stack-overflow-handler #t
+ trigger-overflow trigger-overflow))
- ;; FIXME: this test does not test what it is intending to test
- (pass-if-exception "exception raised"
- exception:vm-error
- (let ((thunk (let loop () (cons 's (loop)))))
- (call-with-vm thunk))))
+ (pass-if-exception "limit should be exact integer"
+ exception:wrong-type-arg
+ (call-with-stack-overflow-handler 2.0
+ trigger-overflow trigger-overflow))
+
+ (pass-if-exception "limit should be nonnegative"
+ exception:out-of-range
+ (call-with-stack-overflow-handler -1
+ trigger-overflow trigger-overflow))
+
+ (pass-if-exception "limit should be positive"
+ exception:out-of-range
+ (call-with-stack-overflow-handler 0
+ trigger-overflow trigger-overflow))
+
+ (pass-if-exception "limit should be within address space"
+ exception:out-of-range
+ (call-with-stack-overflow-handler (ash 1 64)
+ trigger-overflow trigger-overflow))
+
+ (pass-if "exception on overflow"
+ (catch 'foo
+ (lambda ()
+ (call-with-stack-overflow-handler 10000
+ trigger-overflow
+ (lambda ()
+ (throw 'foo))))
+ (lambda _ #t)))
+
+ (pass-if "exception on overflow with dynwind"
+ ;; Try all limits between 1 and 200 words.
+ (let lp ((n 1))
+ (or (= n 200)
+ (and (dynwind-test n)
+ (lp (1+ n))))))
+
+ (pass-if-exception "overflow handler should return number"
+ exception:wrong-type-arg
+ (call-with-stack-overflow-handler 1000
+ trigger-overflow
+ (lambda () #t)))
+ (pass-if-exception "overflow handler should return exact integer"
+ exception:wrong-type-arg
+ (call-with-stack-overflow-handler 1000
+ trigger-overflow
+ (lambda () 2.0)))
+ (pass-if-exception "overflow handler should be nonnegative"
+ exception:out-of-range
+ (call-with-stack-overflow-handler 1000
+ trigger-overflow
+ (lambda () -1)))
+ (pass-if-exception "overflow handler should be positive"
+ exception:out-of-range
+ (call-with-stack-overflow-handler 1000
+ trigger-overflow
+ (lambda () 0)))
+
+ (letrec ((fac (lambda (n)
+ (if (zero? n) 1 (* n (fac (1- n)))))))
+ (pass-if-equal "overflow handler can allow recursion to continue"
+ (fac 10)
+ (call-with-stack-overflow-handler 1
+ (lambda () (fac 10))
+ (lambda () 1)))))
;;;
;;; docstrings