refactor: use toString, expect_named, lengths, expect_null, fixed in grepl

.lintr

@@ -1,10 +1,9 @@
-linters: with_defaults(
-    # lintr defaults: https://github.com/jimhester/lintr#available-linters
+linters: linters_with_defaults(
+    # lintr defaults: https://lintr.r-lib.org/reference/default_linters.html
     # the following setup changes/removes certain linters
     assignment_linter = NULL, # do not force using <- for assignments
     object_name_linter = object_name_linter(c("snake_case", "CamelCase")), # only allow snake case and camel case object names
     cyclocomp_linter = NULL, # do not check function complexity
     commented_code_linter = NULL, # allow code in comments
     line_length_linter = line_length_linter(120)
     )
-

R/Callback.R

@@ -224,6 +224,8 @@ clbks = function(.keys) {
 #' Assertions for [Callback] class.
 #'
 #' @param callback ([Callback]).
+#' @param null_ok (`logical(1)`)\cr
+#'   If `TRUE`, `NULL` is allowed.
 #'
 #' @return [Callback] | List of [Callback]s.
 #' @export

R/as_short_string.R

@@ -32,11 +32,11 @@ as_short_string = function(x, width = 30L, num_format = "%.4g") {
       string = sprintf("%s(0)", cl)
     } else {
       string = switch(cl,
-        "numeric" = paste0(sprintf(num_format, x), collapse = ","),
-        "integer" = paste0(as.character(x), collapse = ","),
-        "logical" = paste0(as.character(x), collapse = ","),
-        "character" = paste0(x, collapse = ","),
-        "expression" = as.character(x),
+        numeric = paste0(sprintf(num_format, x), collapse = ","),
+        integer = paste0(as.character(x), collapse = ","),
+        logical = paste0(as.character(x), collapse = ","),
+        character = paste0(x, collapse = ","),
+        expression = as.character(x),
         sprintf("<%s>", cl)
       )
     }
@@ -52,7 +52,7 @@ as_short_string = function(x, width = 30L, num_format = "%.4g") {
     }
     ns = names2(x, missing_val = "<unnamed>")
     ss = lapply(x, convert)
-    paste0(paste0(ns, "=", ss), collapse = ", ")
+    toString(paste0(ns, "=", ss))
   } else {
     convert(x)
   }

R/format_bib.R

@@ -49,7 +49,7 @@ cite_bib = function(..., bibentries = NULL, envir = parent.frame()) {
   })
 
   if (length(str) >= 3L) {
-    str = c(paste0(head(str, -1L), collapse = ", "), tail(str, 1L))
+    str = c(toString(head(str, -1L)), tail(str, 1L))
   }
 
   paste0(str, collapse = " and ")

R/topo_sort.R

@@ -33,7 +33,7 @@ topo_sort = function(nodes) {
   nodes = copy(nodes) # copy ref to be sure
   n = nrow(nodes)
   # sort nodes with few parent to start
-  o = order(map_int(nodes$parents, length), decreasing = FALSE)
+  o = order(lengths(nodes$parents), decreasing = FALSE)
   nodes = nodes[o]
 
   nodes$topo = nodes$depth = NA_integer_ # cols for topo-index and depth layer in sort

tests/testthat/test_encapsulate.R

@@ -47,12 +47,12 @@ test_that("timeout", {
   res = encapsulate("evaluate", .f = f, .args = list(x = 1), .timeout = 1)
   expect_null(res$result)
   expect_true("error" %in% res$log$class)
-  expect_true(any(grepl("time limit", res$log$msg)))
+  expect_match(res$log$msg, "time limit", fixed = TRUE)
 
   res = encapsulate("callr", .f = f, .args = list(x = 1), .timeout = 1)
   expect_null(res$result)
   expect_true("error" %in% res$log$class)
-  expect_true(any(grepl("time limit", res$log$msg)))
+  expect_match(res$log$msg, "time limit", fixed = TRUE)
 })
 
 

tests/testthat/test_insert.R

@@ -8,7 +8,7 @@ test_that("insert_named.list", {
   x = remove_named(x, c("d", "e"))
   expect_list(x, len = 3L)
   expect_set_equal(names(x), letters[1:3])
-  expect_equal(x$d, NULL)
+  expect_null(x$d)
 
   x = insert_named(list(), list(a = 1))
   expect_list(x, len = 1L)
@@ -32,7 +32,7 @@ test_that("insert_named.environment", {
 
   x = remove_named(x, c("d", "e"))
   expect_environment(x, contains = letters[1:3])
-  expect_equal(x$d, NULL)
+  expect_null(x$d)
 
   x = insert_named(new.env(), list(a = 1))
   expect_environment(x, contains = "a")
@@ -42,33 +42,33 @@ test_that("insert_named.environment", {
 test_that("insert_named.data.frame", {
   x = as.data.frame(named_list(letters[1:3], 1))
   x = insert_named(x, list(d = 1))
-  expect_data_frame(x, nrows = 1, ncols = 4)
+  expect_data_frame(x, nrows = 1L, ncols = 4L)
   expect_set_equal(names(x), letters[1:4])
   expect_equal(x$d, 1)
 
   x = remove_named(x, c("d", "e"))
-  expect_data_frame(x, nrows = 1, ncols = 3)
+  expect_data_frame(x, nrows = 1L, ncols = 3L)
   expect_set_equal(names(x), letters[1:3])
-  expect_equal(x$d, NULL)
+  expect_null(x$d)
 
   x = insert_named(data.frame(), list(a = 1))
-  expect_data_frame(x, nrows = 1, ncols = 1)
+  expect_data_frame(x, nrows = 1L, ncols = 1L)
   expect_equal(x$a, 1)
 })
 
 test_that("insert_named.data.table", {
   x = as.data.table(named_list(letters[1:3], 1))
   x = insert_named(x, list(d = 1))
-  expect_data_table(x, nrows = 1, ncols = 4)
+  expect_data_table(x, nrows = 1L, ncols = 4L)
   expect_set_equal(names(x), letters[1:4])
   expect_equal(x$d, 1)
 
   x = remove_named(x, c("d", "e"))
-  expect_data_table(x, nrows = 1, ncols = 3)
+  expect_data_table(x, nrows = 1L, ncols = 3L)
   expect_set_equal(names(x), letters[1:3])
-  expect_equal(x$d, NULL)
+  expect_null(x$d)
 
   x = insert_named(data.table(), list(a = 1))
-  expect_data_table(x, nrows = 1, ncols = 1)
+  expect_data_table(x, nrows = 1L, ncols = 1L)
   expect_equal(x$a, 1)
 })

tests/testthat/test_map.R

@@ -42,7 +42,7 @@ test_that("imap", {
 
   res = imap_chr(x, fun)
   expect_character(res, len = 2)
-  expect_equal(names(res), c("a", "b"))
+  expect_named(res, c("a", "b"))
   expect_equal(unname(res), c("a:1", "b:2"))
 
   x = list(1L, 2L)
@@ -153,7 +153,7 @@ test_that("keep", {
   x = list(a = 1:3, b = c("a", "b"), c = runif(3))
   out = keep(x, is.numeric)
   expect_list(out, len = 2L)
-  expect_equal(names(out), c("a", "c"))
+  expect_named(out, c("a", "c"))
 
   x = iris
   out = keep(x, is.numeric)
@@ -168,7 +168,7 @@ test_that("discard", {
   x = list(a = 1:3, b = c("a", "b"), c = runif(3))
   out = discard(x, is.numeric)
   expect_list(out, len = 1L)
-  expect_equal(names(out), "b")
+  expect_named(out, "b")
 
   x = iris
   out = discard(x, is.numeric)

tests/testthat/test_names2.R

@@ -7,5 +7,5 @@ test_that("names2", {
   expect_identical(names2(x, ""), c("a", rep.int("", 2)))
 
   names(x) = letters[1:3]
-  expect_identical(names(x), names2(x))
+  expect_named(x, names2(x))
 })

tests/testthat/test_set_params.R

@@ -11,7 +11,7 @@ test_that("set_params works for ... with correct inputs", {
   .ps = paradox::ps(a = paradox::p_dbl(), b = paradox::p_dbl())
   .ps$values$a = 1
   set_params(.ps, b = 2, .insert = FALSE)
-  expect_true(is.null(.ps$values$a))
+  expect_null(.ps$values$a)
   expect_true(.ps$values$b == 2)
   .ps$values = list(a = 1)
   set_params(.ps, b = 2, .insert = TRUE)
@@ -23,7 +23,7 @@ test_that("set_params works for .values with correct inputs", {
   .ps = paradox::ps(a = paradox::p_dbl(), b = paradox::p_dbl())
   .ps$values$a = 1
   set_params(.ps, .values = list(b = 2), .insert = FALSE)
-  expect_true(is.null(.ps$values$a))
+  expect_null(.ps$values$a)
   expect_true(.ps$values$b == 2)
   .ps$values = list(a = 1)
   set_params(.ps, .values = list(b = 2), .insert = TRUE)
@@ -41,7 +41,7 @@ test_that("set_params works for .values and ... with correct inputs", {
 
   .ps$values = list(a = 1)
   set_params(.ps, b = 2, .values = list(c = 3), .insert = FALSE)
-  expect_true(is.null(.ps$values$a))
+  expect_null(.ps$values$a)
   expect_true(.ps$values$b == 2)
   expect_true(.ps$values$c == 3)
 })

tests/testthat/test_strip_srcrefs.R

@@ -2,5 +2,5 @@ test_that("remove srcref from function", {
   f = function(x) NULL
   attr(f, "srcref") = "mock_srcrefs"
   f_strip = strip_srcrefs(f)
-  expect_true(is.null(attr(f_strip, "srcref")))
+  expect_null(attr(f_strip, "srcref"))
 })