context("Timers")
timer_test <- function(start, pass){
processor(
start, pass,
prepare = function(env){
SI.event()
},
online = function(input, pass, onTimeout=NULL){
for(i in input){
if(is.null(i$stop))
{
args <- list(
timeout = 500,
singleShot = T,
data = TRUE,
call = 'onTimeout'
)
for(n in names(i)){
args[[n]] <- i[[n]]
}
do.call(startTimer, args)
} else {
stopTimer(i$stop)
}
}
if(is.null(onTimeout)){
pass
} else {
list(onTimeout)
}
}
)
}
si1 <- SI.event(id=1)
si2 <- SI.event(id=2)
siO <- SI.event()
code = "
process = function(){
createOutput(timer_test(input(1), input(2)), 'out')
}
"
do_test <- function(blocks, reference){
online <- run.online(list(si1, si2), blocks, code, env=environment())
expect_identical(list(out=reference), online)
}
test_that("Timer triggers after last block", {
do_test(
list(
DB.event(si1, timeoption2ts(si1, seconds(1)), list())
),
DBcombine(
DB.event(siO, timeoption2ts(siO, seconds(1.5)), TRUE)
)
)
})
test_that("Timer triggers after between blocks", {
do_test(
list(
DB.event(si1, timeoption2ts(si1, seconds(1)), list()),
DB.event(si2, timeoption2ts(si2, seconds(2)), 'B')
),
DBcombine(
DB.event(siO, timeoption2ts(siO, seconds(1.5)), TRUE),
DB.event(siO, timeoption2ts(siO, seconds(2)), 'B')
)
)
})
test_that("Timers reorder correctly", {
do_test(
list(
DB.event(si1, timeoption2ts(si1, seconds(1)), list(data='a')),
DB.event(si1, timeoption2ts(si1, seconds(1.01)), list(data='b', timeout=400)),
DB.event(si2, timeoption2ts(si2, seconds(2)), 'Z')
),
DBcombine(
DB.event(siO, timeoption2ts(siO, seconds(1.41)), 'b'),
DB.event(siO, timeoption2ts(siO, seconds(1.5)), 'a'),
DB.event(siO, timeoption2ts(siO, seconds(2)), 'Z')
)
)
})
test_that("Timers reorder correctly after last block", {
do_test(
list(
DB.event(si1, timeoption2ts(si1, seconds(1.01)), list(data='a')),
DB.event(si1, timeoption2ts(si1, seconds(1.02)), list(data='b', timeout=400)),
DB.event(si1, timeoption2ts(si1, seconds(1.03)), list(data='c', timeout=221))
),
DBcombine(
DB.event(siO, timeoption2ts(siO, seconds(1.251)), 'c'),
DB.event(siO, timeoption2ts(siO, seconds(1.420)), 'b'),
DB.event(siO, timeoption2ts(siO, seconds(1.510)), 'a')
)
)
})
test_that("Timers reorder correctly separated by block", {
do_test(
list(
DB.event(si1, timeoption2ts(si1, seconds(1.01)), list(data='a')),
DB.event(si1, timeoption2ts(si1, seconds(1.02)), list(data='b', timeout=400)),
DB.event(si1, timeoption2ts(si1, seconds(1.03)), list(data='c', timeout=221)),
DB.event(si2, timeoption2ts(si2, seconds(1.31)), 'Z')
),
DBcombine(
DB.event(siO, timeoption2ts(siO, seconds(1.251)), 'c'),
DB.event(siO, timeoption2ts(siO, seconds(1.310)), 'Z'),
DB.event(siO, timeoption2ts(siO, seconds(1.420)), 'b'),
DB.event(siO, timeoption2ts(siO, seconds(1.510)), 'a')
)
)
})
test_that("Timers can be repeative", {
do_test(
list(
DB.event(si1, timeoption2ts(si1, seconds(1.01)), list(data='a', singleShot=F)),
DB.event(si2, timeoption2ts(si2, seconds(1.31)), 'A'),
DB.event(si2, timeoption2ts(si2, seconds(1.61)), 'B'),
DB.event(si2, timeoption2ts(si2, seconds(2.12)), 'C'),
DB.event(si2, timeoption2ts(si2, seconds(2.25)), 'D'),
DB.event(si2, timeoption2ts(si2, seconds(4.31)), 'E')
),
DBcombine(
DB.event(siO, timeoption2ts(siO, seconds(1.31)), 'A'),
DB.event(siO, timeoption2ts(siO, seconds(1.51)), 'a'),
DB.event(siO, timeoption2ts(siO, seconds(1.61)), 'B'),
DB.event(siO, timeoption2ts(siO, seconds(2.01)), 'a'),
DB.event(siO, timeoption2ts(siO, seconds(2.12)), 'C'),
DB.event(siO, timeoption2ts(siO, seconds(2.25)), 'D'),
DB.event(siO, timeoption2ts(siO, seconds(2.51)), 'a'),
DB.event(siO, timeoption2ts(siO, seconds(3.01)), 'a'),
DB.event(siO, timeoption2ts(siO, seconds(3.51)), 'a'),
DB.event(siO, timeoption2ts(siO, seconds(4.01)), 'a'),
DB.event(siO, timeoption2ts(siO, seconds(4.31)), 'E'),
DB.event(siO, timeoption2ts(siO, seconds(4.51)), 'a')
)
)
})
test_that("Timers can be canceled", {
do_test(
list(
DB.event(si1, timeoption2ts(si1, seconds(1.01)), list(data='a', singleShot=F)),
DB.event(si1, timeoption2ts(si1, seconds(1.03)), list(data='b', singleShot=F)),
DB.event(si1, timeoption2ts(si1, seconds(1.06)), list(data='c', singleShot=F)),
DB.event(si1, timeoption2ts(si1, seconds(1.07)), list(data='d', timeout=4000)),
DB.event(si1, timeoption2ts(si1, seconds(1.21)), list(stop=1)), # stop a
DB.event(si1, timeoption2ts(si1, seconds(1.24)), list(stop=1)), # stop a second time
DB.event(si2, timeoption2ts(si2, seconds(1.31)), 'A'),
DB.event(si2, timeoption2ts(si2, seconds(1.61)), 'B'),
DB.event(si1, timeoption2ts(si1, seconds(1.80)), list(stop=2)), # stop b
DB.event(si2, timeoption2ts(si2, seconds(2.12)), 'C'),
DB.event(si1, timeoption2ts(si1, seconds(2.15)), list(stop=3)) # stop c
),
DBcombine(
DB.event(siO, timeoption2ts(siO, seconds(1.31)), 'A'),
DB.event(siO, timeoption2ts(siO, seconds(1.53)), 'b'),
DB.event(siO, timeoption2ts(siO, seconds(1.56)), 'c'),
DB.event(siO, timeoption2ts(siO, seconds(1.61)), 'B'),
DB.event(siO, timeoption2ts(siO, seconds(2.06)), 'c'),
DB.event(siO, timeoption2ts(siO, seconds(2.12)), 'C'),
DB.event(siO, timeoption2ts(siO, seconds(5.07)), 'd')
)
)
})
test_that("Timers can't be used offline", {
blocks = list(
DB.event(si1, timeoption2ts(si1, seconds(1.01)), list(data='a', singleShot=F))
)
expect_error(
run.offline(list(si1, si2), blocks, code, env=environment()),
"Can't use startTimer function without run.online context"
)
})
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.