#' Block comparison of class with `==`
#'
#' Usage like `class(x) == "character"` is prone to error since class in R
#' is in general a vector. The correct version for S3 classes is [inherits()]:
#' `inherits(x, "character")`. Often, class `k` will have an `is.` equivalent,
#' for example [is.character()] or [is.data.frame()].
#'
#' Similar reasoning applies for `class(x) %in% "character"`.
#'
#' @examples
#' # will produce lints
#' lint(
#' text = 'is_lm <- class(x) == "lm"',
#' linters = class_equals_linter()
#' )
#'
#' lint(
#' text = 'if ("lm" %in% class(x)) is_lm <- TRUE',
#' linters = class_equals_linter()
#' )
#'
#' # okay
#' lint(
#' text = 'is_lm <- inherits(x, "lm")',
#' linters = class_equals_linter()
#' )
#'
#' lint(
#' text = 'if (inherits(x, "lm")) is_lm <- TRUE',
#' linters = class_equals_linter()
#' )
#'
#' @evalRd rd_tags("class_equals_linter")
#' @seealso [linters] for a complete list of linters available in lintr.
#' @export
class_equals_linter <- function() {
xpath <- "
parent::expr
/parent::expr
/parent::expr[
not(preceding-sibling::OP-LEFT-BRACKET)
and (EQ or NE or SPECIAL[text() = '%in%'])
]
"
Linter(linter_level = "expression", function(source_expression) {
xml_calls <- source_expression$xml_find_function_calls("class")
bad_expr <- xml_find_all(xml_calls, xpath)
operator <- xml_find_chr(bad_expr, "string(*[2])")
lint_message <- sprintf(
"Use inherits(x, 'class-name'), is.<class> or is(x, 'class') instead of comparing class(x) with %s.",
operator
)
xml_nodes_to_lints(
bad_expr,
source_expression = source_expression,
lint_message = lint_message,
type = "warning"
)
})
}
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.