library(testthat)
library(pander)
cache.dir <- evalsOptions('cache.dir')
graph.dir <- evalsOptions('graph.dir')
wd <- getwd()
setwd(tempdir())
evalsOptions('cache.dir', file.path(tempdir(), '.cache'))
evalsOptions('graph.dir', file.path(tempdir(), 'plots'))
context('eval.msgs')
test_that('returns', {
expect_equal(eval.msgs('1:5')$result, 1:5)
expect_equal(eval.msgs('mtcars')$result, mtcars)
expect_null(eval.msgs('x <- mtcars')$result)
expect_null(evals('plot(mtcars)')$result)
expect_equal(eval.msgs('cat(1:5);1:5')$result, 1:5)
expect_null(eval.msgs('#comment')$result)
expect_null(eval.msgs('')$result)
})
test_that('messages', {
expect_null(eval.msgs('1:5')$msg$messages)
expect_null(eval.msgs('mtcars')$msg$messages)
expect_null(eval.msgs('x <- mtcars')$msg$messages)
expect_null(evals('plot(mtcars)')$msg$messages)
expect_null(eval.msgs('warning("d");warning("f");1')$msg$messages)
expect_equal(eval.msgs('message("FOO")')$msg$messages, 'FOO')
expect_equal(eval.msgs(c('message("FOO")', '1:2'))$msg$messages, 'FOO')
expect_equal(eval.msgs(c('message("FOO");message("FOO");warning("FOO")', '1:2'))$msg$messages, c('FOO', 'FOO'))
})
test_that('warnings', {
expect_null(eval.msgs('1:5')$msg$warnings)
expect_null(eval.msgs('mtcars')$msg$warnings)
expect_null(eval.msgs('x <- mtcars')$msg$warnings)
expect_null(evals('plot(mtcars)')$msg$warnings)
expect_null(eval.msgs('message("FOO")')$msg$warnings)
expect_null(eval.msgs(c('message("FOO")', '1:2'))$msg$warnings)
expect_equal(eval.msgs('warning("d");warning("f");1')$msg$warnings, c('d', 'f'))
expect_equal(eval.msgs(c('warning("FOO")', '1:2'))$msg$warnings, 'FOO')
expect_equal(eval.msgs(c('warning("FOO");message("FOO");warning("FOO")', '1:2'))$msg$warnings, c('FOO', 'FOO'))
})
test_that('errors', {
expect_null(eval.msgs('1:5')$msg$errors)
expect_null(eval.msgs('mtcars')$msg$errors)
expect_null(eval.msgs('x <- mtcars')$msg$errors)
expect_null(evals('plot(mtcars)')$msg$errors)
expect_null(eval.msgs('warning("d");warning("f");1')$msg$errors)
expect_null(eval.msgs('message("FOO")')$msg$errors)
expect_null(eval.msgs(c('message("FOO")', '1:2'))$msg$errors)
expect_null(eval.msgs(c('warning("FOO")', '1:2'))$msg$errors)
expect_null(eval.msgs(c('warning("FOO");message("FOO");warning("FOO")', '1:2'))$msg$errors)
expect_is(eval.msgs('runiff(2)')$msg$errors, 'character')
expect_is(eval.msgs('runif would be nice to run')$msg$errors, 'character')
expect_is(eval.msgs('no.R.object.like.that')$msg$errors, 'character')
expect_error(evals())
expect_error(evals('1:5', hooks=1:10))
expect_error(evals('plot(mtcars)', graph.name = 1))
env <- new.env()
env$plot <- 1
expect_error(evals(1:10, env = env))
})
test_that('output', {
expect_is(eval.msgs('1:5')$output, 'character')
expect_is(eval.msgs('mtcars')$output, 'character')
expect_is(eval.msgs('cat(1:5);1:5')$output, 'character')
expect_null(eval.msgs('x <- mtcars')$output)
expect_null(evals('plot(mtcars)')$output)
expect_null(eval.msgs('cat(1:5)')$output)
})
test_that('stdout', {
expect_null(eval.msgs('1:5')$stdout)
expect_null(eval.msgs('mtcars')$stdout)
expect_null(eval.msgs('x <- mtcars')$stdout)
expect_null(evals('plot(mtcars)')$stdout)
expect_equal(eval.msgs('cat(1:5)')$stdout, '1 2 3 4 5')
expect_equal(eval.msgs('cat(1:5);1:5')$stdout, '1 2 3 4 5')
})
context('evals')
test_that('Variable assignement', {
expect_null(evals('x <- rnorm(100)')[[1]]$result)
})
test_that('Multiple variable assignement', {
expect_null(evals(list(c('x <- rnorm(100)', 'y <- rnorm(10)')), parse = F)[[1]]$result)
})
test_that('Comment', {
expect_null(evals('## comment')[[1]]$result)
})
test_that('Comment & variable assignement', {
expect_null(evals(list(c('## comment', 'y <- rnorm(10)')), parse = F)[[1]]$result)
})
test_that('Basic: numerics', {
expect_is(evals('rnorm(100)')[[1]]$result, 'numeric')
})
test_that('Basic: character', {
expect_equal(evals('"Hello world!"')[[1]]$result, 'Hello world!')
})
test_that('Basic: list', {
expect_is(evals('lapply(rnorm(10), round)')[[1]]$result, 'list')
})
test_that('Basic: data.frame', {
expect_is(evals('mtcars')[[1]]$result, 'data.frame')
})
test_that('Plot: graphics package', {
expect_is(evals('plot(1:10)')[[1]]$result, 'image')
})
test_that('Plot: lattice package', {
expect_is(evals('require(lattice);+histogram(mtcars$hp)')[[1]]$result, 'image')
expect_is(evals('require(lattice);histogram(mtcars$hp)', parse = F)[[1]]$result, 'image')
})
test_that('Plot: multiline code', {
expect_is(evals(list(c('plot(cars, main="Stopping Distance versus Speed")',
'plot(cars, main="Stopping Distance versus Speed")')),
parse = F)[[1]]$result,
'image')
expect_is(evals('plot(cars, main="Stopping Distance versus Speed"); plot(cars, main="Stopping Distance versus Speed")')[[2]]$result, 'image') #nolint
})
test_that('Plot: pdf', {
expect_is(evals('plot(1:10)', graph.output = 'pdf')[[1]]$result, 'image')
})
test_that('Plot: pdf without plotting', {
expect_is(evals('runif(10)', graph.output = 'pdf')[[1]]$result, 'numeric')
})
test_that('NULL', {
expect_is(evals('rnorm(100); NULL')[[1]]$result, 'numeric')
expect_null(evals('rnorm(100); NULL')[[2]]$result)
expect_null(evals('rnorm(100); NULL', parse = FALSE)[[1]]$result)
})
test_that('## comment', {
expect_is(evals('rnorm(100);## comment')[[1]]$result, 'numeric')
expect_is(evals('rnorm(100);## comment', parse = FALSE)[[1]]$result, 'numeric')
})
test_that('var assignement', {
expect_is(evals('rnorm(100);x <- 1')[[1]]$result, 'numeric')
expect_null(evals('rnorm(100);x <- 1', parse = F)[[1]]$result)
})
test_that('creating function', {
expect_is(evals('rnorm(100);f <- function(x) mean(x)')[[1]]$result, 'numeric')
expect_null(evals('rnorm(100);f <- function(x) mean(x)')[[2]]$result)
expect_null(evals('rnorm(100);f <- function(x) mean(x)', parse = F)[[1]]$result)
})
test_that('string+num', {
expect_is(evals('"X";rnorm(100)')[[2]]$result, 'numeric')
expect_is(evals('"X";rnorm(100)')[[1]]$result, 'character')
expect_is(evals('"X";rnorm(100)', parse = FALSE)[[1]]$result, 'numeric')
})
test_that('data.frame+num', {
expect_is(evals(list(c('mtcars', 'rnorm(100)')), parse = FALSE)[[1]]$result, 'numeric')
})
test_that('simple error', {
expect_is(evals('dadaffaSFA+A')[[1]]$msg$error, 'character')
})
test_that('simple error', {
expect_is(evals('runiff(10)')[[1]]$msg$error, 'character')
})
test_that('multiple errors', {
expect_is(evals(list(c('runiff(20)', 'Old MacDonald had a farm?')), parse = F)[[1]]$msg$error, 'character')
})
test_that('multiple errors', {
expect_is(evals('no.R.object;no.R.function();very.mixed.up(stuff)')[[1]]$msg$error, 'character')
expect_is(evals('no.R.object;no.R.function();very.mixed.up(stuff)')[[2]]$msg$error, 'character')
expect_is(evals('no.R.object;no.R.function();very.mixed.up(stuff)')[[3]]$msg$error, 'character')
expect_is(evals('no.R.object;no.R.function();very.mixed.up(stuff)', parse = F)[[1]]$msg$error, 'character')
})
test_that('output+errors', {
expect_is(evals(list(c('mean(1:10)', 'no.R.function()')), parse = F)[[1]]$msg$error, 'character')
})
test_that('output+multiple errors', {
expect_is(evals(list(c('no.R.object', 'Old MacDonald had a farm\\dots', 'pi')),
parse = F)[[1]]$msg$error,
'character')
})
test_that('simple warning', {
expect_is(evals('chisq.test(mtcars$gear, mtcars$hp)')[[1]]$msg$warning, 'character')
})
test_that('multiple warnings+output', {
expect_is(evals(list(c('chisq.test(mtcars$gear, mtcars$am)', 'pi', 'chisq.test(mtcars$gear, mtcars$hp)')),
parse = F)[[1]]$msg$warnings,
'character')
expect_is(evals('chisq.test(mtcars$gear, mtcars$am);pi;chisq.test(mtcars$gear, mtcars$hp)')[[1]]$msg$warnings,
'character')
})
test_that('long lines with line breaks', {
expect_is(evals('if (TRUE) {\nset.caption("FOO")\nplot(c(1,2,3,4,5,6,7,8,9,10,11,12))\n}')[[1]]$result, 'image')
expect_equal(length(evals('x <- "this is a very-very looooooooooong line which might be split on `parse`, but that is not a big deal at all"\nx\n1')), 3) #nolint
})
test_that('cache.dir option works correctly', {
dir <- tempdir()
suppressWarnings(file.remove(list.files(dir)))
t1 <- system.time(evals('1:1e5', cache.mode = 'disk', cache.dir = dir, cache.time = 0))
lf <- list.files(dir)
expect_true(length(lf) > 0)
t2 <- system.time(evals('1:1e5', cache.mode = 'disk', cache.dir = dir, cache.time = 0))
expect_equal(list.files(dir), lf)
# plots
suppressWarnings(file.remove(list.files(dir)))
t1 <- system.time(evals('plot(mtcars)',
cache.mode = 'disk',
cache.dir = dir,
cache.time = 0,
cache.copy.images = T))
lf <- list.files(dir)
expect_true(length(lf) > 0)
t2 <- system.time(evals('plot(mtcars)',
cache.mode = 'disk',
cache.dir = dir,
cache.time = 0,
cache.copy.images = TRUE))
expect_equal(list.files(dir), lf)
})
test_that('caching works correctly', {
env <- new.env()
evals('x <- 1:10', env = env, cache.time = 0)
expect_true(length(ls(pander:::cached.results)) > 0)
evals('x <- 1:100', env = env, cache.time = 0)
res <- evals('x', env = env)
expect_equal(res[[1]]$result, 1:100)
t1 <- system.time(evals('plot(mtcars)', hi.res = T))
lf <- list.files('plots')
t2 <- system.time(evals('plot(mtcars)', hi.res = T))
expect_equal(list.files('plots'), lf)
})
test_that('plots', {
r1 <- evals('ggplot(mtcars, aes(wt, mpg)) + geom_point() + geom_smooth(aes(wt,mpg), method = lm, se=FALSE)',
graph.unify = T)
r2 <- evals('xyplot(wt ~ mpg, mtcars, type = c("p","smooth"))', graph.unify = T)
expect_equal(r1$type, r2$type)
dir <- 'temp'
r1 <- evals('plot(mtcars)',
graph.recordplot = TRUE,
cache.time = 0,
cache.copy.images = TRUE,
cache.mode = 'disk',
cache.dir = dir)
lf <- list.files(dir)
expect_true(length(list.files(dir, pattern = 'recordedplot$')) > 0)
png(filename=file.path(dir, 'recorded.png'))
redraw.recordedplot(list.files(dir, pattern = 'recordedplot$', full.names = T)[1])
dev.off()
})
test_that('hooks work correctly', {
set.seed(1)
txt <- 'runif(1:4); matrix(runif(25), 5, 5); 1:5'
hooks <- list('numeric' = round, 'matrix' = pander_return)
res <- evals(txt, hooks = hooks)
set.seed(1)
expect_equal(res[[1]]$result, round(runif(1:4)))
expect_equal(res[[2]]$result, pander_return(matrix(runif(25), 5, 5)))
## using pander's default hook
set.seed(1)
res <- evals(txt, hooks = list('default' = pander_return))
set.seed(1)
expect_equal(res[[1]]$result, pander_return(runif(1:4)))
expect_equal(res[[2]]$result, pander_return(matrix(runif(25), 5, 5)))
expect_equal(res[[3]]$result, pander_return(1:5))
})
test_that('output param works correctly', {
res <- evals('1:10', output = 'all')
expect_equal(names(res[[1]]), c('src', 'result', 'output', 'type', 'msg', 'stdout'))
res <- evals('1:10', output = c('src', 'result'))
expect_equal(names(res[[1]]), c('src', 'result'))
expect_error(evals('1:10', output = c('src', 'result', '123')))
res <- evals('matrix(5,5,5)',
hooks = list('matrix' = list(pander_return, 'Cap')))[[1]]$result
expect_equal(res[14], 'Table: Cap')
})
evalsOptions('cache.dir', cache.dir)
evalsOptions('graph.dir', graph.dir)
setwd(wd)
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.