Skip to content

Instantly share code, notes, and snippets.

@CSJCampbell

CSJCampbell/test_file_coverage

Last active July 29, 2016 12:07
Show Gist options
  • Save CSJCampbell/8654d0e96c14ddeec7c0097ab10ef94f to your computer and use it in GitHub Desktop.
Save CSJCampbell/8654d0e96c14ddeec7c0097ab10ef94f to your computer and use it in GitHub Desktop.
Download ZIP
Test Coverage execution tests for covr
Raw
test_file_coverage
# Date of last change: 2016-07-29
# Last changed by: ccampbell
# Original author: ccampbell
# updated test_reportCoverage.R for covr testing.
#
# Copyright Mango Solutions, Chippenham, UK 2013-2016
# This document may be copied whole or in part for any use,
# provided that this copyright notice is retained.
###############################################################################
# execute this file on:
# https://github.com/MangoTheCat/testCoverage/tree/master/inst/examples
#
# Note that the test frame values are simply the reported value
# and should be double checked for sanity.
#
# Note that temporary installation of S4 classes is not removed by
# the current machinery (probably testthat) so coverage is not
# counted correctly for successive tests within the same environment.
test_that("add", {
# zero tests for instrumented functions
out_a0 <- file_coverage(source_files = list.files(file.path(
"examples", "add", "R"), full.names = TRUE),
test_files = list.files(file.path(
"examples", "add", "inst", "tests", "testthat", "tests0"), full.names = TRUE))
expect_message(object = print(out_a0), regex = "Coverage: 0.00%")
expect_that(sum(as.data.frame(out_a0)[["value"]]), equals(0L))
# tests for instrumented functions (1/1 lines instrumented)
out_a1 <- file_coverage(source_files = list.files(file.path(
"examples", "add", "R"), full.names = TRUE),
test_files = list.files(file.path(
"examples", "add", "inst", "tests", "testthat", "tests1"), full.names = TRUE))
expect_message(object = print(out_a1), regex = "Coverage: 100.00%")
expect_that(sum(as.data.frame(out_a1)[["value"]]), equals(1L))
})
test_that("fibonacci", {
# zero tests for instrumented functions
out_f0 <- file_coverage(source_files = list.files(file.path(
"examples", "fibonacci", "R"), full.names = TRUE),
test_files = list.files(file.path(
"examples", "fibonacci", "inst", "tests", "testthat", "tests0"), full.names = TRUE))
expect_message(object = print(out_f0), regex = "Coverage: 0.00%")
expect_that(sum(as.data.frame(out_f0)[["value"]]), equals(0L))
# tests for instrumented functions
out_f1 <- file_coverage(source_files = list.files(file.path(
"examples", "fibonacci", "R"), full.names = TRUE),
test_files = list.files(file.path(
"examples", "fibonacci", "inst", "tests", "testthat", "tests1"), full.names = TRUE))
#f1ex <- structure(list(
# A = structure(c(21L, 18L),
# .Dim = c(2L, 1L), .Dimnames = list(c("Trace Points", "test_fib1.R"), "fib.R")),
# E = FALSE,
# B = structure(list(
# test_fib1.R = structure(c(18L, 3L),
# .Dim = c(2L, 1L), .Dimnames = structure(list(c("Executed", "Not Executed"), "fib.R"),
# .Names = c("", "")), class = "table")), .Names = "test_fib1.R"),
# S = structure(c(18, 3), .Names = c("TRUE", "FALSE"))),
# .Names = c("A", "E", "B", "S"))
# 18/21 = 85.7% counting symbols in testCoverage
expect_message(object = print(out_f1), regex = "Coverage: 57.14%")
expect_that(sum(as.data.frame(out_f1)[["value"]]), equals(44L))
# tests 100% tracepoints for instrumented functions
out_f2 <- file_coverage(source_files = list.files(file.path(
"examples", "fibonacci", "R"), full.names = TRUE),
test_files = list.files(file.path(
"examples", "fibonacci", "inst", "tests", "testthat", "tests2"), full.names = TRUE))
#f2ex <- structure(list(
# A = structure(c(21L, 21L),
# .Dim = c(2L, 1L), .Dimnames = list(c("Trace Points", "test_fib2.R"), "fib.R")),
# E = FALSE,
# B = structure(list(
# test_fib2.R = structure(c(21L, 0),
# .Dim = c(2L, 1L), .Dimnames = structure(list(c("Executed", "Not Executed"), "fib.R"),
# .Names = c("", "")), class = "table")), .Names = "test_fib2.R"),
# S = structure(c(21, 0), .Names = c("TRUE", "FALSE"))),
# .Names = c("A", "E", "B", "S"))
expect_message(object = print(out_f2), regex = "Coverage: 100.00%")
expect_that(sum(as.data.frame(out_f2)[["value"]]), equals(60L))
})
test_that("saturate", {
# zero tests for instrumented functions
out_s0 <- file_coverage(source_files = list.files(file.path(
"examples", "saturate", "R"), full.names = TRUE),
test_files = list.files(file.path(
"examples", "saturate", "inst", "tests", "testthat", "tests0"), full.names = TRUE))
#s0ex <- structure(list(
# A = structure(c(15L, 0L, 33L, 0L), .Dim = c(2L, 2L),
# .Dimnames = list(c("Trace Points", "test_saturate0.R"), c("saturate.R", "saturateHSV.R"))),
# E = FALSE,
# B = structure(list(
# test_saturate0.R = structure(c(0L, 15L, 0L, 33L), .Dim = c(2L, 2L),
# .Dimnames = structure(list(c("Executed", "Not Executed"), c("saturate.R", "saturateHSV.R")),
# .Names = c("", "")), class = "table")),
# .Names = "test_saturate0.R"),
# S = structure(c(0, 48), .Names = c("TRUE", "FALSE"))),
# .Names = c("A", "E", "B", "S"))
expect_message(object = print(out_s0), regex = "Coverage: 0.00%")
expect_that(sum(as.data.frame(out_s0)[["value"]]), equals(0L))
# tests for instrumented functions
out_s1 <- file_coverage(source_files = list.files(file.path(
"examples", "saturate", "R"), full.names = TRUE),
test_files = list.files(file.path(
"examples", "saturate", "inst", "tests", "testthat", "tests1"), full.names = TRUE))
# 36.63% total lines hit
#s1ex <- structure(list(
# A = structure(c(15L, 0L, 33L, 21L), .Dim = c(2L, 2L),
# .Dimnames = list(c("Trace Points", "test_saturate1.R"), c("saturate.R", "saturateHSV.R"))),
# E = FALSE,
# B = structure(list(
# test_saturate1.R = structure(c(0L, 15L, 21L, 12L), .Dim = c(2L, 2L),
# .Dimnames = structure(list(c("Executed", "Not Executed"), c("saturate.R", "saturateHSV.R")),
# .Names = c("", "")), class = "table")),
# .Names = "test_saturate1.R"),
# S = structure(c(21, 27), .Names = c("TRUE", "FALSE"))),
# .Names = c("A", "E", "B", "S"))
expect_message(object = print(out_s1), regex = "Coverage: 36.63%")
expect_that(sum(as.data.frame(out_s1)[["value"]]), equals(22L))
# tests for instrumented functions
out_s2 <- file_coverage(source_files = list.files(file.path(
"examples", "saturate", "R"), full.names = TRUE),
test_files = list.files(file.path(
"examples", "saturate", "inst", "tests", "testthat", "tests2"), full.names = TRUE))
# 59.09%
#s2ex <- structure(list(
# A = structure(c(15L, 15L, 33L, 21L), .Dim = c(2L, 2L),
# .Dimnames = list(c("Trace Points", "test_saturate2.R"), c("saturate.R", "saturateHSV.R"))),
# E = FALSE,
# B = structure(list(
# test_saturate2.R = structure(c(15L, 0L, 21L, 12L), .Dim = c(2L, 2L),
# .Dimnames = structure(list(c("Executed", "Not Executed"), c("saturate.R", "saturateHSV.R")),
# .Names = c("", "")), class = "table")),
# .Names = "test_saturate2.R"),
# S = structure(c(36, 12), .Names = c("TRUE", "FALSE"))),
# .Names = c("A", "E", "B", "S"))
expect_message(object = print(out_s2), regex = "Coverage: 59.09%")
expect_that(sum(as.data.frame(out_s2)[["value"]]), equals(34L))
# tests for instrumented functions
out_s3 <- file_coverage(source_files = list.files(file.path(
"examples", "saturate", "R"), full.names = TRUE),
test_files = list.files(file.path(
"examples", "saturate", "inst", "tests", "testthat", "tests3"), full.names = TRUE))
#s3ex <- structure(list(
# A = structure(c(15L, 15L, 0L, 33L, 29L, 33L),
# .Dim = c(3L, 2L),
# .Dimnames = list(c("Trace Points", "test_saturate3.R", "test_saturateRGB3.R"),
# c("saturate.R", "saturateHSV.R"))),
# E = c(FALSE, FALSE),
# B = structure(list(
# test_saturate3.R = structure(c(15L, 0L, 29L, 4L),
# .Dim = c(2L, 2L),
# .Dimnames = structure(list(c("Executed", "Not Executed"), c("saturate.R", "saturateHSV.R")),
# .Names = c("", "")), class = "table"),
# test_saturateRGB3.R = structure(c(0L, 15L, 33L, 0L),
# .Dim = c(2L, 2L),
# .Dimnames = structure(list(c("Executed", "Not Executed"), c("saturate.R", "saturateHSV.R")),
# .Names = c("", "")), class = "table")),
# .Names = c("test_saturate3.R", "test_saturateRGB3.R")),
# S = structure(c(48, 0), .Names = c("TRUE", "FALSE"))),
# .Names = c("A", "E", "B", "S"))
expect_message(object = print(out_s3), regex = "Coverage: 100.00%")
expect_that(sum(as.data.frame(out_s3)[["value"]]), equals(143L))
})
# reverse assign must not be ignored
test_that("incr reverse assign", {
out <- file_coverage(
source_files = list.files(file.path("examples", "incr", "R"), full.names = TRUE),
test_files = list.files(file.path("examples", "incr",
"inst", "tests", "testthat", "tests"), full.names = TRUE))
expect_message(object = print(out), regex = "Coverage: 100.00%")
expect_that(sum(as.data.frame(out)[["value"]]), equals(2L))
})
# q must be ignored
test_that("incr q CCT-74", {
## note that q is not masked!
#outq <- file_coverage(
# source_files = list.files(file.path("examples", "incr", "R"), full.names = TRUE),
# test_files = list.files(file.path("examples", "incr",
# "inst", "tests", "testthat", "testsq"), full.names = TRUE))
#ex <- structure(list(
# A = structure(c(3L, 3L),
# .Dim = c(2L, 1L),
# .Dimnames = list(c("Trace Points", "test_incrq.R"), "incr.R")),
# E = FALSE,
# B = structure(list(
# test_incrq.R = structure(c(3L, 0L),
# .Dim = c(2L, 1L),
# .Dimnames = structure(list(c("Executed", "Not Executed"), "incr.R"),
# .Names = c("", "")), class = "table")),
# .Names = "test_incrq.R"),
# S = structure(c(3, 0), .Names = c("TRUE", "FALSE"))),
# .Names = c("A", "E", "B", "S"))
#expect_that(out, equals(ex))
}
)
test_that("sales S4", {
# zero tests for instrumented functions
out_sl0 <- suppressWarnings(
file_coverage(source_files = list.files(file.path(
"examples", "sales", "R"), full.names = TRUE),
test_files = list.files(file.path(
"examples", "sales", "inst", "tests", "testthat", "tests0"), full.names = TRUE))
)
expect_that(sum(as.data.frame(out_sl0)[["value"]]), equals(0L))
expect_message(object = print(out_sl0), regex = "Coverage: 0.00%")
# tests for instrumented functions partial coverage
out_sl1 <- suppressWarnings(
file_coverage(source_files = list.files(file.path(
"examples", "sales", "R"), full.names = TRUE),
test_files = list.files(file.path(
"examples", "sales", "inst", "tests", "testthat", "tests1"), full.names = TRUE))
)
expect_that(sum(as.data.frame(out_sl1)[["value"]]),
equals(26L))
expect_message(object = print(out_sl1), regex = "Coverage: 56.67%")
# tests 100% tracepoints for instrumented functions
# includes validObject via call to unique
out_sl2 <- suppressWarnings(
file_coverage(source_files = list.files(file.path(
"examples", "sales", "R"), full.names = TRUE),
test_files = list.files(file.path(
"examples", "sales", "inst", "tests", "testthat", "tests2"), full.names = TRUE))
)
expect_that(sum(as.data.frame(out_sl2)[["value"]]), equals(104L))
expect_message(object = print(out_sl2), regex = "Coverage: 100.00%")
})
# Note that temporary installation of S4 classes is not removed by
# the current machinery (probably testthat) so coverage is not
# counted correctly for successive tests within the same environment.
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment