explicit_return_linter tests

test-explicit_return_linter.R

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())
})