test_that("line_push() adds indentation", { out <- line_push("foo", "bar", width = 4, indent = 2) expect_identical(out, c("foo", " bar")) }) test_that("line_push() doesn't make a new line if current is only spaces", { expect_identical(line_push(" ", "foo", width = 2L), " foo") }) test_that("line_push() trims trailing spaces", { expect_identical(line_push("foo ", "bar", width = 1L), c("foo", "bar")) }) test_that("line_push() doesn't trim trailing spaces on sticky inputs", { expect_identical(line_push("tag", " = ", sticky = TRUE, width = 3L, indent = 2L), "tag = ") }) test_that("sticky input sticks", { expect_identical(line_push("foo ", "bar", sticky = TRUE, width = 1L), "foo bar") }) test_that("line_push() respects boundaries", { expect_identical(line_push("foo, ", "bar", boundary = 4L, width = 1L, indent = 2L), c("foo,", " bar")) expect_identical(line_push("foo, ", "bar", sticky = TRUE, boundary = 4L, width = 1L, indent = 2L), c("foo,", " bar")) expect_identical(line_push("foo, bar", "baz", boundary = 4L, width = 1L, indent = 2L), c("foo, bar", " baz")) }) test_that("line_push() handles the nchar(line) == boundary case", { expect_identical(line_push(" tag = ", "bar", sticky = TRUE, boundary = 8L, width = 3L, indent = 2L), " tag = bar") }) test_that("line_push() strips ANSI codes before computing overflow", { local_options(cli.num_colors = 8L) if (!has_ansi()) { skip("test needs cli") } expect_identical(length(line_push("foo", open_blue(), width = 3L)), 2L) expect_identical(length(line_push("foo", open_blue(), width = 3L, has_colour = TRUE)), 1L) }) test_that("can push several lines (useful for default base deparser)", { expect_identical(new_lines()$push(c("foo", "bar"))$get_lines(), "foobar") }) test_that("control flow is deparsed", { expect_identical(fn_call_deparse(expr(function(a, b) 1)), "function(a, b) 1") expect_identical(fn_call_deparse(expr(function(a = 1, b = 2) { 3; 4; 5 })), c("function(a = 1, b = 2) {", " 3", " 4", " 5", "}")) expect_identical(while_deparse(quote(while(1) 2)), "while (1) 2") expect_identical(for_deparse(quote(for(a in 2) 3)), "for (a in 2) 3") expect_identical(repeat_deparse(quote(repeat 1)), "repeat 1") expect_identical(if_deparse(quote(if (1) 2 else { 3 })), c("if (1) 2 else {", " 3", "}")) }) test_that("functions defs increase indent", { ctxt <- new_lines(width = 3L) expect_identical(sexp_deparse(quote(function() 1), ctxt), c("function()", " 1")) ctxt <- new_lines(width = 3L) expect_identical(sexp_deparse(function() 1, ctxt), c("")) }) test_that("blocks are deparsed", { expect_identical(braces_deparse(quote({1; 2; { 3; 4 }})), c("{", " 1", " 2", " {", " 3", " 4", " }", "}")) expect_identical_(sexp_deparse(quote({{ 1 }})), c("{", " {", " 1", " }", "}")) ctxt <- new_lines(width = 3L) expected_lines <- c("{", " 11111", " 22222", " {", " 33333", " 44444", " }", "}") expect_identical(braces_deparse(quote({11111; 22222; { 33333; 44444 }}), ctxt), expected_lines) }) test_that("multiple openers on the same line only trigger one indent", { ctxt <- new_lines(width = 3L) expect_identical(sexp_deparse(quote(function() { 1 }), ctxt), c("function()", " {", " 1", " }")) ctxt <- new_lines(width = 12L) expect_identical(sexp_deparse(quote(function() { 1 }), ctxt), c("function() {", " 1", "}")) }) test_that("multiple openers on the same line are correctly reset", { expect_identical(sexp_deparse(quote({ 1(2()) })), c("{", " 1(2())", "}")) }) test_that("parentheses are deparsed", { expect_identical(parens_deparse(quote((1))), "(1)") expect_identical(parens_deparse(quote(({ 1; 2 }))), c("({", " 1", " 2", "})")) expect_identical(sexp_deparse(quote(({({ 1 })}))), c("({", " ({", " 1", " })", "})")) }) test_that("spaced operators are deparsed", { expect_identical(spaced_op_deparse(quote(1 ? 2)), "1 ? 2") expect_identical(spaced_op_deparse(quote(1 <- 2)), "1 <- 2") expect_identical(spaced_op_deparse(quote(1 <<- 2)), "1 <<- 2") expect_identical(spaced_op_deparse(quote(`=`(1, 2))), "1 = 2") expect_identical(spaced_op_deparse(quote(1 := 2)), "1 := 2") expect_identical(spaced_op_deparse(quote(1 ~ 2)), "1 ~ 2") expect_identical(spaced_op_deparse(quote(1 | 2)), "1 | 2") expect_identical(spaced_op_deparse(quote(1 || 2)), "1 || 2") expect_identical(spaced_op_deparse(quote(1 & 2)), "1 & 2") expect_identical(spaced_op_deparse(quote(1 && 2)), "1 && 2") expect_identical(spaced_op_deparse(quote(1 > 2)), "1 > 2") expect_identical(spaced_op_deparse(quote(1 >= 2)), "1 >= 2") expect_identical(spaced_op_deparse(quote(1 < 2)), "1 < 2") expect_identical(spaced_op_deparse(quote(1 <= 2)), "1 <= 2") expect_identical(spaced_op_deparse(quote(1 == 2)), "1 == 2") expect_identical(spaced_op_deparse(quote(1 != 2)), "1 != 2") expect_identical(spaced_op_deparse(quote(1 + 2)), "1 + 2") expect_identical(spaced_op_deparse(quote(1 - 2)), "1 - 2") expect_identical(spaced_op_deparse(quote(1 * 2)), "1 * 2") expect_identical(spaced_op_deparse(quote(1 / 2)), "1 / 2") expect_identical(spaced_op_deparse(quote(1 %% 2)), "1 %% 2") expect_identical(spaced_op_deparse(quote(1 %>% 2)), "1 %>% 2") expect_identical(sexp_deparse(quote({ 1; 2 } + { 3; 4 })), c("{", " 1", " 2", "} + {", " 3", " 4", "}")) }) test_that("unspaced operators are deparsed", { expect_identical(unspaced_op_deparse(quote(1:2)), "1:2") expect_identical(unspaced_op_deparse(quote(1^2)), "1^2") expect_identical(unspaced_op_deparse(quote(a$b)), "a$b") expect_identical(unspaced_op_deparse(quote(a@b)), "a@b") expect_identical(unspaced_op_deparse(quote(a::b)), "a::b") expect_identical(unspaced_op_deparse(quote(a:::b)), "a:::b") }) test_that("operands are wrapped in parentheses to ensure correct predecence", { expect_identical_(sexp_deparse(expr(1 + !!quote(2 + 3))), "1 + (2 + 3)") expect_identical_(sexp_deparse(expr((!!quote(1^2))^3)), "(1^2)^3") skip_on_cran() skip_if(getRversion() < "4.0.0") expect_identical_(sexp_deparse(quote(function() 1 ? 2)), "(function() 1) ? 2") expect_identical_(sexp_deparse(expr(!!quote(function() 1) ? 2)), "(function() 1) ? 2") }) test_that("unary operators are deparsed", { expect_identical(unary_op_deparse(quote(?1)), "?1") expect_identical(unary_op_deparse(quote(~1)), "~1") expect_identical(unary_op_deparse(quote(!1)), "!1") expect_identical_(unary_op_deparse(quote(!!1)), "!!1") expect_identical_(unary_op_deparse(quote(!!!1)), "!!!1") expect_identical_(unary_op_deparse(quote(`!!`(1))), "!!1") expect_identical_(unary_op_deparse(quote(`!!!`(1))), "!!!1") expect_identical(unary_op_deparse(quote(+1)), "+1") expect_identical(unary_op_deparse(quote(-1)), "-1") }) test_that("brackets are deparsed", { expect_identical(sexp_deparse(quote(1[2])), c("1[2]")) expect_identical(sexp_deparse(quote(1[[2]])), c("1[[2]]")) ctxt <- new_lines(width = 1L) expect_identical(sexp_deparse(quote(1[2]), ctxt), c("1[", " 2]")) ctxt <- new_lines(width = 1L) expect_identical(sexp_deparse(quote(1[[2]]), ctxt), c("1[[", " 2]]")) }) test_that("calls are deparsed", { expect_identical(call_deparse(quote(foo(bar, baz))), "foo(bar, baz)") expect_identical(call_deparse(quote(foo(one = bar, two = baz))), "foo(one = bar, two = baz)") }) test_that("call_deparse() respects boundaries", { ctxt <- new_lines(width = 1L) expect_identical(call_deparse(quote(foo(bar, baz)), ctxt), c("foo(", " bar,", " baz)")) ctxt <- new_lines(width = 7L) expect_identical(call_deparse(quote(foo(bar, baz)), ctxt), c("foo(", " bar,", " baz)")) ctxt <- new_lines(width = 8L) expect_identical(call_deparse(quote(foo(bar, baz)), ctxt), c("foo(bar,", " baz)")) ctxt <- new_lines(width = 1L) expect_identical(call_deparse(quote(foo(one = bar, two = baz)), ctxt), c("foo(", " one = bar,", " two = baz)")) }) test_that("call_deparse() handles multi-line arguments", { ctxt <- new_lines(width = 1L) expect_identical(sexp_deparse(quote(foo(one = 1, two = nested(one = 1, two = 2))), ctxt), c("foo(", " one = 1,", " two = nested(", " one = 1,", " two = 2))")) ctxt <- new_lines(width = 20L) expect_identical(sexp_deparse(quote(foo(one = 1, two = nested(one = 1, two = 2))), ctxt), c("foo(one = 1, two = nested(", " one = 1, two = 2))")) }) test_that("call_deparse() delimits CAR when needed", { fn_call <- quote(function() x + 1) call <- expr((!!fn_call)()) expect_identical(call_deparse(call), "(function() x + 1)()") roundtrip <- parse_expr(expr_deparse(call)) exp <- call2(call("(", fn_call)) # Zap srcref to work around https://github.com/r-lib/waldo/issues/59 expect_equal(zap_srcref(roundtrip), zap_srcref(exp)) call <- expr((!!quote(f + g))(x)) expect_identical(call_deparse(call), "`+`(f, g)(x)") expect_identical(parse_expr(expr_deparse(call)), call) call <- expr((!!quote(+f))(x)) expect_identical(call_deparse(call), "`+`(f)(x)") expect_identical(parse_expr(expr_deparse(call)), call) call <- expr((!!quote(while (TRUE) NULL))(x)) expect_identical(call_deparse(call), "`while`(TRUE, NULL)(x)") expect_identical(parse_expr(expr_deparse(call)), call) call <- expr(foo::bar(x)) expect_identical(call_deparse(call), "foo::bar(x)") expect_identical(parse_expr(expr_deparse(call)), call) }) test_that("literal functions are deparsed", { expect_identical_(sexp_deparse(function(a) 1), "") expect_identical_(sexp_deparse(expr(foo(!!function(a) 1))), "foo()") }) test_that("literal dots are deparsed", { dots <- (function(...) env_get(, "..."))(NULL) expect_identical_(sexp_deparse(expr(foo(!!dots))), "foo(<...>)") }) test_that("environments are deparsed", { expect_identical(sexp_deparse(expr(foo(!! env()))), "foo()") }) test_that("atomic vectors are deparsed", { expect_identical(sexp_deparse(set_names(c(TRUE, FALSE, TRUE), c("", "b", ""))), "") expect_identical(sexp_deparse(set_names(1:3, c("", "b", ""))), "") expect_identical(sexp_deparse(set_names(c(1, 2, 3), c("", "b", ""))), "") expect_identical(sexp_deparse(set_names(as.complex(1:3), c("", "b", ""))), "") expect_identical(sexp_deparse(set_names(as.character(1:3), c("", "b", ""))), "") expect_identical(sexp_deparse(set_names(as.raw(1:3), c("", "b", ""))), "") }) test_that("boundaries are respected when deparsing vectors", { ctxt <- new_lines(width = 1L) vec <- set_names(1:3, c("", "b", "")) expect_identical_(sexp_deparse(expr(foo(!!vec)), ctxt), c("foo(", " )")) ctxt <- new_lines(width = 12L) expect_identical(sexp_deparse(list(c("foo", "bar", "baz")), ctxt), c(">")) }) test_that("scalar atomic vectors are simply printed", { expect_identical(sexp_deparse(TRUE), "TRUE") expect_identical(sexp_deparse(1L), "1L") expect_identical(sexp_deparse(1), "1") expect_identical(sexp_deparse(1i), "0+1i") expect_identical(sexp_deparse("1"), "\"1\"") }) test_that("scalar raw vectors are printed in long form", { expect_identical(sexp_deparse(as.raw(1)), "") }) test_that("literal lists are deparsed", { expect_identical(sexp_deparse(list(TRUE, b = 2L, 3, d = "4", as.raw(5))), ">") }) test_that("long vectors are truncated by default", { expect_identical(sexp_deparse(1:10), "") expect_identical(sexp_deparse(as.list(1:10)), "") }) test_that("long vectors are truncated when max_elements = 0L", { lines <- new_lines(max_elements = 0L) expect_identical(sexp_deparse(1:10, lines), "") lines <- new_lines(max_elements = 0L) expect_identical(sexp_deparse(as.list(1:10), lines), "") }) test_that("long vectors are not truncated when max_elements = NULL", { lines <- new_lines(max_elements = NULL) expect_identical(sexp_deparse(1:10, lines), "") lines <- new_lines(max_elements = NULL) expect_identical(sexp_deparse(as.list(1:10), lines), "") }) test_that("other objects are deparsed with base deparser", { expect_identical_(sexp_deparse(expr(foo((!!base::list)(1, 2)))), "foo(.Primitive(\"list\")(1, 2))") expect_identical_(sexp_deparse(expr(foo((!!base::`if`)(1, 2)))), "foo(.Primitive(\"if\")(1, 2))") }) test_that("S3 objects are deparsed", { skip_on_cran() expr <- expr(list(!!factor(1:3), !!structure(list(), class = c("foo", "bar", "baz")))) expect_identical(sexp_deparse(expr), "list(, )") }) test_that("successive indentations on a single line are only counted once", { ctxt <- new_lines(5L) broken_output <- c(">") expect_identical(sexp_deparse(list(c(foo = "bar", baz = "bam")), ctxt), broken_output) ctxt <- new_lines(12L) unbroken_output <- c(">") expect_identical(sexp_deparse(list(c(foo = "bar", baz = "bam")), ctxt), unbroken_output) }) test_that("successive indentations close off properly", { expect_identical(sexp_deparse(quote(1(2(), 3(4())))), "1(2(), 3(4()))") expect_identical(sexp_deparse(quote(1(2(), 3(4()))), new_lines(width = 1L)), c("1(", " 2(),", " 3(", " 4()))")) expect_identical(sexp_deparse(expr(c((1), function() { 2 }))), c("c((1), function() {", " 2", "})")) }) test_that("empty quosures are deparsed", { expect_identical(strip_style(quo_deparse(quo())), "^") }) test_that("missing values are deparsed", { expect_identical(expr_deparse(NA), "NA") expect_identical(expr_deparse(NaN), "NaN") expect_identical(expr_deparse(NA_integer_), "NA_integer_") expect_identical(expr_deparse(NA_real_), "NA_real_") expect_identical(expr_deparse(NA_complex_), "NA_complex_") expect_identical(expr_deparse(NA_character_), "NA_character_") expect_identical(expr_deparse(c(NaN, 2, NA)), "") expect_identical(expr_deparse(c(foo = NaN)), "") expect_identical(sexp_deparse(c(name = NA)), "") expect_identical(sexp_deparse(c(NA, "NA")), "") expect_identical(sexp_deparse(quote(call(NA))), "call(NA)") expect_identical(sexp_deparse(quote(call(NA_integer_))), "call(NA_integer_)") expect_identical(sexp_deparse(quote(call(NA_real_))), "call(NA_real_)") expect_identical(sexp_deparse(quote(call(NA_complex_))), "call(NA_complex_)") expect_identical(sexp_deparse(quote(call(NA_character_))), "call(NA_character_)") }) test_that("needs_backticks() detects non-syntactic symbols", { expect_true(all(map_lgl(reserved_words, needs_backticks))) expect_false(any(map_lgl(c(".", "a", "Z"), needs_backticks))) expect_true(all(map_lgl(c("1", ".1", "~", "!"), needs_backticks))) expect_true(all(map_lgl(c("_", "_foo", "1foo"), needs_backticks))) expect_true(all(map_lgl(c(".fo!o", "b&ar", "baz <- _baz", "~quux.", "h~unoz_"), needs_backticks))) expect_false(any(map_lgl(c(".foo", "._1", "bar", "baz_baz", "quux.", "hunoz_", "..."), needs_backticks))) expect_false(needs_backticks(expr())) }) test_that("expr_text() and expr_name() interpret unicode tags (#611)", { expect_identical(expr_text(quote(``)), "o") expect_identical(expr_name(quote(`~f`)), "~foo") expect_identical(as_label(quote(`~f`)), "~foo") }) test_that("expr_text() deparses non-syntactic symbols with backticks (#211)", { expect_identical(expr_text(sym("~foo")), "`~foo`") expect_identical(expr_text(sym("~f")), "`~foo`") expect_identical(expr_text(call("~foo")), "`~foo`()") }) test_that("expr_text() deparses empty arguments", { expect_identical(expr_text(expr()), "") expect_identical(quo_text(expr()), "") expect_identical(quo_text(quo()), "") }) test_that("expr_name() deparses empty arguments", { expect_identical(expr_name(expr()), "") expect_identical(quo_name(quo()), "") expect_identical(names(quos_auto_name(quos(, ))), "") expect_identical(as_label(expr()), "") }) test_that("expr_deparse() handles newlines in strings (#484)", { x <- "foo\n" expect_identical(expr_deparse(x), "\"foo\\n\"") expect_output(expr_print(x), "foo\\n", fixed = TRUE) roundtrip <- parse_expr(expr_deparse(x)) expect_identical(x, roundtrip) }) test_that("expr_deparse() handles ANSI escapes in strings", { expect_identical(expr_deparse("\\"), deparse("\\")) expect_identical(expr_deparse("\\a"), deparse("\\a")) expect_identical(expr_deparse("\\b"), deparse("\\b")) expect_identical(expr_deparse("\\f"), deparse("\\f")) expect_identical(expr_deparse("\\n"), deparse("\\n")) expect_identical(expr_deparse("\\r"), deparse("\\r")) expect_identical(expr_deparse("\\t"), deparse("\\t")) expect_identical(expr_deparse("\\v"), deparse("\\v")) expect_identical(expr_deparse("\\0"), deparse("\\0")) }) test_that("as_label() and expr_name() handles .data pronoun", { expect_identical(expr_name(quote(.data[["bar"]])), "bar") expect_identical(quo_name(quo(.data[["bar"]])), "bar") expect_identical(as_label(quote(.data[["bar"]])), "bar") expect_identical(as_label(quo(.data[["bar"]])), "bar") }) test_that("as_label() handles literals", { expect_identical(as_label(1:2), "") expect_identical(as_label(c(1, 2)), "") expect_identical(as_label(letters), "") expect_identical(as_label(base::list), "") expect_identical(as_label(base::mean), "") }) test_that("as_label() handles objects", { skip_on_cran() expect_identical(as_label(mtcars), "") expect_identical(as_label(structure(1, class = "foo")), "") }) test_that("bracket deparsing is a form of argument deparsing", { expect_identical(expr_deparse(quote(foo[bar, , baz()])), "foo[bar, , baz()]") expect_identical(expr_deparse(quote(foo[[bar, , baz()]])), "foo[[bar, , baz()]]") skip_on_cran() expect_identical(expr_deparse(call("[", iris, missing_arg(), drop = FALSE)), "[, drop = FALSE]") }) test_that("non-syntactic symbols are deparsed with backticks", { expect_identical(expr_deparse(quote(`::foo`)), "`::foo`") expect_identical(expr_deparse(quote(x(`_foo`))), "x(`_foo`)") expect_identical(expr_deparse(quote(x[`::foo`])), "x[`::foo`]") }) test_that("symbols with unicode are deparsed consistently (#691)", { skip_if(getRversion() < "3.2") expect_identical(expr_text(sym("\u00e2a")), "\u00e2a") expect_identical(expr_deparse(sym("\u00e2a")), "\u00e2a") expect_identical(expr_text(sym("a\u00e2")), "a\u00e2") expect_identical(expr_deparse(sym("a\u00e2")), "a\u00e2") }) test_that("formal parameters are backticked if needed", { expect_identical(expr_deparse(function(`^`) {}), c("")) }) test_that("empty blocks are deparsed on the same line", { expect_identical(expr_deparse(quote({ })), "{ }") }) test_that("top-level S3 objects are deparsed", { skip_on_cran() f <- structure(function() { }, class = "lambda") expect_identical(expr_deparse(f), "") }) # This test causes a parsing failure in R CMD check >= 3.6 # # test_that("binary operators with 0 or 1 arguments are properly deparsed", { # expect_identical_(expr_deparse(quote(`/`())), "`/`()") # expect_identical(expr_deparse(quote(`/`("foo"))), "`/`(\"foo\")") # expect_identical_(expr_deparse(quote(`::`())), "`::`()") # expect_identical(expr_deparse(quote(`::`("foo"))), "`::`(\"foo\")") # }) test_that("as_label() supports symbols, calls, and literals", { expect_identical(as_label(quote(foo)), "foo") expect_identical(as_label(quote(foo(bar))), "foo(bar)") expect_identical(as_label(1L), "1L") expect_identical(as_label("foo"), "\"foo\"") expect_identical(as_label(function() NULL), "") expect_identical(as_label(expr(function() { a; b })), "function() ...") expect_identical(as_label(1:2), "") expect_identical(as_label(env()), "") }) test_that("as_label() supports special objects", { expect_match(as_label(quote(foo := bar)), ":=") expect_identical(as_label(quo(foo)), "foo") expect_identical(as_label(quo(foo(!!quo(bar)))), "foo(bar)") expect_identical(as_label(~foo), "~foo") expect_identical(as_label(NULL), "NULL") }) test_that("as_name() supports quosured symbols and strings", { expect_identical(as_name(quo(foo)), "foo") expect_identical(as_name(quo("foo")), "foo") expect_error(as_name(quo(foo())), "Can't convert a call to a string") }) test_that("named empty lists are marked as named", { expect_identical(expr_deparse(set_names(list(), chr())), "") }) test_that("infix operators are sticky", { expect_identical(expr_deparse(quote(foo %>% bar), width = 3L), c("foo %>%", " bar")) expect_identical(expr_deparse(quote(foo + bar), width = 3L), c("foo +", " bar")) }) test_that("argument names are backticked if needed (#950)", { expect_identical(expr_deparse(quote(list(`a b` = 1))), "list(`a b` = 1)") }) test_that("`next` and `break` are deparsed", { expect_equal(expr_deparse(quote({ next; (break) })), c("{", " next", " (break)", "}")) expect_equal(expr_deparse(quote(a <- next <- break)), c("a <- next <- break")) }) test_that("double colon is never wrapped (#1072)", { expect_identical( expr_deparse(quote(some.very.long::construct), width = 20), "some.very.long::construct" ) expect_identical( expr_deparse(quote(id_function <- base::identity), width = 15), c( "id_function <-", " base::identity" ) ) expect_identical( expr_deparse(quote(id_fun <- base::identity), width = 20), "id_fun <- base::identity" ) }) test_that("triple colon is never wrapped (#1072)", { expect_identical( expr_deparse(quote(some.very.long:::construct), width = 20), "some.very.long:::construct" ) expect_identical( expr_deparse(quote(id_function <- base:::identity), width = 15), c( "id_function <-", " base:::identity" ) ) expect_identical( expr_deparse(quote(id_fun <- base:::identity), width = 20), "id_fun <- base:::identity" ) }) test_that("backslashes in strings are properly escaped (#1160)", { expect_equal( expr_deparse(sym("a\\b")), "`a\\\\b`" ) # Escaping ensures this roundtrip expect_equal( parse_expr(expr_deparse(sym("a\\b"))), sym("a\\b") ) # Argument names expect_equal( expr_deparse(quote(c("a\\b" = "c\\d"))), "c(`a\\\\b` = \"c\\\\d\")" ) # Vector names expect_equal( expr_deparse(c("a\\b" = "c\\d")), "" ) expect_equal( expr_deparse(list("a\\b" = "c\\d")), "" ) }) test_that("formulas are deparsed (#1169)", { # Evaluated formulas are treated as objects expect_equal( expr_deparse(~foo), "" ) # Unevaluated formulas with a symbol have no space expect_equal( expr_deparse(quote(~foo)), "~foo" ) # Unevaluated formulas with expressions have a space expect_equal( expr_deparse(quote(~+foo)), "~ +foo" ) expect_equal( expr_deparse(quote(~foo())), "~ foo()" ) }) test_that("matrices and arrays are formatted (#383)", { mat <- matrix(1:3) expect_equal(as_label(mat), "") expect_equal(expr_deparse(mat), "") mat2 <- matrix(1:4, 2) expect_equal(as_label(mat2), "") expect_equal(expr_deparse(mat2), "") arr <- array(1:3, c(1, 1, 3)) expect_equal(as_label(arr), "") expect_equal(expr_deparse(arr), "") }) test_that("infix operators are labelled (#956, r-lib/testthat#1432)", { expect_equal( as_label(quote({ 1; 2} + 3)), "... + 3" ) expect_equal( as_label(quote(`+`(1, 2, 3))), "`+`(1, 2, 3)" ) expect_equal( as_label(quote( arg + arg + arg + arg + arg + arg + arg + arg + arg + arg + arg + arg )), "... + arg" ) expect_equal( as_label(quote(X[key1 == "val1" & key2 == "val2"]$key3 & foobarbaz(foobarbaz(foobarbaz(foobarbaz(foobarbaz(foobarbaz(foobarbaz())))))))), "X[key1 == \"val1\" & key2 == \"val2\"]$key3 & ..." ) expect_equal( as_label(quote(X[key1 == "val1"]$key3 & foobarbaz(foobarbaz()))), "X[key1 == \"val1\"]$key3 & foobarbaz(foobarbaz())" ) # This fits in 60 characters so we don't need to truncate it expect_equal( as_label(quote(nchar(chr, type = "bytes", allowNA = TRUE) == 1)), "nchar(chr, type = \"bytes\", allowNA = TRUE) == 1" ) # This fits into 60 characters if we truncate either side, # so we don't need to shorten both of them expect_equal( as_label(quote(very_long_expression[with(subsetting), -1] - another_very_long_expression[with(subsetting), -1] )), "very_long_expression[with(subsetting), -1] - ..." ) lhs_perfect_fit <- sym(paste(rep("a", 56), collapse = "")) lhs_no_fit <- sym(paste(rep("a", 57), collapse = "")) expect_equal( as_label(expr(!!lhs_perfect_fit + 1)), "aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa + 1" ) expect_equal( as_label(expr(!!lhs_perfect_fit + 10)), "... + 10" ) expect_equal( as_label(expr(1 + !!lhs_perfect_fit)), "1 + aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa" ) expect_equal( as_label(expr(10 + !!lhs_perfect_fit)), "10 + ..." ) expect_equal( as_label(expr(!!lhs_no_fit + 1)), "... + 1" ) expect_equal( as_label(expr(!!lhs_no_fit + !!lhs_no_fit)), "... + ..." ) }) test_that("binary op without arguments", { expect_equal( expr_deparse(quote(`+`())), "`+`()" ) expect_equal( expr_deparse(quote(`$`())), "`$`()" ) expect_equal( expr_deparse(quote(`~`())), "`~`()" ) }) test_that("call_deparse_highlight() handles long lists of arguments (#1456)", { out <- call_deparse_highlight(quote( foo( aaaaaa = aaaaaa, bbbbbb = bbbbbb, cccccc = cccccc, dddddd = dddddd, eeeeee = eeeeee ) ), NULL) expect_equal( cli::ansi_strip(out), "foo(...)" ) }) test_that("call_deparse_highlight() handles multi-line arguments (#1456)", { out <- call_deparse_highlight(quote( fn(arg = { a b }) ), NULL) expect_equal( cli::ansi_strip(out), "fn(...)" ) }) test_that("embrace operator is deparsed (#1511)", { expect_equal_( expr_deparse(quote({{ a }})), "{{ a }}" ) expect_equal_( expr_deparse(quote(foo({{ a }}))), "foo({{ a }})" ) })