Fix alarms bug
parent
dbd8ce49cf
commit
e555c00287
|
@ -0,0 +1,17 @@
|
||||||
|
IN: alarms.tests
|
||||||
|
USING: alarms kernel calendar sequences tools.test threads
|
||||||
|
concurrency.count-downs ;
|
||||||
|
|
||||||
|
[ ] [
|
||||||
|
1 <count-down>
|
||||||
|
{ f } clone 2dup
|
||||||
|
[ first cancel-alarm count-down ] 2curry 1 seconds later
|
||||||
|
swap set-first
|
||||||
|
await
|
||||||
|
] unit-test
|
||||||
|
|
||||||
|
[ ] [
|
||||||
|
[
|
||||||
|
[ resume ] curry instant later drop
|
||||||
|
] "test" suspend drop
|
||||||
|
] unit-test
|
|
@ -37,8 +37,8 @@ SYMBOL: alarm-thread
|
||||||
register-alarm ;
|
register-alarm ;
|
||||||
|
|
||||||
: call-alarm ( alarm -- )
|
: call-alarm ( alarm -- )
|
||||||
dup alarm-quot try
|
|
||||||
dup alarm-entry box> drop
|
dup alarm-entry box> drop
|
||||||
|
dup alarm-quot try
|
||||||
dup alarm-interval [ reschedule-alarm ] [ drop ] if ;
|
dup alarm-interval [ reschedule-alarm ] [ drop ] if ;
|
||||||
|
|
||||||
: (trigger-alarms) ( alarms now -- )
|
: (trigger-alarms) ( alarms now -- )
|
||||||
|
@ -46,8 +46,7 @@ SYMBOL: alarm-thread
|
||||||
2drop
|
2drop
|
||||||
] [
|
] [
|
||||||
over heap-peek drop over alarm-expired? [
|
over heap-peek drop over alarm-expired? [
|
||||||
over heap-pop drop call-alarm
|
over heap-pop drop call-alarm (trigger-alarms)
|
||||||
(trigger-alarms)
|
|
||||||
] [
|
] [
|
||||||
2drop
|
2drop
|
||||||
] if
|
] if
|
||||||
|
|
Loading…
Reference in New Issue