diff --git a/NEWS.md b/NEWS.md index 3a7e5f886..61b78c756 100644 --- a/NEWS.md +++ b/NEWS.md @@ -23,8 +23,8 @@ * `assignment_linter()` no longer lints assignments in braces that include comments when `allow_trailing = FALSE` (#1701, @ashbaldry) * `object_usage_linter()` - + No longer silently ignores usage warnings that don't contain a quoted name (#1714, @AshesITR) - + No longer fails on code with comments inside a multi-line call to `glue::glue()` (#1919, @MichaelChirico) + + No longer silently ignores usage warnings that don't contain a quoted name (#1714, @AshesITR) + + No longer fails on code with comments inside a multi-line call to `glue::glue()` (#1919, @MichaelChirico) * `namespace_linter()` correctly recognizes backticked operators to be exported from respective namespaces (like `` rlang::`%||%` ``) (#1752, @IndrajeetPatil) @@ -41,7 +41,9 @@ * `object_name_linter()` allows all S3 group Generics (see `?base::groupGeneric`) and S3 generics defined in a different file in the same package (#1808, #1841, @AshesITR) -* `object_usage_linter()` improves identification of the exact source of a lint for undefined variables in expressions with where the variable is used as a symbol in a usual way, for example in a formula or in an extraction with `$` (#1914, @MichaelChirico). +* `object_usage_linter()` improves identification of the exact source of a lint + + for undefined variables in expressions with where the variable is used as a symbol in a usual way, for example in a formula or in an extraction with `$` (#1914, @MichaelChirico). + + for general usage warnings without location info (#1986 and #1917, @AshesITR) * `function_left_parentheses_linter()` produces a more specific lint (and no longer fails) when the opening parenthesis is on a different line than `function` or the call name (#1953, @MichaelChirico). Thanks also to @IndrajeetPatil and @lorenzwalthert for identifying a regression in the initial fix, #1963. diff --git a/R/object_usage_linter.R b/R/object_usage_linter.R index c8ae413f0..856b5e77a 100644 --- a/R/object_usage_linter.R +++ b/R/object_usage_linter.R @@ -99,6 +99,7 @@ object_usage_linter <- function(interpret_glue = TRUE, skip_with = TRUE) { known_used_symbols = known_used_symbols, declared_globals = declared_globals, start_line = as.integer(xml2::xml_attr(fun_assignment, "line1")), + end_line = as.integer(xml2::xml_attr(fun_assignment, "line2")), skip_with = skip_with ) @@ -245,6 +246,7 @@ parse_check_usage <- function(expression, known_used_symbols = character(), declared_globals = character(), start_line = 1L, + end_line = 1L, skip_with = TRUE) { vals <- list() @@ -282,10 +284,10 @@ parse_check_usage <- function(expression, "'", capture(name = "name", anything), "'", - anything + zero_or_more(any, type = "lazy") ) ), - line_info + or(line_info, end) ) ) @@ -301,13 +303,20 @@ parse_check_usage <- function(expression, # nocov end res <- res[!missing, ] - res$line1 <- as.integer(res$line1) + start_line - 1L + res$line1 <- ifelse( + nzchar(res$line1), + as.integer(res$line1) + start_line - 1L, + NA_integer_ + ) res$line2 <- ifelse( nzchar(res$line2), as.integer(res$line2) + start_line - 1L, res$line1 ) + res$line1[is.na(res$line1)] <- start_line + res$line2[is.na(res$line2)] <- end_line + res } diff --git a/R/quotes_linter.R b/R/quotes_linter.R index 3820fc881..1392a33f9 100644 --- a/R/quotes_linter.R +++ b/R/quotes_linter.R @@ -47,7 +47,7 @@ quotes_linter <- function(delimiter = c('"', "'")) { single_quote, end ) - lint_message <- "Only use double-quotes." # nolint: object_usage_linter. An apparent codetools bug. + lint_message <- "Only use double-quotes." # nolint: object_usage. An apparent codetools bug. } else { quote_regex <- rex( start, @@ -73,8 +73,8 @@ quotes_linter <- function(delimiter = c('"', "'")) { quote_matches, function(id) { with(content[str_idx[id], ], { - line <- source_expression$file_lines[[line1]] - col2 <- if (line1 == line2) col2 else nchar(line) + line <- source_expression$file_lines[[line1]] # nolint: object_usage. Codetools bug + col2 <- if (line1 == line2) col2 else nchar(line) # nolint: object_usage. Codetools bug Lint( filename = source_expression$filename, line_number = line1, diff --git a/tests/testthat/test-object_usage_linter.R b/tests/testthat/test-object_usage_linter.R index 77b9efe9d..bb29ecf96 100644 --- a/tests/testthat/test-object_usage_linter.R +++ b/tests/testthat/test-object_usage_linter.R @@ -765,3 +765,75 @@ test_that("functional lambda definitions are also caught", { object_usage_linter() ) }) + +test_that("messages without location info are repaired", { + # regression test for #1986 + expect_lint( + trim_some(" + foo <- function() no_fun() + "), + list( + message = rex::rex("no visible global function definition for", anything), + line_number = 1L, + column_number = 19L + ), + object_usage_linter() + ) + + expect_lint( + trim_some(" + foo <- function(a = no_fun()) a + "), + list( + message = rex::rex("no visible global function definition for", anything), + line_number = 1L, + column_number = 21L + ), + object_usage_linter() + ) + + expect_lint( + trim_some(" + foo <- function() no_global + "), + list( + message = rex::rex("no visible binding for global variable", anything), + line_number = 1L, + column_number = 19L + ), + object_usage_linter() + ) + + expect_lint( + trim_some(" + foo <- function() unused_local <- 42L + "), + list( + message = rex::rex("local variable", anything, "assigned but may not be used"), + line_number = 1L, + column_number = 19L + ), + object_usage_linter() + ) + + # More complex case with two lints and missing location info + expect_lint( + trim_some(" + foo <- function() a <- + bar() + "), + list( + list( + message = rex::rex("local variable", anything, "assigned but may not be used"), + line_number = 1L, + column_number = 19L + ), + list( + message = rex::rex("no visible global function definition for", anything), + line_number = 2L, + column_number = 3L + ) + ), + object_usage_linter() + ) +})