Nothing
test_that("@usage overrides default", {
out <- roc_proc_text(rd_roclet(), "
#' A
#' @usage a(a=2)
a <- function(a=1) {}")[[1]]
expect_equal(out$get_value("usage"), rd("a(a=2)"))
})
test_that("@usage overrides default for @docType data", {
out <- roc_proc_text(rd_roclet(), "
#' Title.
#'
#' @name abc
#' @docType data
#' @usage data(abc)
NULL")[[1]]
expect_equal(out$get_value("usage"), rd("data(abc)"))
})
test_that("@usage NULL suppresses default usage", {
out <- roc_proc_text(rd_roclet(), "
#' A
#' @usage NULL
a <- function(a=1) {}")[[1]]
expect_equal(out$get_value("usage"), NULL)
})
test_that("quoted topics have usage statements", {
out <- roc_proc_text(rd_roclet(), "
#' Title.
\"f\" <- function(a = 1, b = 2, c = a + b) {}")[[1]]
expect_equal(out$get_value("usage"), rd("f(a = 1, b = 2, c = a + b)"))
expect_equal(out$get_rd("usage"), "\\usage{\nf(a = 1, b = 2, c = a + b)\n}")
})
# Escaping --------------------------------------------------------------------
test_that("usage escaping preserved when combined", {
out <- roc_proc_text(rd_roclet(), "
#' Foo
foo <- function(x = '%') x
#' @rdname foo
bar <- function(y = '%') y
")[[1]]
expect_s3_class(out$get_value("usage"), "rd")
})
test_that("default usage not double escaped", {
out <- roc_proc_text(rd_roclet(), "
#' Regular
mean.foo <- function(x) 'foo'
")[[1]]
expect_equal(out$get_rd("usage"), "\\usage{\n\\method{mean}{foo}(x)\n}")
})
test_that("% and \\ are escaped in usage", {
out <- roc_proc_text(rd_roclet(), "
#' Title.
a <- function(a='%\\\\') {}")[[1]]
expect_equal(out$get_value("usage"), escape('a(a = "%\\\\")'))
expect_equal(out$get_rd("usage"), "\\usage{\na(a = \"\\%\\\\\\\\\")\n}")
})
test_that("% and \\ not escaped in manual usage", {
out <- roc_proc_text(rd_roclet(), "
#' Title.
#' @usage %\\
a <- function(a) {}
")[[1]]
expect_equal(out$get_value("usage"), rd('%\\'))
expect_equal(out$get_rd("usage"), '\\usage{\n%\\\n}')
})
test_that("Special vars removed in rc methods usage", {
out <- roc_proc_text(rd_roclet(), "
#' Class Blob
ABCD <- setRefClass('ABC', methods = list(
draw = function(x = 1) {
\"2\"
x
})
)
")[[1]]
expect_equal(out$get_value("rcmethods"), list("draw(x = 1)" = "2"))
})
# object_usage ------------------------------------------------------------
test_that("usage captured from formals", {
expect_equal(
call_to_usage(f <- function() {}),
"f()"
)
expect_equal(
call_to_usage(f <- function(a = 1) {}),
"f(a = 1)"
)
})
test_that("argument containing function is generates correct usage", {
expect_equal(
call_to_usage(f <- function(a = function(x) 1) {}),
"f(a = function(x) 1)"
)
})
test_that("backticks retained when needed", {
expect_equal(
call_to_usage(f <- function(`_a`) {}),
"f(`_a`)"
)
expect_equal(
call_to_usage(`-f` <- function(x) {}),
"`-f`(x)"
)
})
test_that("% escaped when not in infix function", {
expect_equal(
call_to_usage(`%foo%bar` <- function(x, table) {}),
"`\\%foo\\%bar`(x, table)"
)
expect_equal(
call_to_usage(`%foo%bar<-` <- function(x, value) {}),
"`\\%foo\\%bar`(x) <- value"
)
})
test_that("default usage formats data correctly", {
expect_equal(
call_to_usage(hello <- 1),
"hello"
)
})
test_that("default usage formats replacement functions correctly", {
expect_equal(
call_to_usage(`f<-` <- function(x, value) {}),
"f(x) <- value"
)
expect_equal(
call_to_usage(`f<-` <- function(x, y, value) {}),
"f(x, y) <- value"
)
})
test_that("default usage formats infix functions correctly", {
expect_equal(call_to_usage("%.%" <- function(a, b) {}), "a \\%.\\% b")
expect_equal(call_to_usage(":" <- function(a, b) {}), "a:b")
expect_equal(call_to_usage("+" <- function(a, b) {}), "a + b")
# even if it contains <-
expect_equal(call_to_usage("%<-%" <- function(a, b) {}), "a \\%<-\\% b")
# defaults are ignored
expect_equal(call_to_usage(":" <- function(a = 1, b = 2) {}), "a:b")
})
test_that("default usage formats S3 methods correctly", {
expect_equal(
call_to_usage(mean.foo <- function(x) {}),
"\\method{mean}{foo}(x)"
)
expect_equal(
call_to_usage(mean.function <- function(x) {}),
"\\method{mean}{`function`}(x)"
)
expect_equal(
call_to_usage("+.foo" <- function(x, b) {}),
"\\method{+}{foo}(x, b)"
)
expect_equal(
call_to_usage("%%.foo" <- function(x, b) {}),
"\\method{\\%\\%}{foo}(x, b)"
)
expect_equal(
call_to_usage("[<-.foo" <- function(x, value) {}),
"\\method{[}{foo}(x) <- value"
)
})
test_that("S4 classes have no default usage", {
expect_equal(
call_to_usage({
setClass("Foo")
}),
character()
)
})
test_that("default usage correct for S4 generics", {
expect_equal(
call_to_usage({
setGeneric("foo", function(x, y) {})
}),
"foo(x, y)"
)
})
test_that("default usage correct for S4 methods", {
expect_equal(
call_to_usage({
setClass("Foo")
setMethod("sum", "Foo", function(x, ..., na.rm = FALSE) {})
}),
"\\S4method{sum}{Foo}(x, ..., na.rm = FALSE)"
)
expect_equal(
call_to_usage({
setClass("Foo")
setMethod("+", "Foo", function(e1, e2) "foo")
}),
"\\S4method{+}{Foo,ANY}(e1, e2)"
)
expect_equal(
call_to_usage({
setClass("Foo")
setMethod("[<-", "Foo", function(x, i, j, ..., value) "foo")
}),
"\\S4method{[}{Foo}(x, i, j, ...) <- value"
)
expect_equal(
call_to_usage({
setGeneric("%&&%", function(x, y) standardGeneric("%&&%"))
setMethod("%&&%", signature("logical", "logical"), function(x, y) {})
}),
"\\S4method{\\%&&\\%}{logical,logical}(x, y)"
)
})
test_that("default usage correct for S4 methods with different args to generic", {
expect_equal(
call_to_usage({
setGeneric("testfun", function(x, ...) standardGeneric("testfun"))
setMethod("testfun", "matrix", function(x, add = FALSE, ...) {
x - 1
})
}),
"\\S4method{testfun}{matrix}(x, add = FALSE, ...)"
)
})
test_that("non-syntactic S4 class names are not escaped in usage", {
expect_equal(
call_to_usage({
setGeneric("rhs", function(x) standardGeneric("rhs"))
setMethod("rhs", "<-", function(x) x[[3]])
}),
"\\S4method{rhs}{<-}(x)"
)
})
# Wrapping --------------------------------------------------------------------
test_that("new wrapping style doesn't change unexpectedly", {
expect_snapshot_output({
cat(call_to_usage({
f <- function(a = ' a',
b = ' b',
c = ' c',
d = ' d') {}
}), "\n\n")
cat(call_to_usage({
f <- function(a = c('abcdef', 'abcdef', 'abcdef', 'abcdef', 'abcdef',
'abcdef', 'abcdef', 'abcdef', 'abcdef', 'abcdef')) {}
}), "\n\n")
cat(call_to_usage({
mean.reallyratherquitelongclassname <-
function(reallyreatherquitelongargument = 'reallyratherquitelongvalue_____________________') {}
}), "\n\n")
cat(call_to_usage({
`long_replacement_fun<-` <- function(x,
a = 'aaaaaaaaaaaaaaaa',
b = 'aaaaaaaaaaaaaaaa',
c = 'aaaaaaaaaaaaaaaa',
value) {}
}), "\n\n")
cat(call_to_usage({
function_name <- function(x, y, xy = "abcdef",
xyz = c(`word word word word` = "abcdef", `word word word` = "abcdef",
`word word word` = "abcdef", `word word word` = "abcdef")) {}
}), "\n\n")
cat(call_to_usage({
function_name <- function(
f = function(x) {
1
2
}) {}
}), "\n\n")
})
})
test_that("old wrapping style doesn't change unexpectedly", {
local_roxy_meta_set("old_usage", TRUE)
expect_snapshot_output({
cat(call_to_usage({
f <- function(a = ' a',
b = ' b',
c = ' c',
d = ' d') {}
}), "\n\n")
cat(call_to_usage({
f <- function(a = c('abcdef', 'abcdef', 'abcdef', 'abcdef', 'abcdef',
'abcdef', 'abcdef', 'abcdef', 'abcdef', 'abcdef')) {}
}), "\n\n")
cat(call_to_usage({
mean.reallyratherquitelongclassname <-
function(reallyreatherquitelongargument = 'reallyratherquitelongvalue_____________________') {}
}), "\n\n")
cat(call_to_usage({
`long_replacement_fun<-` <- function(x,
a = 'aaaaaaaaaaaaaaaa',
b = 'aaaaaaaaaaaaaaaa',
c = 'aaaaaaaaaaaaaaaa',
value) {}
}), "\n\n")
# breaking works after escapes (#265)
cat(call_to_usage({
f <- function(
xxxxxxxxxxxxxxxxxx1,
xxxxxxxxxxxxxxxxxx2,
xxxxxxxxxxxxxxxxxx3,
x = "\"'",
xxxxxxxxxxxxxxxxxx4,
xxxxxxxxxxxxxxxxxx5,
xxxxxxxxxxxxxxxxxx6,
xxxxxxxxxxxxxxxxxx7
) {}
}), "\n\n")
})
})
test_that("preserves non-breaking-space", {
expect_equal(
call_to_usage(f <- function(a = "\u{A0}") {}),
'f(a = "\u{A0}")'
)
})
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.