From: Christopher Allan Webber Date: Sat, 28 Nov 2015 04:09:31 +0000 (-0600) Subject: Add (catch-8sync) stuff X-Git-Tag: v0.1.0~58 X-Git-Url: https://jxself.org/git/?a=commitdiff_plain;h=fbb1776a35db50db19fc158381e74361d6e9b789;p=8sync.git Add (catch-8sync) stuff --- diff --git a/eightsync/agenda.scm b/eightsync/agenda.scm index 68db42e..edade13 100644 --- a/eightsync/agenda.scm +++ b/eightsync/agenda.scm @@ -65,6 +65,8 @@ %port-request %run %run-at %run-delay + catch-8sync catch-%8sync + print-error-and-continue %current-agenda @@ -543,6 +545,22 @@ return the wrong thing via (%8sync) and trip themselves up." (lambda () body ...))))) +(define-syntax-rule (catch-8sync exp (handler-key handler) ...) + (catch '%8sync-caught-error + (lambda () + exp) + (lambda (_ orig-key orig-args orig-stacks) + (cond + ((or (eq? handler-key #t) + (eq? orig-key handler-key)) + (apply handler orig-stacks orig-args)) ... + (else (raise '%8sync-caught-error + orig-key orig-args orig-stacks)))))) + +;; Alias...? +(define-syntax-rule (catch-%8sync rest ...) + (catch-8sync rest ...)) + ;;; Execution of agenda, and current agenda diff --git a/tests/test-agenda.scm b/tests/test-agenda.scm index 6913109..6918c99 100644 --- a/tests/test-agenda.scm +++ b/tests/test-agenda.scm @@ -394,9 +394,34 @@ "in here now!\n" "Well that was fun :)\n"))) +;; Make sure catching tools work + +(let ((speaker (speak-it)) + (catch-result #f)) + (catch-8sync + (begin + (speaker "hello") + (throw '%8sync-caught-error + 'my-orig-key '(apple orange banana) '(*fake-stack* *fake-stack* *fake-stack*)) + (speaker "no goodbyes")) + ('some-key + (lambda (stacks . rest) + (speaker "should not happen"))) + ('my-orig-key + (lambda (stacks fruit1 fruit2 fruit3) + (set! catch-result + `((fruit1 ,fruit1) + (fruit2 ,fruit2) + (fruit3 ,fruit3)))))) + (test-equal (speaker) '("hello")) + (test-equal catch-result '((fruit1 apple) + (fruit2 orange) + (fruit3 banana)))) + ;; End tests (test-end "test-agenda") +;; @@: A better way to handle this at the repl? (test-exit)