diff --git a/knots/parallelism.scm b/knots/parallelism.scm index a3b04c7..c98ca3f 100644 --- a/knots/parallelism.scm +++ b/knots/parallelism.scm @@ -217,9 +217,9 @@ (if (null? active-channels) (map (match-lambda - ((#f . ('exception exn)) + ((#f . ('exception exn)) (raise-exception exn)) - ((#f . ('result val)) + ((#f . ('result val)) val)) channels-to-results) (loop diff --git a/knots/resource-pool.scm b/knots/resource-pool.scm index e55bdac..7da76b0 100644 --- a/knots/resource-pool.scm +++ b/knots/resource-pool.scm @@ -74,7 +74,7 @@ (record-constructor &resource-pool-abort-add-resource)) (define resource-pool-abort-add-resource-error? - (record-predicate &resource-pool-abort-add-resource)) + (exception-predicate &resource-pool-abort-add-resource)) (define-record-type (make-resource-pool-record name channel destroy-condition configuration) @@ -1196,7 +1196,7 @@ (record-constructor &resource-pool-timeout)) (define resource-pool-timeout-error? - (record-predicate &resource-pool-timeout)) + (exception-predicate &resource-pool-timeout)) (define &resource-pool-too-many-waiters (make-exception-type '&recource-pool-too-many-waiters @@ -1217,7 +1217,7 @@ (record-constructor &resource-pool-too-many-waiters)) (define resource-pool-too-many-waiters-error? - (record-predicate &resource-pool-too-many-waiters)) + (exception-predicate &resource-pool-too-many-waiters)) (define &resource-pool-destroyed (make-exception-type '&recource-pool-destroyed @@ -1233,7 +1233,7 @@ (record-constructor &resource-pool-destroyed)) (define resource-pool-destroyed-error? - (record-predicate &resource-pool-destroyed)) + (exception-predicate &resource-pool-destroyed)) (define &resource-pool-destroy-resource (make-exception-type '&recource-pool-destroy-resource @@ -1244,7 +1244,7 @@ (record-constructor &resource-pool-destroy-resource)) (define resource-pool-destroy-resource-exception? - (record-predicate &resource-pool-destroy-resource)) + (exception-predicate &resource-pool-destroy-resource)) (define resource-pool-default-timeout-handler (make-parameter #f)) diff --git a/knots/thread-pool.scm b/knots/thread-pool.scm index b176162..70d7292 100644 --- a/knots/thread-pool.scm +++ b/knots/thread-pool.scm @@ -198,7 +198,7 @@ from there, or #f if that would be an empty string." (record-accessor &thread-pool-timeout-error 'pool))) (define thread-pool-timeout-error? - (record-predicate &thread-pool-timeout-error)) + (exception-predicate &thread-pool-timeout-error)) (define* (make-fixed-size-thread-pool size #:key diff --git a/knots/timeout.scm b/knots/timeout.scm index 58306e0..a65a095 100644 --- a/knots/timeout.scm +++ b/knots/timeout.scm @@ -85,7 +85,7 @@ (record-constructor &port-timeout-error)) (define port-timeout-error? - (record-predicate &port-timeout-error)) + (exception-predicate &port-timeout-error)) (define &port-read-timeout-error (make-exception-type '&port-read-timeout-error @@ -96,7 +96,7 @@ (record-constructor &port-read-timeout-error)) (define port-read-timeout-error? - (record-predicate &port-read-timeout-error)) + (exception-predicate &port-read-timeout-error)) (define &port-write-timeout-error (make-exception-type '&port-write-timeout-error @@ -107,7 +107,7 @@ (record-constructor &port-write-timeout-error)) (define port-write-timeout-error? - (record-predicate &port-write-timeout-error)) + (exception-predicate &port-write-timeout-error)) (define (readable? port) "Test if PORT is writable." diff --git a/knots/web-server.scm b/knots/web-server.scm index 453db44..a0a3641 100644 --- a/knots/web-server.scm +++ b/knots/web-server.scm @@ -130,7 +130,7 @@ closes PORT, unless KEEP-ALIVE? is true." (record-constructor &request-body-ended-prematurely)) (define request-body-ended-prematurely-error? - (record-predicate &request-body-ended-prematurely)) + (exception-predicate &request-body-ended-prematurely)) (define (request-body-port/knots r) (cond diff --git a/tests.scm b/tests.scm index a58eff0..0cca3b4 100644 --- a/tests.scm +++ b/tests.scm @@ -1,6 +1,7 @@ (define-module (tests) #:use-module (ice-9 exceptions) #:use-module (fibers) + #:use-module (knots) #:export (run-fibers-for-tests assert-no-heap-growth)) @@ -15,9 +16,10 @@ (simple-format #t "running ~A\n" thunk) (with-exception-handler (lambda (exn) - (backtrace) + (print-backtrace-and-exception/knots exn) (raise-exception exn)) - thunk) + (lambda () + (start-stack #t (thunk)))) #t) #:unwind? #t)) #:hz 0