Created
February 27, 2019 11:29
-
-
Save emilyriederer/d1c98b31554cb08d7d2d8405eb3d07cc to your computer and use it in GitHub Desktop.
knitr eng_sxss unit tests
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
library(testthat) | |
# define code chunks ---- | |
scss <- c("$font-stack: Helvetica, sans-serif;", "$primary-color: #333;", | |
"", "body {", " font: 100% $font-stack;", " color: $primary-color;", | |
"}") | |
sass <- c("$font-stack: Helvetica, sans-serif", "$primary-color: #333", | |
"", "body", " font: 100% $font-stack", " color: $primary-color") | |
output_compressed <- '<style type=\"text/css\">\nbody{font:100% Helvetica,sans-serif;color:#333}\n</style>\n' | |
# simulate options object ---- | |
gen_input <- function(engine, valid = TRUE, | |
echo = FALSE, eval = TRUE, error = TRUE, | |
package = NULL, style = NULL, engine.path = NULL){ | |
code <- if(engine == "sass") sass else scss | |
if(!valid) code <- c(code[1:3], "###", code[4:length(code)]) | |
list(engine = engine, | |
echo = echo, eval = eval, code = code, error = error, | |
engine.opts = list(package = package, style = style), | |
engine.path = engine.path) | |
} | |
# get sass path | |
path <- sub(".(bat|exe)", "", | |
tryCatch( | |
system2("where","sass", stdout = TRUE), | |
warning = function(w) "sass", | |
error = function(e) "sass") | |
) | |
# define tests ---- | |
context("Core CSS rendering") | |
test_that( | |
"Valid CSS is rendered to HTML output with the correct engine", | |
with_mock("knitr:::is_html_output" = function(...) TRUE, { | |
expect_message(t1 <- knitr:::eng_sxss(gen_input("scss")), "^Converting sass with R") | |
expect_message(t2 <- knitr:::eng_sxss(gen_input("scss", package = TRUE)), "^Converting sass with R") | |
expect_message(t3 <- knitr:::eng_sxss(gen_input("scss", package = FALSE)), "^Converting sass with exec") | |
expect_message(t4 <- knitr:::eng_sxss(gen_input("sass")), "^Converting sass with R package") | |
expect_message(t5 <- knitr:::eng_sxss(gen_input("sass", package = TRUE)), "^Converting sass with R") | |
expect_message(t6 <- knitr:::eng_sxss(gen_input("sass", package = FALSE)), "^Converting sass with exec") | |
expect_message(t7 <- knitr:::eng_sxss(gen_input("sass", engine.path = path)), "^Converting sass with exec") | |
expect_equal(t1, output_compressed) | |
expect_equal(t2, output_compressed) | |
expect_equal(t3, output_compressed) | |
expect_equal(t4, output_compressed) | |
expect_equal(t5, output_compressed) | |
expect_equal(t6, output_compressed) | |
expect_equal(t7, output_compressed) | |
})) | |
test_that( | |
"Bad input creates no output (empty char) and warning when error = TRUE", | |
with_mock("knitr:::is_html_output" = function(...) TRUE, { | |
expect_warning(t1 <- knitr:::eng_sxss(gen_input("scss", valid = FALSE))) | |
expect_warning(t2 <- knitr:::eng_sxss(gen_input("sass", valid = FALSE))) | |
expect_warning(t3 <- knitr:::eng_sxss(gen_input("scss", package = FALSE, valid = FALSE))) | |
expect_warning(t4 <- knitr:::eng_sxss(gen_input("sass", package = FALSE, valid = FALSE))) | |
expect_equal(t1, "") | |
expect_equal(t2, "") | |
expect_equal(t3, "") | |
expect_equal(t4, "") | |
})) | |
test_that( | |
"Bad input throws error when error = FALSE", | |
with_mock("knitr:::is_html_output" = function(...) TRUE, { | |
expect_error(knitr:::eng_sxss(gen_input("scss", valid = FALSE, error = FALSE))) | |
expect_error(knitr:::eng_sxss(gen_input("sass", valid = FALSE, error = FALSE))) | |
expect_error(knitr:::eng_sxss(gen_input("scss", package = FALSE, valid = FALSE, error = FALSE))) | |
expect_error(knitr:::eng_sxss(gen_input("sass", package = FALSE, valid = FALSE, error = FALSE))) | |
})) | |
context("Styling options") | |
test_that( | |
"Invalid style defaults to 'compressed' and gives warning when error = TRUE", | |
with_mock("knitr:::is_html_output" = function(...) TRUE, { | |
expect_warning(t1 <- knitr:::eng_sxss(gen_input("scss", style = "xyz"))) | |
expect_warning(t2 <- knitr:::eng_sxss(gen_input("scss", package = FALSE, style = "xyz"))) | |
expect_warning(t3 <- knitr:::eng_sxss(gen_input("sass", style = "xyz"))) | |
expect_warning(t4 <- knitr:::eng_sxss(gen_input("sass", package = FALSE, style = "xyz"))) | |
expect_warning(t5 <- knitr:::eng_sxss(gen_input("scss", package = FALSE, style = "nested"))) | |
expect_warning(t6 <- knitr:::eng_sxss(gen_input("sass", package = FALSE, style = "nested"))) | |
expect_equal(t1, output_compressed) | |
expect_equal(t2, output_compressed) | |
expect_equal(t3, output_compressed) | |
expect_equal(t4, output_compressed) | |
expect_equal(t5, output_compressed) | |
expect_equal(t6, output_compressed) | |
})) | |
test_that( | |
"Invalid style throws error when error = FALSE", | |
with_mock("knitr:::is_html_output" = function(...) TRUE, { | |
expect_error(knitr:::eng_sxss(gen_input("scss", style = "xyz", error = FALSE))) | |
expect_error(knitr:::eng_sxss(gen_input("scss", package = FALSE, style = "xyz", error = FALSE))) | |
expect_error(knitr:::eng_sxss(gen_input("sass", style = "xyz", error = FALSE))) | |
expect_error(knitr:::eng_sxss(gen_input("sass", package = FALSE, style = "xyz", error = FALSE))) | |
})) | |
context("Other chunk options handled correctly") | |
test_that( | |
"All processing is skipped when eval = FALSE", | |
with_mock("knitr:::is_html_output" = function(...) TRUE, { | |
expect_message(t1 <- knitr:::eng_sxss(gen_input("scss", eval = FALSE)), NA) | |
expect_message(t2 <- knitr:::eng_sxss(gen_input("scss", package = TRUE, eval = FALSE)), NA) | |
expect_message(t3 <- knitr:::eng_sxss(gen_input("scss", package = FALSE, eval = FALSE)), NA) | |
expect_message(t4 <- knitr:::eng_sxss(gen_input("sass", eval = FALSE)), NA) | |
expect_message(t5 <- knitr:::eng_sxss(gen_input("sass", package = TRUE, eval = FALSE)), NA) | |
expect_message(t6 <- knitr:::eng_sxss(gen_input("sass", package = FALSE, eval = FALSE)), NA) | |
expect_equal(t1, "") | |
expect_equal(t2, "") | |
expect_equal(t3, "") | |
expect_equal(t4, "") | |
expect_equal(t5, "") | |
expect_equal(t6, "") | |
})) | |
test_that( | |
"Unprocessed results returned when echo = TRUE", | |
with_mock("knitr:::is_html_output" = function(...) TRUE, { | |
expect_equal(knitr:::eng_sxss(gen_input("scss", package = TRUE, eval = FALSE, echo = TRUE)), paste0(scss, collapse = "\n")) | |
expect_equal(knitr:::eng_sxss(gen_input("scss", package = FALSE, eval = FALSE, echo = TRUE)), paste0(scss, collapse = "\n")) | |
expect_equal(knitr:::eng_sxss(gen_input("sass", package = TRUE, eval = FALSE, echo = TRUE)), paste0(sass, collapse = "\n")) | |
expect_equal(knitr:::eng_sxss(gen_input("sass", package = FALSE, eval = FALSE, echo = TRUE)), paste0(sass, collapse = "\n")) | |
})) | |
test_that( | |
"Invalid option to package engine.opt is handled correctly", | |
with_mock("knitr:::is_html_output" = function(...) TRUE, { | |
expect_warning(t1 <- knitr:::eng_sxss(gen_input("scss", package = "a", error = TRUE)), "package option must be either TRUE or FALSE. Defaulting to TRUE.") | |
expect_error(knitr:::eng_sxss(gen_input("scss", package = "a", error = FALSE)), "package option must be either TRUE or FALSE") | |
expect_equal(t1, output_compressed) | |
})) |
Sign up for free
to join this conversation on GitHub.
Already have an account?
Sign in to comment