diff --git a/NEWS.md b/NEWS.md index 5405ca284..d87df3414 100644 --- a/NEWS.md +++ b/NEWS.md @@ -1,4 +1,5 @@ # lintr 1.0.0.9001 # +* Fix line number sometimes wrongly reported by no_tab_linter() (#134, @fangly) * Fix line and column number sometimes wrongly reported by spaces_inside_linter() (#203, @fangly) * Add `pipe_continuation_linter()` (#216). @@ -42,7 +43,8 @@ * Fixed lint_package bug where cache was not caching (#146, @schloerke) * Fixed cache not saved in a directory other than requested (#213, @fangly) * Commas linter handles missing arguments calls properly (#145) -* Add `function_left_parentheses_linter` to check that there is no space between a function name and its left parentheses (#204, @jrnold). +* Add `function_left_parentheses_linter` to check that there is no space between + a function name and its left parentheses (#204, @jrnold). # lintr 1.0.0 # * bugfix to work with testthat 1.0.0 diff --git a/R/no_tab_linter.R b/R/no_tab_linter.R index 93891899a..bd2a2a183 100644 --- a/R/no_tab_linter.R +++ b/R/no_tab_linter.R @@ -1,41 +1,41 @@ -#' @describeIn linters check that only spaces are used, never tabs. +#' @describeIn linters check that only spaces are used for indentation, not tabs. #' @export no_tab_linter <- function(source_file) { - all_res <- re_matches( + all_matches <- re_matches( source_file$lines, rex(start, zero_or_more(regex("\\s")), one_or_more("\t")), locations = TRUE, global = TRUE ) - names(all_res) <- as.character(seq_along(all_res)) - - # filter out lines with no matches - all_res <- all_res[ - vapply(all_res, function(line_match) {!is.na(line_match[["start"]][[1L]])}, logical(1L)) - ] + line_numbers <- as.integer(names(source_file$lines)) Map( - function(line_res, line_num) { + function(line_matches, line_number) { lapply( - split(line_res, seq_len(nrow(line_res))), - function(res) { + split(line_matches, seq_len(nrow(line_matches))), + function(match) { + start <- match[["start"]] + if (is.na(start)) { + return() + } + end <- match[["end"]] Lint( filename = source_file$filename, - line_number = line_num, - column_number = res[["start"]], + line_number = line_number, + column_number = start, type = "style", message = "Use spaces to indent, not tabs.", - line = source_file$lines[line_num], + line = source_file$lines[[as.character(line_number)]], # R outputs tabs with 8 spaces # TODO: this is incorrect for embedded tabs, I am not going to fix it. - ranges = list(c(res[["start"]], res[["end"]])), + ranges = list(c(start, end)), linter = "no_tab_linter" ) } ) }, - all_res, - names(all_res) + all_matches, + line_numbers ) } diff --git a/man/linters.Rd b/man/linters.Rd index e4c522bab..540f22d27 100644 --- a/man/linters.Rd +++ b/man/linters.Rd @@ -170,7 +170,7 @@ do not have spaces before them. \item \code{line_length_linter}: check the line length of both comments and code is less than length. -\item \code{no_tab_linter}: check that only spaces are used, never tabs. +\item \code{no_tab_linter}: check that only spaces are used for indentation, not tabs. \item \code{object_usage_linter}: checks that closures have the proper usage using \code{\link[codetools]{checkUsage}}. Note this runs diff --git a/tests/testthat/test-no_tab_linter.R b/tests/testthat/test-no_tab_linter.R index b146ca33d..76f66aad3 100644 --- a/tests/testthat/test-no_tab_linter.R +++ b/tests/testthat/test-no_tab_linter.R @@ -10,7 +10,9 @@ test_that("returns the correct linting", { expect_lint("#\tblah", NULL, no_tab_linter) - expect_lint("\tblah", msg, no_tab_linter) + expect_lint("\tblah", c(message = msg, line_number = 1L), no_tab_linter) - expect_lint("\t\tblah", msg, no_tab_linter) + expect_lint("\n\t\tblah", c(message = msg, line_number = 2L), no_tab_linter) + + # Note: no tests of column number since they are currently incorrect (tabs converted to 8 spaces) })