From 908188e7142825f66364fe93da7ac083a9fe7e2e Mon Sep 17 00:00:00 2001
From: Christopher Allan Webber <cwebber@dustycloud.org>
Date: Mon, 31 Jul 2017 08:44:24 -0500
Subject: [PATCH] Add public condition-signalled? procedure for peeking at
 condition state.

* fibers/conditions.scm (condition-signalled?/public): New variable,
exported as condition-signalled?
* fibers.texi (Conditions): Document condition-signalled?
* tests/conditions.scm: Add tests for condition-signalled?
---
 fibers.texi           |  8 ++++++++
 fibers/conditions.scm | 11 ++++++++++-
 tests/conditions.scm  |  2 ++
 3 files changed, 20 insertions(+), 1 deletion(-)

diff --git a/fibers.texi b/fibers.texi
index 9c139de..72c9c98 100644
--- a/fibers.texi
+++ b/fibers.texi
@@ -721,6 +721,14 @@ signalled.  Equivalent to @code{(perform-operation (wait-operation
 cvar))}.
 @end defun
 
+@defun condition-signalled? cvar
+Return @code{#t} if @var{cvar} has already been signalled.
+
+In general you will want to use @code{wait} or @code{wait-operation} to
+wait on a condition.  However, sometimes it is useful to see whether or
+not a condition has already been signalled without blocking if not.
+@end defun
+
 @node REPL Commands
 @section REPL Commands
 
diff --git a/fibers/conditions.scm b/fibers/conditions.scm
index 5501135..7b53ac3 100644
--- a/fibers/conditions.scm
+++ b/fibers/conditions.scm
@@ -37,7 +37,8 @@
             condition?
             signal-condition!
             wait-operation
-            wait))
+            wait
+            (condition-signalled?/public . condition-signalled?)))
 
 (define-record-type <condition>
   (%make-condition signalled? waiters)
@@ -102,3 +103,11 @@ returns @code{#t} otherwise."
 (define (wait cvar)
   "Wait until @var{cvar} has been signalled."
   (perform-operation (wait-operation cvar)))
+
+(define (condition-signalled?/public cvar)
+  "Return @code{#t} if @var{cvar} has already been signalled.
+
+In general you will want to use @code{wait} or @code{wait-operation} to
+wait on a condition.  However, sometimes it is useful to see whether or
+not a condition has already been signalled without blocking if not."
+  (atomic-box-ref (condition-signalled? cvar)))
diff --git a/tests/conditions.scm b/tests/conditions.scm
index 505c42a..93c679f 100644
--- a/tests/conditions.scm
+++ b/tests/conditions.scm
@@ -68,8 +68,10 @@
 (assert-equal #t (condition? cv))
 (assert-run-fibers-returns (#f) (wait/timeout cv))
 (assert-run-fibers-returns (#f) (wait/timeout cv))
+(assert-equal #f (condition-signalled? cv))
 (assert-equal #t (signal-condition! cv))
 (assert-equal #f (signal-condition! cv))
+(assert-equal #t (condition-signalled? cv))
 (assert-run-fibers-returns (#t) (wait/timeout cv))
 (assert-run-fibers-returns (#t) (wait/timeout cv))
 (assert-run-fibers-returns (#t)