Skip to content

Instantly share code, notes, and snippets.

@MichaelChirico
Created November 10, 2023 18:13
Show Gist options
  • Save MichaelChirico/9164672a4e762627c09ad6b521e54964 to your computer and use it in GitHub Desktop.
Save MichaelChirico/9164672a4e762627c09ad6b521e54964 to your computer and use it in GitHub Desktop.
explicit_return_linter tests
test_that("explicit_return_linter works in simple function", {
lines <- c(
"foo <- function(bar) {",
" return(bar)",
"}"
)
expect_lint(lines, NULL, explicit_return_linter())
})
test_that("explicit_return_linter works for using stop() instead of returning", {
lines <- c(
"foo <- function(bar) {",
" stop('bad')",
"}"
)
expect_lint(lines, NULL, explicit_return_linter())
stop_if_not_lines <- c(
"foo <- function(bar) {",
" stopifnot(bar == 'bad')",
"}"
)
expect_lint(stop_if_not_lines, NULL, explicit_return_linter())
})
test_that("explicit_return_linter ignores expressions that aren't functions", {
expect_lint(
"x + 1", NULL, explicit_return_linter()
)
})
test_that("explicit_return_linter ignores anonymous/inline functions", {
lines <- "lapply(rnorm(10), function(x) x + 1)"
expect_lint(lines, NULL, explicit_return_linter())
})
test_that("explicit_return_linter ignores if statements outside of functions", {
lines <- c(
"if(TRUE) {",
" TRUE",
"} else {",
" FALSE",
"}"
)
expect_lint(lines, NULL, explicit_return_linter())
})
test_that("explicit_return_linter passes on multi-line functions", {
lines <- c(
"foo <- function(x) {",
" y <- x + 1",
" return(y)",
"}"
)
expect_lint(lines, NULL, explicit_return_linter())
})
test_that("explicit_return_linter identifies a simple missing return", {
lines <- c(
"foo <- function(bar) {",
" bar",
"}"
)
expect_lint(
lines,
"All functions must have an explicit return\\(\\).",
explicit_return_linter()
)
})
test_that("explicit_return_linter finds a missing return in a 2+ line function", {
lines <- c(
"foo <- function(x) {",
" y <- x + 1",
" y^2",
"}"
)
expect_lint(
lines,
"All functions must have an explicit return\\(\\).",
explicit_return_linter()
)
})
test_that("explicit_return_linter finds a missing return despite early returns", {
lines <- c(
"foo <- function(x) {",
" if (TRUE) return(TRUE)",
" x <- 1 + 1",
" x",
"}"
)
expect_lint(
lines,
"All functions must have an explicit return\\(\\).",
explicit_return_linter()
)
})
test_that("explicit_return_linter finds multiple missing returns in branches", {
lines <- c(
"foo <- function() {",
" if(TRUE) {",
" TRUE",
" } else {",
" FALSE",
" }",
"}"
)
expect_lint(
lines,
list(
"All functions must have an explicit return\\(\\).",
"All functions must have an explicit return\\(\\)."
),
explicit_return_linter()
)
})
test_that("explicit_return_linter works regardless of braces in final if case", {
lines <- c(
"foo <- function() {",
" if(TRUE) TRUE",
"}"
)
expect_lint(
lines,
"All functions must have an explicit return\\(\\).",
explicit_return_linter()
)
other_lines <- c(
"foo <- function() {",
" if(TRUE) return(TRUE)",
"}"
)
expect_lint(other_lines, NULL, explicit_return_linter())
})
test_that("explicit_return_linter finds missing return in one branch of an if", {
lines <- c(
"foo <- function() {",
" if(TRUE) {",
" return(TRUE)",
" } else {",
" FALSE",
" }",
"}"
)
expect_lint(
lines,
"All functions must have an explicit return\\(\\).",
explicit_return_linter()
)
lines_other_way <- c(
"foo <- function() {",
" if(TRUE) {",
" TRUE",
" } else {",
" return(FALSE)",
" }",
"}"
)
expect_lint(
lines_other_way,
"All functions must have an explicit return\\(\\).",
explicit_return_linter()
)
})
test_that("explicit_return_linter works in nested if statements", {
lines <- c(
"foo <- function() {",
" if(TRUE) {",
" return(TRUE)",
" } else if (nzchar(\"a\")) {",
" return(TRUE)",
" } else {",
" return(FALSE)",
" }",
"}"
)
expect_lint(lines, NULL, explicit_return_linter())
more_lines <- c(
"foo <- function() {",
" if(TRUE) {",
" if (nzchar(\"a\")) {",
" TRUE",
" }",
" } else {",
" return(FALSE)",
" }",
"}"
)
expect_lint(
more_lines,
"All functions must have an explicit return\\(\\).",
explicit_return_linter()
)
})
test_that("explicit_return_linter works in multi-line nested if statements", {
lines <- c(
"foo <- function() {",
" if(TRUE) {",
" if (nzchar(\"a\")) {",
" y <- 1 + 1",
" y",
" }",
" } else {",
" return(FALSE)",
" }",
"}"
)
expect_lint(
lines,
"All functions must have an explicit return\\(\\).",
explicit_return_linter()
)
other_lines <- c(
"foo <- function() {",
" if(TRUE) {",
" if (nzchar(\"a\")) {",
" y <- 1 + 1",
" return(y)",
" }",
" } else {",
" return(FALSE)",
" }",
"}"
)
expect_lint(other_lines, NULL, explicit_return_linter())
})
test_that("explicit_return_linter works for final for loops as well", {
lines <- c(
"foo <- function() {",
" for (i in seq_len(10)) {",
" if (i %% 2 == 0) {",
" y <- 1 + 1",
" return(y)",
" }",
" }",
"}"
)
expect_lint(lines, NULL, explicit_return_linter())
other_lines <- c(
"foo <- function() {",
" for (i in seq_len(10)) {",
" if (i %% 2 == 0) {",
" y <- 1 + 1",
" }",
" }",
"}"
)
expect_lint(
other_lines,
"All functions must have an explicit return\\(\\).",
explicit_return_linter()
)
})
test_that("explicit_return_linter works for function factories", {
lines <- c(
"foo <- function(x) {",
" function () {",
" return(x + 1)",
" }",
"}"
)
expect_lint(
lines,
"All functions must have an explicit return\\(\\).",
explicit_return_linter()
)
failing_lines <- c(
"foo <- function(x) {",
" function () {",
" x + 1",
" }",
"}"
)
expect_lint(
failing_lines,
list(
"All functions must have an explicit return\\(\\).",
"All functions must have an explicit return\\(\\)."
),
explicit_return_linter()
)
})
test_that("explicit_return_linter allows return()-less Rcpp wrappers", {
lines <- c(
"ReadCapacitorAsList <- function(file) {",
" .Call(R_ReadCapacitorAsList, file)",
"}"
)
expect_lint(lines, NULL, explicit_return_linter())
})
test_that("explicit_return_linter allows return()-less namespace hook calls", {
lines <- c(
".onLoad <- function(libname, pkgname) {",
" nativesupport::LoadNativeExtension()",
"}"
)
expect_lint(lines, NULL, explicit_return_linter())
})
test_that("explicit_return_linter correctly handles pipes", {
lines <- c(
"foo <- function(x) {",
" x %>%",
" return()",
"}"
)
expect_lint(lines, NULL, explicit_return_linter())
multiple_function_lines <- c(
"foo <- function(x) {",
" x %>%",
" mean() %>%",
" return()",
"}"
)
expect_lint(multiple_function_lines, NULL, explicit_return_linter())
preceding_pipe_lines <- c(
"foo <- function(x) {",
" y <- rnorm(length(x))",
"",
" x %>%",
" cbind(y) %>%",
" return()",
"}"
)
expect_lint(preceding_pipe_lines, NULL, explicit_return_linter())
})
test_that("explicit_return_linter handles pipes in control flow", {
lines <- c(
"foo <- function(x) {",
" if (TRUE) {",
" return(invisible())",
" } else {",
" x %>%",
" return()",
" }",
"}"
)
expect_lint(lines, NULL, explicit_return_linter())
bad_lines <- c(
"foo <- function(x) {",
" for (i in seq_len(10)) {",
" x %>%",
" mean()",
" }",
"}"
)
expect_lint(
bad_lines,
"All functions must have an explicit return\\(\\).",
explicit_return_linter()
)
missing_branch_lines <- c(
"foo <- function(x) {",
" if (TRUE) {",
" x %>%",
" mean()",
" } else {",
" return(TRUE)",
" }",
"}"
)
expect_lint(
missing_branch_lines,
"All functions must have an explicit return\\(\\).",
explicit_return_linter()
)
})
test_that("explicit_return_linter passes on q() or quit() calls", {
lines <- c(
"foo <- function(x) {",
" if (TRUE) {",
" q('n')",
" } else {",
" quit('n')",
" }",
"}"
)
expect_lint(lines, NULL, explicit_return_linter())
})
test_that("explicit_return_linter passes on .setUp/.tearDown calls", {
setup_lines <- c(
".setUp <- function() {",
" options(foo = TRUE)",
"}"
)
expect_lint(setup_lines, NULL, explicit_return_linter())
teardown_lines <- c(
".tearDown <- function() {",
" options(foo = TRUE)",
"}"
)
expect_lint(teardown_lines, NULL, explicit_return_linter())
})
test_that("explicit_return_linter allows RUnit tests to pass", {
lines <- c(
"TestKpSxsSummary <- function() {",
" context <- foo(72643424)",
" expected <- data.frame(a = 2)",
" checkEquals(expected, bar(context))",
"}"
)
expect_lint(lines, NULL, explicit_return_linter())
custom_lines <- c(
"TestMyPackage <- function() {",
" checkMyCustomComparator(x, y)",
"}"
)
expect_lint(custom_lines, NULL, explicit_return_linter())
})
test_that("explicit_return_linter skips RUnit functions in argumented tests", {
lines <- c(
"TestKpSxsSummary <- function(an_argument) {",
" context <- foo(an_argument)",
" expected <- data.frame(a = 2)",
" checkEquals(expected, bar(context))",
"}"
)
expect_lint(lines, NULL, explicit_return_linter())
})
test_that("explicit_return_linter skips terminal LOG and logging::LOG", {
lines <- c(
"foo <- function(bar) {",
" LOG('INFO', 'bad')",
"}"
)
expect_lint(lines, NULL, explicit_return_linter())
ns_lines <- c(
"foo <- function(bar) {",
" logging::LOG('INFO', 'bad')",
"}"
)
expect_lint(ns_lines, NULL, explicit_return_linter())
})
test_that("explicit_return_linter skips brace-wrapped inline functions", {
expect_lint("function(x) { sum(x) }", NULL, explicit_return_linter())
})
test_that("explicit_return_linter skips common S4 method functions", {
lines_standard_generic <- c(
"setGeneric(",
' "ReadCircuitsPBAsDataTable",',
" function(pbMessageList) {",
' standardGeneric("ReadCircuitsPBAsDataTable")',
" }",
")"
)
expect_lint(lines_standard_generic, NULL, explicit_return_linter())
lines_call_next_method <- c(
'setMethod("initialize", "CircuitsTopology", function(.Object, ...) {',
" callNextMethod(.Object, ...)",
"})"
)
expect_lint(lines_call_next_method, NULL, explicit_return_linter())
})
test_that("explicit_return_linter skips rlang::abort", {
lines <- c(
"foo <- function(bar) {",
" abort('bad')",
"}"
)
expect_lint(lines, NULL, explicit_return_linter())
ns_lines <- c(
"foo <- function(bar) {",
" rlang::abort('bad')",
"}"
)
expect_lint(ns_lines, NULL, explicit_return_linter())
})
test_that("explicit_return_linter skips invokeRestart(), tryInvokeRestart()", {
invoke_lines <- c(
"warning = function(w) {",
" warn <<- append(warn, conditionMessage(w))",
' invokeRestart("muffleWarning")',
"}"
)
expect_lint(invoke_lines, NULL, explicit_return_linter())
try_invoke_lines <- c(
"custom_warning = function(w) {",
" warn <<- append(warn, conditionMessage(w))",
' tryInvokeRestart("muffleCustom_warning")',
"}"
)
expect_lint(try_invoke_lines, NULL, explicit_return_linter())
})
# NB: x |> return() is blocked by the parser, so no need to test that.
test_that("Native pipes are handled correctly", {
expect_lint(
c(
"foo <- function(x) {",
" for (i in seq_len(10)) {",
" x |>",
" mean()",
" }",
"}"
),
"All functions must have an explicit return\\(\\).",
explicit_return_linter()
)
expect_lint(
c(
"foo <- function(x) {",
" if (TRUE) {",
" x |>",
" mean()",
" } else {",
" return(TRUE)",
" }",
"}"
),
"All functions must have an explicit return\\(\\).",
explicit_return_linter()
)
})
test_that("explicit_return_linter works for final while/repeat loops as well", {
while_lines <- c(
"foo <- function(x) {",
" while (x > 0) {",
" if (x %% 2 == 0) {",
" return(x)",
" }",
" x <- x + sample(10, 1)",
" }",
"}"
)
expect_lint(while_lines, NULL, explicit_return_linter())
repeat_lines <- c(
"foo <- function(x) {",
" repeat {",
" if (x == 0) {",
" return(x)",
" }",
" x <- x - sign(x)",
" }",
"}"
)
expect_lint(repeat_lines, NULL, explicit_return_linter())
})
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment