Nothing
context("testthat functionalities replacements")
my_reporter <- function(){
global_rep <- get_reporter()
# Try to get the output of expect_silent_RTest
reporter <- ListReporter$new()
set_reporter(reporter)
reporter$start_reporter()
# Execute the wrapper function
tmpExec <- NULL
with_reporter(reporter,
test_that("length computed correctly", {
expect_silent_RTest(message("xx"))
})
)
reporter$end_context()
reporter$end_reporter()
set_reporter(global_rep)
return(reporter)
}
test_that("expect_silent_RTest function works", {
b <- 1
expect_error(as.logical(expect_silent_RTest(a <- c_value)))
expect_equal(as.logical(expect_silent_RTest(a <- b)),TRUE)
reporter <- my_reporter()
expect_equal(
reporter$results$as_list()[[1]]$results[[1]]$message,
"~message(\"xx\") produced:\nmessages = 'xx'")
})
my_reporter <- function(){
global_rep <- get_reporter()
# Try to get the output of expect_silent_RTest
reporter <- ListReporter$new()
set_reporter(reporter)
reporter$start_reporter()
# Execute the wrapper function
tmpExec <- NULL
myfun <- function(){
warning("one")
warning("two")
}
with_reporter(reporter,
test_that("length computed correctly", {
RTest::expect_silent_RTest(myfun())
})
)
reporter$end_context()
reporter$end_reporter()
set_reporter(global_rep)
return(reporter)
}
test_that("expect_silent_RTest function warnings works", {
reporter <- my_reporter()
expect_equal(
reporter$results$as_list()[[1]]$results[[1]]$message,
"~myfun() produced:\nwarnings1 = 'one'\nwarnings2 = 'two'")
})
test_that("expect_silent_RTest function warnings works with own quasi comp", {
options("force_implementation"=TRUE)
reporter <- my_reporter()
expect_equal(
reporter$results$as_list()[[1]]$results[[1]]$message,
"~myfun() produced:\nwarnings1 = 'one'\nwarnings2 = 'two'")
options("force_implementation"=FALSE)
})
test_that("expect_silent_RTest function outptus works", {
global_rep <- get_reporter()
# Try to get the output of expect_silent_RTest
reporter <- ListReporter$new()
set_reporter(reporter)
reporter$start_reporter()
# Execute the wrapper function
tmpExec <- NULL
myfun <- function(){
print("one")
print("two")
}
with_reporter(reporter,
test_that("length computed correctly", {
expect_silent_RTest(myfun())
})
)
reporter$end_context()
reporter$end_reporter()
set_reporter(global_rep)
expect_equal(
reporter$results$as_list()[[1]]$results[[1]]$message,
"~myfun() produced:\noutputs = '[1] \"one\"\n[1] \"two\"'")
})
test_that("exec_silent_RTest in reporting works",{
global_rep <- get_reporter()
# Create test collection
testCollection <- new("RTestCollection",
project.name = "RTest Vignette",
project.details = "Example test exectuion",
tester = "Example tester",
test.start = format(Sys.time(), "%Y-%m-%d %H:%M:%S"))
testCollection <- importTCsFromDir(testCollection,
xml.dPath = paste0(find.package("RTest"),"/xml-templates"),
f.pattern="test.testthat.xml")
outf <- tempfile(fileext=".html")
intern_reporter <- get_reporter()
set_reporter(intern_reporter)
# Execute all tests with two warnings
my_fun <<- function(){
warning("one")
warning("two")
}
testCollection <- exec(testCollection, out.fPath = outf, open=FALSE)
set_reporter(global_rep)
expect_equal(
testCollection@collection[[1]]@tests[["RTest"]][[1]][[1]][[1]]$result,
"failed"
)
# Just one warning
my_fun <<- function(){
warning("one")
}
testCollection <- exec(testCollection, out.fPath = outf, open=FALSE)
set_reporter(global_rep)
expect_equal(
testCollection@collection[[1]]@tests[["RTest"]][[1]][[1]][[1]]$result,
"failed"
)
})
#............................. Greater LOWER ................................................
test_that("expect_less_than",{
expect_silent(
RTest:::expect_less_than(5,5.1)
)
expect_error(
RTest:::expect_less_than(5,4.9)
)
})
test_that("expect_more_than",{
options("force_implementation"=NULL)
expect_silent(
RTest:::expect_more_than(5,4.9)
)
expect_error(
RTest:::expect_more_than(5,5.1)
)
})
test_that("expect_more_than old testthat",{
options("force_implementation"=TRUE)
expect_warning(
RTest:::expect_gt(5,4.9)
)
options("force_implementation"=FALSE)
})
test_that("expect_less_than old testthat",{
options("force_implementation"=TRUE)
expect_warning(
RTest:::expect_lt(5,5.1)
)
options("force_implementation"=FALSE)
})
test_that("expect overwrite works", {
expect_old <- testthat::expect
assignInNamespace("expect", RTest::expect_testthat, ns="testthat", pos="package:testthat")
global_rep <- get_reporter()
# Create test collection
testCollection <- new("RTestCollection",
project.name = "RTest Vignette",
project.details = "Example test exectuion",
tester = "Example tester",
test.start = format(Sys.time(), "%Y-%m-%d %H:%M:%S"))
testCollection <- importTCsFromDir(testCollection,
xml.dPath = paste0(find.package("RTest"),"/xml-templates"),
f.pattern="RTest_TC-generic.xml")
outf <- tempfile(fileext=".html")
intern_reporter <- get_reporter()
set_reporter(intern_reporter)
# Execute all tests with two warnings
my_fun <<- function(){
warning("one")
warning("two")
}
testCollection <- exec(testCollection, out.fPath = outf, open=FALSE)
set_reporter(global_rep)
res1 <- testCollection@collection[[1]]@tests[["RTest"]][[5]][[1]][[1]]$reporter$results$as_list()
expect_match(
res1[[3]]$results[[1]]$message,
"Equal\\n\\{\"Test\""
)
assignInNamespace("expect", expect_old, ns="testthat", pos="package:testthat")
global_rep <- get_reporter()
# Create test collection
testCollection <- new("RTestCollection",
project.name = "RTest Vignette",
project.details = "Example test exectuion",
tester = "Example tester",
test.start = format(Sys.time(), "%Y-%m-%d %H:%M:%S"))
testCollection <- importTCsFromDir(testCollection,
xml.dPath = paste0(find.package("RTest"),"/xml-templates"),
f.pattern="RTest_TC-generic.xml")
outf <- tempfile(fileext=".html")
intern_reporter <- get_reporter()
set_reporter(intern_reporter)
# Execute all tests with two warnings
my_fun <<- function(){
warning("one")
warning("two")
}
testCollection <- exec(testCollection, out.fPath = outf, open=FALSE)
set_reporter(global_rep)
res1 <- testCollection@collection[[1]]@tests[["RTest"]][[5]][[1]][[1]]$reporter$results$as_list()
expect_match(
res1[[3]]$results[[1]]$message,
"\\nEqual$"
)
})
Any scripts or data that you put into this service are public.
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.