|
| 1 | +#' Return linter |
| 2 | +#' |
| 3 | +#' This linter checks functions' [return()] expressions. |
| 4 | +#' |
| 5 | +#' @param return_style Character string naming the return style. `"implicit"`, |
| 6 | +#' the default, enforeces the Tidyverse guide recommendation to leave terminal |
| 7 | +#' returns implicit. `"explicit"` style requires that `return()` always be |
| 8 | +#' explicitly supplied. |
| 9 | +#' @param return_functions Character vector of functions that are accepted as terminal calls |
| 10 | +#' when `return_style = "explicit"`. These are in addition to exit functions |
| 11 | +#' from base that are always allowed: [stop()], [q()], [quit()], [invokeRestart()], |
| 12 | +#' `tryInvokeRestart()`, [UseMethod()], [NextMethod()], [standardGeneric()], |
| 13 | +#' [callNextMethod()], [.C()], [.Call()], [.External()], and [.Fortran()]. |
| 14 | +#' @param except Character vector of functions that are not checked when |
| 15 | +#' `return_style = "explicit"`. These are in addition to namespace hook functions |
| 16 | +#' that are never checked: `.onLoad()`, `.onUnload()`, `.onAttach()`, `.onDetach()`, |
| 17 | +#' `.Last.lib()`, `.First()` and `.Last()`. |
| 18 | +#' |
| 19 | +#' @examples |
| 20 | +#' # will produce lints |
| 21 | +#' code <- "function(x) {\n return(x + 1)\n}" |
| 22 | +#' writeLines(code) |
| 23 | +#' lint( |
| 24 | +#' text = code, |
| 25 | +#' linters = return_linter() |
| 26 | +#' ) |
| 27 | +#' |
| 28 | +#' code <- "function(x) {\n x + 1\n}" |
| 29 | +#' writeLines(code) |
| 30 | +#' lint( |
| 31 | +#' text = code, |
| 32 | +#' linters = return_linter(return_style = "explicit") |
| 33 | +#' ) |
| 34 | +#' |
| 35 | +#' # okay |
| 36 | +#' code <- "function(x) {\n x + 1\n}" |
| 37 | +#' writeLines(code) |
| 38 | +#' lint( |
| 39 | +#' text = code, |
| 40 | +#' linters = return_linter() |
| 41 | +#' ) |
| 42 | +#' |
| 43 | +#' code <- "function(x) {\n return(x + 1)\n}" |
| 44 | +#' writeLines(code) |
| 45 | +#' lint( |
| 46 | +#' text = code, |
| 47 | +#' linters = return_linter(return_style = "explicit") |
| 48 | +#' ) |
| 49 | +#' |
| 50 | +#' |
| 51 | +#' @evalRd rd_tags("return_linter") |
| 52 | +#' @seealso |
| 53 | +#' - [linters] for a complete list of linters available in lintr. |
| 54 | +#' - <https://style.tidyverse.org/functions.html?q=return#return> |
| 55 | +#' @export |
| 56 | +return_linter <- function( |
| 57 | + return_style = c("implicit", "explicit"), |
| 58 | + return_functions = NULL, |
| 59 | + except = NULL) { |
| 60 | + return_style <- match.arg(return_style) |
| 61 | + |
| 62 | + if (return_style == "implicit") { |
| 63 | + xpath <- " |
| 64 | + (//FUNCTION | //OP-LAMBDA) |
| 65 | + /following-sibling::expr[1][*[1][self::OP-LEFT-BRACE]] |
| 66 | + /expr[last()][ |
| 67 | + expr[1][ |
| 68 | + not(OP-DOLLAR or OP-AT) |
| 69 | + and SYMBOL_FUNCTION_CALL[text() = 'return'] |
| 70 | + ] |
| 71 | + ] |
| 72 | + " |
| 73 | + msg <- "Use implicit return behavior; explicit return() is not needed." |
| 74 | + } else { |
| 75 | + # See `?.onAttach`; these functions are all exclusively used for their |
| 76 | + # side-effects, so implicit return is generally acceptable |
| 77 | + |
| 78 | + except <- union(special_funs, except) |
| 79 | + |
| 80 | + base_return_functions <- c( |
| 81 | + # Normal calls |
| 82 | + "return", "stop", "q", "quit", |
| 83 | + "invokeRestart", "tryInvokeRestart", |
| 84 | + |
| 85 | + # Functions related to S3 methods |
| 86 | + "UseMethod", "NextMethod", |
| 87 | + |
| 88 | + # Functions related to S4 methods |
| 89 | + "standardGeneric", "callNextMethod", |
| 90 | + |
| 91 | + # Functions related to C interfaces |
| 92 | + ".C", ".Call", ".External", ".Fortran" |
| 93 | + ) |
| 94 | + |
| 95 | + return_functions <- union(base_return_functions, return_functions) |
| 96 | + |
| 97 | + control_calls <- c("IF", "FOR", "WHILE", "REPEAT") |
| 98 | + |
| 99 | + # from top, look for a FUNCTION definition that uses { (one-line |
| 100 | + # function definitions are excepted), then look for failure to find |
| 101 | + # return() on the last() expr of the function definition. |
| 102 | + # exempt .onLoad which shows up in the tree like |
| 103 | + # <expr><expr><SYMBOL>.onLoad</></><LEFT_ASSIGN></><expr><FUNCTION>... |
| 104 | + # simple final expression (no control flow) must be |
| 105 | + # <expr><expr> CALL( <expr> ) </expr></expr> |
| 106 | + # NB: if this syntax _isn't_ used, the node may not be <expr>, hence |
| 107 | + # the use of /*[...] below and self::expr here. position() = 1 is |
| 108 | + # needed to guard against a few other cases. |
| 109 | + # We also need to make sure that this expression isn't followed by a pipe |
| 110 | + # symbol, which would indicate that we need to also check the last |
| 111 | + # expression. |
| 112 | + # pipe expressions are like |
| 113 | + # ... |
| 114 | + # <SPECIAL>%>%</SPECIAL> |
| 115 | + # <expr><expr><SYMBOL_FUNCTION_CALL>return</SYMBOL_FUNCTION_CALL> |
| 116 | + # </expr></expr> |
| 117 | + # Unlike the following case, the return should be the last expression in |
| 118 | + # the sequence. |
| 119 | + # conditional expressions are like |
| 120 | + # <expr><IF> ( <expr> ) <expr> [ <ELSE> <expr>] </expr> |
| 121 | + # we require _any_ call to return() in either of the latter two <expr>, i.e., |
| 122 | + # we don't apply recursive logic to check every branch, only that the |
| 123 | + # two top level branches have at least two return()s |
| 124 | + # because of special 'in' syntax for 'for' loops, the condition is |
| 125 | + # tagged differently than for 'if'/'while' conditions (simple PAREN) |
| 126 | + xpath <- glue(" |
| 127 | + (//FUNCTION | //OP-LAMBDA)[parent::expr[not( |
| 128 | + preceding-sibling::expr[SYMBOL[{ xp_text_in_table(except) }]] |
| 129 | + )]] |
| 130 | + /following-sibling::expr[OP-LEFT-BRACE and expr[last()]/@line1 != @line1] |
| 131 | + /expr[last()] |
| 132 | + /*[ |
| 133 | + ( |
| 134 | + position() = 1 |
| 135 | + and ( |
| 136 | + ( |
| 137 | + { xp_or(paste0('self::', setdiff(control_calls, 'IF'))) } |
| 138 | + ) or ( |
| 139 | + not({ xp_or(paste0('self::', control_calls)) }) |
| 140 | + and not( |
| 141 | + following-sibling::PIPE |
| 142 | + or following-sibling::SPECIAL[text() = '%>%'] |
| 143 | + ) |
| 144 | + and not(self::expr/SYMBOL_FUNCTION_CALL[ |
| 145 | + { xp_text_in_table(return_functions) } |
| 146 | + ]) |
| 147 | + ) |
| 148 | + ) |
| 149 | + ) or ( |
| 150 | + preceding-sibling::IF |
| 151 | + and self::expr |
| 152 | + and position() > 4 |
| 153 | + and not(.//SYMBOL_FUNCTION_CALL[{ xp_text_in_table(return_functions) }]) |
| 154 | + ) |
| 155 | + ] |
| 156 | + ") |
| 157 | + msg <- "All functions must have an explicit return()." |
| 158 | + } |
| 159 | + |
| 160 | + Linter(function(source_expression) { |
| 161 | + if (!is_lint_level(source_expression, "expression")) { |
| 162 | + return(list()) |
| 163 | + } |
| 164 | + |
| 165 | + xml <- source_expression$xml_parsed_content |
| 166 | + |
| 167 | + xml_nodes <- xml_find_all(xml, xpath) |
| 168 | + |
| 169 | + xml_nodes_to_lints( |
| 170 | + xml_nodes, |
| 171 | + source_expression = source_expression, |
| 172 | + lint_message = msg, |
| 173 | + type = "style" |
| 174 | + ) |
| 175 | + }) |
| 176 | +} |
0 commit comments