Fix false positive in if_switch_linter() for empty strings

NEWS.md

@@ -10,7 +10,6 @@
 
 * Excluding `cyclocomp_linter()` in `available_linters()` or `linters_with_tags()`, which requires the weak dependency {cyclocomp}, no longer emits a warning (#2909, @MichaelChirico).
 * `repeat_linter()` no longer errors when `while` is in a column to the right of `}` (#2828, @MichaelChirico).
-* `undesirable_operator_linter(call_is_undesirable = FALSE)` now correctly skips prefix notation like `` `:::`(pkg, fun) `` (#2999, @emmanuel-ferdman).
 
 ## New and improved features
 
@@ -52,6 +51,8 @@
 
 ### Lint accuracy fixes: removing false positives
 
+* `if_switch_linter()` no longer produces a false positive when comparing to empty strings (`""`, `''`, or raw strings like `R"()"`), which cannot be used as `switch()` case names (#2835, @emmanuel-ferdman).
+* `undesirable_operator_linter(call_is_undesirable = FALSE)` now correctly skips prefix notation like `` `:::`(pkg, fun) `` (#2999, @emmanuel-ferdman).
 * `unnecessary_nesting_linter()` treats `=` assignment the same as `<-` for several pieces of logic (#2245 and #2829, @MichaelChirico).
 * `vector_logic_linter()` ignores scalar operators (`&&`/`||`) inside anonymous functions within `filter()`/`subset()` (#2935, @emmanuel-ferdman).
 

R/if_switch_linter.R

@@ -159,7 +159,7 @@
 #' @seealso [linters] for a complete list of linters available in lintr.
 #' @export
 if_switch_linter <- function(max_branch_lines = 0L, max_branch_expressions = 0L) {
-  equal_str_cond <- "expr[1][EQ and expr/STR_CONST]"
+  equal_str_cond <- "expr[1][EQ and expr/STR_CONST[string-length(text()) > 2]]"
 
   if (max_branch_lines > 0L || max_branch_expressions > 0L) {
     complexity_cond <- xp_or(c(
@@ -188,9 +188,6 @@ if_switch_linter <- function(max_branch_lines = 0L, max_branch_expressions = 0L)
     switch_xpath <- NULL
   }
 
-  # NB: IF AND {...} AND ELSE/... implies >= 3 equality conditions are present
-  # .//expr/IF/...: the expr in `==` that's _not_ the STR_CONST
-  # not(preceding::IF): prevent nested matches which might be incorrect globally
   if_xpath <- glue("
   //IF
     /parent::expr[
@@ -205,23 +202,24 @@ if_switch_linter <- function(max_branch_lines = 0L, max_branch_expressions = 0L)
     ]
   ")
 
-  # not(. != .): don't match if there are _any_ expr which _don't_ match the top expr
-  equality_test_cond <- glue("self::*[
-    .//expr/IF/following-sibling::{equal_str_cond}/expr[not(STR_CONST)]
-      != expr[1][EQ]/expr[not(STR_CONST)]
-  ]")
-
   Linter(linter_level = "expression", function(source_expression) {
     xml <- source_expression$xml_parsed_content
 
     bad_expr <- xml_find_all(xml, if_xpath)
-    expr_all_equal <- is.na(xml_find_first(
-      strip_comments_from_subtree(bad_expr),
-      equality_test_cond
-    ))
+
+    bad_expr_clean <- strip_comments_from_subtree(bad_expr)
+    expr_all_equal <- vapply(bad_expr_clean, if_else_chain_expr_is_unique, logical(1L))
+    bad_expr <- bad_expr[expr_all_equal]
+
+    # Exclude empty strings, which can't be used as switch() case names
+    nonempty <- vapply(bad_expr, function(expr) {
+      str_nodes <- if_else_chain_strings(expr)
+      all(vapply(str_nodes, function(n) nzchar(get_r_string(n)), logical(1L)))
+    }, logical(1L))
+    bad_expr <- bad_expr[nonempty]
 
     lints <- xml_nodes_to_lints(
-      bad_expr[expr_all_equal],
+      bad_expr,
       source_expression = source_expression,
       lint_message = paste(
         "Prefer switch() statements over repeated if/else equality tests,",
@@ -246,3 +244,35 @@ if_switch_linter <- function(max_branch_lines = 0L, max_branch_expressions = 0L)
     lints
   })
 }
+
+# Extract STR_CONST nodes from equality conditions in an if/else if chain
+if_else_chain_strings <- function(expr) {
+  str_nodes <- list()
+  first <- xml_find_first(expr, "IF/following-sibling::expr[1][EQ]/expr/STR_CONST")
+  if (!is.na(first)) str_nodes <- c(str_nodes, list(first))
+  current <- expr
+  repeat {
+    else_if <- xml_find_first(current, "ELSE/following-sibling::expr[IF]")
+    if (is.na(else_if)) break
+    current <- else_if
+    str_node <- xml_find_first(current, "IF/following-sibling::expr[1][EQ]/expr/STR_CONST")
+    if (!is.na(str_node)) str_nodes <- c(str_nodes, list(str_node))
+  }
+  str_nodes
+}
+
+# Check that equality conditions in an if/else if chain use the same expression
+if_else_chain_expr_is_unique <- function(expr) {
+  expr_nodes <- character()
+  first <- xml_find_first(expr, "IF/following-sibling::expr[1][EQ]/expr[not(STR_CONST)]")
+  if (!is.na(first)) expr_nodes <- c(expr_nodes, xml_text(first))
+  current <- expr
+  repeat {
+    else_if <- xml_find_first(current, "ELSE/following-sibling::expr[IF]")
+    if (is.na(else_if)) break
+    current <- else_if
+    expr_node <- xml_find_first(current, "IF/following-sibling::expr[1][EQ]/expr[not(STR_CONST)]")
+    if (!is.na(expr_node)) expr_nodes <- c(expr_nodes, xml_text(expr_node))
+  }
+  length(unique(expr_nodes)) == 1L
+}

tests/testthat/test-if_switch_linter.R

@@ -17,8 +17,27 @@ test_that("if_switch_linter skips allowed usages", {
   # simple cases with two conditions might be more natural
   #   without switch(); require at least three branches to trigger a lint
   expect_no_lint("if (x == 'a') 1 else if (x == 'b') 2", linter)
+  # not thrown by raw strings
+  expect_no_lint("if (x == 'a') 1 else if (x == R'(b)') 2", linter)
   # still no third if() clause
   expect_no_lint("if (x == 'a') 1 else if (x == 'b') 2 else 3", linter)
+  # not thrown by raw strings
+  expect_no_lint("if (x == 'a') 1 else if (x == R'(b)') 2 else 3", linter)
+
+  # empty string comparisons can't use switch()
+  expect_no_lint("if (x == '') 1 else if (x == 'a') 2 else if (x == 'b') 3", linter)
+  expect_no_lint('if (x == "") 1 else if (x == "a") 2 else if (x == "b") 3', linter)
+  expect_no_lint("if (x == 'a') 1 else if (x == '') 2 else if (x == 'b') 3", linter)
+  expect_no_lint("if (x == 'a') 1 else if (x == 'b') 2 else if (x == '') 3", linter)
+  expect_no_lint("if (x == 'a') 1 else if (x == 'b') 2 else if (x == 'c') 3 else if (x == '') 4", linter)
+})
+
+test_that("if_switch_linter handles raw empty strings", {
+  linter <- if_switch_linter()
+
+  # raw empty strings can't use switch() either
+  expect_no_lint('if (x == R"--()--") 1 else if (x == "a") 2 else if (x == "b") 3', linter)
+  expect_no_lint('if (x == R"()") 1 else if (x == R"{}") 2 else if (x == R"[]") 3', linter)
 })
 
 test_that("if_switch_linter blocks simple disallowed usages", {
@@ -27,6 +46,8 @@ test_that("if_switch_linter blocks simple disallowed usages", {
 
   # anything with >= 2 equality statements is deemed switch()-worthy
   expect_lint("if (x == 'a') 1 else if (x == 'b') 2 else if (x == 'c') 3", lint_msg, linter)
+  # regardless of raw strings
+  expect_lint("if (x == 'a') 1 else if (x == r'(b)') 2 else if (x == R'--[c]--') 3", lint_msg, linter)
   # expressions are also OK
   expect_lint("if (foo(x) == 'a') 1 else if (foo(x) == 'b') 2 else if (foo(x) == 'c') 3", lint_msg, linter)
   # including when comments are present
@@ -77,6 +98,20 @@ test_that("multiple lints have right metadata", {
       } else if (y == 'C') {
         do_C()
       }
+      if (z1 == 'a') {
+        do_a()
+      } else if (z2 == 'b') {
+        do_b()
+      } else if (z3 == 'c') {
+        do_c()
+      }
+      if (a == '1') {
+        do_1()
+      } else if (a == '2') {
+        do_2()
+      } else if (a == '') {
+        do_blank()
+      }
     }"),
     list(
       list(lint_msg, line_number = 2L),