Mismatch between source and test file names

covr-per-file-analyze.R

#' ---
#' title: Mismatch between source and test files in tibble
#' output:
#'   html_notebook:
#'     toc: true
#'     code_folding: hide
#' ---

# For paged output
options(max.print = 1000)

library(tidyverse)
# for as.data.frame.coverage
requireNamespace("covr", quietly = TRUE)

# Created by covr-per-file.R in
# https://gist.github.com/krlmlr/30a3c07d5114cde39236b2c08d69c873
test_results <- readRDS("covr-results.rds")

covr_enframe <- function(x) {
  x$result %>%
    as.data.frame() %>%
    as_tibble() %>%
    transmute(
      source_file = filename,
      source_pos = paste0(
        source_file, ":",
        first_line, ":", first_column, "-",
        last_line, ":", last_column,
        if_else(is.na(functions), paste0("-", functions), "")
      ),
      value
    )
}

##' # Check errors ----

test_results %>%
  filter(map_lgl(covr, ~ !is.null(.x$error))) %>%
  nrow()


##' # Collect coverage per expression per test file ----

long <-
  test_results %>%
  mutate(covr_frames = map(covr, covr_enframe)) %>%
  select(-code, -covr) %>%
  rename(test_file = file) %>%
  unnest(covr_frames) %>%
  select(source_file, everything())

# Munge file names, don't care about native code for now
long_clean <-
  long %>%
  filter(grepl("^R/", source_file)) %>%
  mutate(source_file = gsub("^R/", "", source_file)) %>%
  mutate(test_file = gsub("^test-", "", test_file))

covr_per_test_file <-
  long_clean %>%
  group_by(source_file, test_file) %>%
  summarize(coverage = mean(value != 0)) %>%
  ungroup() %>%
  arrange(source_file, -coverage) %>%
  group_by(source_file) %>%
  mutate(rank = row_number()) %>%
  ungroup()

best <-
  covr_per_test_file %>%
  filter(rank == 1) %>%
  select(-rank)

#' All tests where the best coverage is obtained from a test file
#' that's named differently from the source file.
best %>%
  filter(test_file != source_file) %>%
  filter(!grepl("^utils-", source_file)) %>%
  arrange(-coverage)


##' # Which source files are covered by tests in other files? ----

long_clean_rank <-
  long_clean %>%
  left_join(covr_per_test_file %>% select(source_file, test_file, rank))

best_hit <-
  long_clean_rank %>%
  filter(value > 0, source_file == test_file) %>%
  select(-value, -rank, -test_file)

other_hit <-
  long_clean_rank %>%
  filter(value > 0, source_file != test_file)

#' List locations that were missed by the same-file test
#' but hit by the other test
anti_join(other_hit, best_hit, by = c("source_file", "source_pos")) %>%
  group_by(source_pos) %>%
  summarize(test_file = paste0(head(test_file, 3), collapse = ", ")) %>%
  ungroup()

covr-per-file.R

library(tidyverse)
library(rlang)

tests <- dir("tests/testthat", pattern = "^test-.*[.][rR]$")

test_code <- function(file) {
  code <- paste0('testthat::test_file("tests/testthat/', file, '")')
  quo(covr::package_coverage(type = "none", code = !!code))
}

test_def <-
  tibble(file = tests) %>%
  filter(!grepl("^test-zzz-", file)) %>%
  mutate(code = map(file, test_code))

test_results <-
  test_def %>%
  mutate(covr = map(code, safely(eval_tidy)))

saveRDS(test_results, "covr-results.rds")