Misc cleanups

.lintr

@@ -1,2 +1,2 @@
-linters: with_defaults(line_length_linter(120))
+linters: linters_with_defaults(line_length_linter(120))
 exclusions: list("inst/doc/how_it_works.R")

DESCRIPTION

@@ -72,7 +72,7 @@ Suggests:
     box (>= 1.2.0)
 License: MIT + file LICENSE
 VignetteBuilder: knitr
-RoxygenNote: 7.2.3
+RoxygenNote: 7.3.2
 Roxygen: list(markdown = TRUE)
 Config/testthat/edition: 3
 Config/testthat/parallel: TRUE

NAMESPACE

@@ -2,6 +2,9 @@
 
 S3method("[",coverage)
 S3method(as.data.frame,coverage)
+S3method(markers,coverage)
+S3method(markers,coverages)
+S3method(markers,data.frame)
 S3method(merge_coverage,character)
 S3method(merge_coverage,list)
 S3method(print,coverage)

R/cobertura.R

@@ -14,7 +14,7 @@
 #' @param cov the coverage object returned from [package_coverage()]
 #' @param filename the name of the Cobertura XML file
 #' @export
-to_cobertura <- function(cov, filename = "cobertura.xml"){
+to_cobertura <- function(cov, filename = "cobertura.xml") {
 
   loadNamespace("xml2")
 
@@ -24,7 +24,7 @@ to_cobertura <- function(cov, filename = "cobertura.xml"){
   percent_per_function <- tapply(df$value, df$functions, FUN = function(x) (sum(x > 0) / length(x)))
   lines_valid <- nrow(df)
   lines_covered <- sum(df$value > 0)
-                                 
+
   d <- xml2::xml_new_document()
 
   xml2::xml_add_child(d, xml2::xml_dtd(
@@ -34,7 +34,7 @@ to_cobertura <- function(cov, filename = "cobertura.xml"){
   top <- xml2::xml_add_child(d,
     "coverage",
     "line-rate" = as.character(percent_overall),
-    "branch-rate" = "0", 
+    "branch-rate" = "0",
     `lines-covered` = as.character(lines_covered),
     `lines-valid` = as.character(lines_valid),
     `branches-covered` = "0",

R/codecov.R

@@ -178,7 +178,7 @@ codecov <- function(...,
     codecov_query <- list(service = "github-actions",
                           branch = branch,
                           build = github_run_id,
-                          build_url = utils::URLencode(sprintf("http://github.com/%s/actions/runs/%s", slug, github_run_id)),
+                          build_url = utils::URLencode(sprintf("https://github.com/%s/actions/runs/%s", slug, github_run_id)),
                           pr = pr,
                           slug = slug,
                           commit = commit %||% Sys.getenv("GITHUB_SHA"))

R/compiled.R

@@ -91,7 +91,7 @@ run_gcov <- function(path, quiet = TRUE, clean = TRUE,
   res <- withr::with_dir(src_path, {
            compact(unlist(lapply(gcov_inputs, run_gcov_one), recursive = FALSE))
          })
-  if (!length(res) & length(gcov_inputs))
+  if (!length(res) && length(gcov_inputs))
     warning('parsed gcov output was empty')
   res
 }

R/covr.R

@@ -366,7 +366,7 @@ package_coverage <- function(path = ".",
                              code = character(),
                              install_path = temp_file("R_LIBS"),
                              ...,
-                             exclusions, pre_clean=TRUE) {
+                             exclusions, pre_clean = TRUE) {
 
   if (!missing(exclusions)) {
     warning(
@@ -420,8 +420,7 @@ package_coverage <- function(path = ".",
   # check for compiler
   if (!uses_icc()) {
     flags <- getOption("covr.flags")
-  }
-  else {
+  } else {
     if (length(getOption("covr.icov")) > 0L) {
       flags <- getOption("covr.icov_flags")
       # clean up old icov files
@@ -706,7 +705,7 @@ merge_coverage_tests <- function(from, into = NULL) {
   # modify trace test tallies
   for (name in intersect(names(into), names(from))) {
     if (name == "tests") next
-    from[[name]]$tests$tally[,1L] <- test_idx[from[[name]]$tests$tally[,1L]]
+    from[[name]]$tests$tally[, 1L] <- test_idx[from[[name]]$tests$tally[, 1L]]
     into[[name]]$tests$tally <- rbind(into[[name]]$tests$tally, from[[name]]$tests$tally)
   }
 

R/icc.R

@@ -54,7 +54,7 @@ parse_icov <- function(lines, package_path = "") {
                     by = list(line=m1$line, functions=m1$functions), sum)
     names(m2) <- c("line", "functions", "coverage")
   }
-  matches <- m2[order(m2$line),]
+  matches <- m2[order(m2$line), ]
 
   values <- as.numeric(matches$coverage > 0L)
   functions <- matches$functions

R/summary_functions.R

@@ -199,6 +199,7 @@ format_percentage <- function(x) {
 
 markers <- function(x, ...) UseMethod("markers")
 
+#' @export
 markers.coverages <- function(x, ...) {
   mrks <- unlist(lapply(unname(x), markers), recursive = FALSE)
 
@@ -216,6 +217,7 @@ markers.coverages <- function(x, ...) {
                       autoSelect = "first")
   invisible()
 }
+#' @export
 markers.coverage <- function(x, ...) {
 
   # generate the markers
@@ -233,6 +235,7 @@ markers.coverage <- function(x, ...) {
 
 }
 
+#' @export
 markers.data.frame <- function(x, ..., type = "test") { # nolint
   # generate the markers
   markers <- Map(function(filename, line, column) {

R/trace_calls.R

@@ -31,17 +31,15 @@ trace_calls <- function (x, parent_functions = NULL, parent_ref = NULL) {
   if (is.atomic(x) || is.name(x) || is.null(x)) {
     if (is.null(parent_ref)) {
       x
-    }
-    else {
+    } else {
       if (is_na(x) || is_brace(x)) {
         x
       } else {
         key <- new_counter(parent_ref, parent_functions) # nolint
         count(key, x)
       }
     }
-  }
-  else if (is.call(x)) {
+  } else if (is.call(x)) {
     src_ref <- attr(x, "srcref") %||% impute_srcref(x, parent_ref)
     if ((identical(x[[1]], as.name("<-")) || identical(x[[1]], as.name("="))) && # nolint
       (is.call(x[[3]]) && identical(x[[3]][[1]], as.name("function")))) {
@@ -59,8 +57,7 @@ trace_calls <- function (x, parent_functions = NULL, parent_ref = NULL) {
     } else {
       as.call(recurse(x))
     }
-  }
-  else if (is.function(x)) {
+  } else if (is.function(x)) {
 
     # We cannot trace primitive functions
     if (is.primitive(x)) {
@@ -83,17 +80,13 @@ trace_calls <- function (x, parent_functions = NULL, parent_ref = NULL) {
     formals(x) <- new_formals
     body(x) <- fun_body
     x
-  }
-  else if (is.pairlist(x)) {
+  } else if (is.pairlist(x)) {
     as.pairlist(recurse(x))
-  }
-  else if (is.expression(x)) {
+  } else if (is.expression(x)) {
     as.expression(recurse(x))
-  }
-  else if (is.list(x)) {
+  } else if (is.list(x)) {
     recurse(x)
-  }
-  else {
+  } else {
     message("Unknown language class: ", paste(class(x), collapse = "/"))
     x
   }

R/trace_tests.R

@@ -127,7 +127,7 @@ count_test <- function(key) {
   tests$.data[[4L]] <- .current_test$i
 
   tests$.value <- .counters[[key]]$value
-  with(tests, tally[.value,] <- .data)
+  with(tests, tally[.value, ] <- .data)
 }
 
 #' Initialize a new test counter for a coverage trace
@@ -339,9 +339,9 @@ truncate_call <- function(call_obj, limit = 1e4) {
 #'
 is_current_test_finished <- function() {
   is.null(.current_test$src) ||
-  .current_test$last_frame > sys.nframe() ||
-  !identical(.current_test$src_call, sys.call(which = .current_test$last_frame)) ||
-  !identical(.current_test$src_env, sys.frame(which = .current_test$last_frame - 1L))
+    .current_test$last_frame > sys.nframe() ||
+    !identical(.current_test$src_call, sys.call(which = .current_test$last_frame)) ||
+    !identical(.current_test$src_env, sys.frame(which = .current_test$last_frame - 1L))
 }
 
 #' Is the source bound to the expression

README.md

@@ -3,7 +3,7 @@
 <!-- badges: start -->
 [![R-CMD-check](https://github.com/r-lib/covr/actions/workflows/R-CMD-check.yaml/badge.svg)](https://github.com/r-lib/covr/actions/workflows/R-CMD-check.yaml)
 [![Codecov test coverage](https://codecov.io/gh/r-lib/covr/branch/master/graph/badge.svg)](https://app.codecov.io/gh/r-lib/covr?branch=master)
-[![CRAN version](http://www.r-pkg.org/badges/version/covr)](https://cran.r-project.org/package=covr)
+[![CRAN version](https://www.r-pkg.org/badges/version/covr)](https://cran.r-project.org/package=covr)
 <!-- badges: end -->
 
 Track test coverage for your R package and view reports locally or (optionally)

tests/testthat/test-S7.R

@@ -1,5 +1,5 @@
 test_that("S7 coverage is reported", {
-  local_edition(3)
+  skip_if_not_installed("S7")
   cov <- as.data.frame(package_coverage(test_path("TestS7")))
 
   expect_equal(cov$value, c(1, 1, 1, 2, 5, 0, 5, 0, 5, 1, 1, 2, 1, 1, 0))

tests/testthat/test-codecov.R

@@ -48,7 +48,8 @@ ci_vars <- c(
   "WERCKER_GIT_COMMIT" = NA,
   "WERCKER_GIT_OWNER" = NA,
   "WERCKER_GIT_REPOSITORY" = NA,
-  "WERCKER_MAIN_PIPELINE_STARTED" = NA)
+  "WERCKER_MAIN_PIPELINE_STARTED" = NA
+)
 
 cov <- package_coverage(test_path("TestS4"))
 

tests/testthat/test-coveralls.R

@@ -43,11 +43,12 @@ ci_vars <- c(
   "WERCKER_GIT_COMMIT" = NA,
   "WERCKER_GIT_OWNER" = NA,
   "WERCKER_GIT_REPOSITORY" = NA,
-  "WERCKER_MAIN_PIPELINE_STARTED" = NA)
+  "WERCKER_MAIN_PIPELINE_STARTED" = NA
+)
 
 read_file <- function(file) paste(collapse = "\n", readLines(file))
 
-cov <- package_coverage("TestS4")
+cov <- package_coverage(test_path("TestS4"))
 
 test_that("coveralls generates a properly formatted json file", {
   withr::with_envvar(

tests/testthat/test-parallel.R

@@ -13,7 +13,7 @@ test_that("mcparallel with the fix", {
   skip_on_os("windows")
 
   # using auto detection
-  cov <- package_coverage("TestParallel", type = "test")
+  cov <- package_coverage(test_path("TestParallel"), type = "test")
   # only the non parallel code is covered
   expect_equal(percent_coverage(cov), 100)
 })

tests/testthat/test-print.R

@@ -30,9 +30,6 @@ test_that("print.coverage prints by = \"line\" by default", {
 
   expect_message(print(cov),
     rex::rex("R/TestPrint.R: ", anything, "0.00%"))
-})
-test_that("print.coverage prints by = \"line\" by default", {
-  cov <- package_coverage("TestPrint")
 
   expect_message(print(cov, group = "functions"),
     rex::rex("test_me", anything, "0.00%"))

tests/testthat/test-report.R

@@ -12,7 +12,7 @@ skip_on_ci <- function() {
 
   #tmp <- tempfile()
   #set.seed(42)
-  #cov <- package_coverage("TestS4")
+  #cov <- package_coverage(test_path("TestS4"))
   ## Shiny uses its own seed which is not affected by set.seed, so we need to
   ## set that as well to have reproducibility
   #g <- shiny:::.globals

tests/testthat/test-summary.R

@@ -1,5 +1,5 @@
 test_that("Summary gives 50% coverage and two lines with zero coverage", {
-  cv <- package_coverage("TestSummary")
+  cv <- package_coverage(test_path("TestSummary"))
   expect_equal(percent_coverage(cv), 50)
   expect_equal(nrow(zero_coverage(cv)), 2)
 })

tests/testthat/test-utils.R

@@ -50,8 +50,6 @@ test_that("per_line removes blank lines and lines with only punctuation (#387)",
   expect_equal(line_cov[[1]]$coverage, c(NA, 0, 0, 2, NA, 1, NA, 1, NA, NA, NA, NA, NA, NA, NA, NA, NA))
 })
 
-context("split_on_line_directives")
-
 test_that("split_on_line_directives returns NULL for input without directive (#588)", {
   expect_identical(
     split_on_line_directives(NULL),